KIDS Distribution saved on Jun 27, 2008@12:59:52
IHS ScriptPro Interface Patch 1
**KIDS**:APSS*1.0*1^

**INSTALL NAME**
APSS*1.0*1
"BLD",2961,0)
APSS*1.0*1^IHS SCRIPTPRO INTERFACE^0^3080627^n
"BLD",2961,1,0)
^^14^14^3080430.113924
"BLD",2961,1,1,0)
Patch 1 delivers the following fields as new content sent from RPMS to the ScriptPro 
"BLD",2961,1,2,0)
dispensing system.
"BLD",2961,1,3,0)

"BLD",2961,1,4,0)
       Patient Address
"BLD",2961,1,5,0)
       Patient Gender
"BLD",2961,1,6,0)
       Provider Class
"BLD",2961,1,7,0)
       License Number
"BLD",2961,1,8,0)
       Provider DEA#
"BLD",2961,1,9,0)
       Issue Date
"BLD",2961,1,10,0)
       Pharmacy Name
"BLD",2961,1,11,0)
       Site DEA#
"BLD",2961,1,12,0)

"BLD",2961,1,13,0)
-The ASK prompt was not checking for DUOUT. This is corrected in patch 1.
"BLD",2961,1,14,0)
-Added logic to suppress the ASK prompt when labels are tasked.
"BLD",2961,4,0)
^9.64PA^^
"BLD",2961,"INI")
EP1^APSSINI0
"BLD",2961,"KRN",0)
^9.67PA^8989.52^19
"BLD",2961,"KRN",.4,0)
.4
"BLD",2961,"KRN",.401,0)
.401
"BLD",2961,"KRN",.402,0)
.402
"BLD",2961,"KRN",.403,0)
.403
"BLD",2961,"KRN",.5,0)
.5
"BLD",2961,"KRN",.84,0)
.84
"BLD",2961,"KRN",3.6,0)
3.6
"BLD",2961,"KRN",3.8,0)
3.8
"BLD",2961,"KRN",9.2,0)
9.2
"BLD",2961,"KRN",9.8,0)
9.8
"BLD",2961,"KRN",9.8,"NM",0)
^9.68A^4^4
"BLD",2961,"KRN",9.8,"NM",1,0)
APSSLIC^^0^B17771025
"BLD",2961,"KRN",9.8,"NM",2,0)
APSSSPRO^^0^B25035830
"BLD",2961,"KRN",9.8,"NM",3,0)
APSSINI0^^0^B52704709
"BLD",2961,"KRN",9.8,"NM",4,0)
APSSNTE1^^0^B3150172
"BLD",2961,"KRN",9.8,"NM","B","APSSINI0",3)

"BLD",2961,"KRN",9.8,"NM","B","APSSLIC",1)

"BLD",2961,"KRN",9.8,"NM","B","APSSNTE1",4)

"BLD",2961,"KRN",9.8,"NM","B","APSSSPRO",2)

"BLD",2961,"KRN",19,0)
19
"BLD",2961,"KRN",19,"NM",0)
^9.68A^^
"BLD",2961,"KRN",19.1,0)
19.1
"BLD",2961,"KRN",101,0)
101
"BLD",2961,"KRN",409.61,0)
409.61
"BLD",2961,"KRN",771,0)
771
"BLD",2961,"KRN",870,0)
870
"BLD",2961,"KRN",8989.51,0)
8989.51
"BLD",2961,"KRN",8989.52,0)
8989.52
"BLD",2961,"KRN",8994,0)
8994
"BLD",2961,"KRN","B",.4,.4)

"BLD",2961,"KRN","B",.401,.401)

"BLD",2961,"KRN","B",.402,.402)

"BLD",2961,"KRN","B",.403,.403)

"BLD",2961,"KRN","B",.5,.5)

"BLD",2961,"KRN","B",.84,.84)

"BLD",2961,"KRN","B",3.6,3.6)

"BLD",2961,"KRN","B",3.8,3.8)

"BLD",2961,"KRN","B",9.2,9.2)

"BLD",2961,"KRN","B",9.8,9.8)

"BLD",2961,"KRN","B",19,19)

"BLD",2961,"KRN","B",19.1,19.1)

"BLD",2961,"KRN","B",101,101)

"BLD",2961,"KRN","B",409.61,409.61)

"BLD",2961,"KRN","B",771,771)

"BLD",2961,"KRN","B",870,870)

"BLD",2961,"KRN","B",8989.51,8989.51)

"BLD",2961,"KRN","B",8989.52,8989.52)

"BLD",2961,"KRN","B",8994,8994)

"BLD",2961,"PRE")
APSSINI0
"BLD",2961,"QUES",0)
^9.62^^
"BLD",2961,"REQB",0)
^9.611^^
"INI")
EP1^APSSINI0
"MBREQ")
0
"PKG",374,-1)
1^1
"PKG",374,0)
IHS SCRIPTPRO INTERFACE^APSS^IHS SCRIPTPRO INTERFACE
"PKG",374,20,0)
^9.402P^^
"PKG",374,22,0)
^9.49I^1^1
"PKG",374,22,1,0)
1.0^3060111
"PKG",374,22,1,"PAH",1,0)
1^3080627
"PKG",374,22,1,"PAH",1,1,0)
^^14^14^3080627
"PKG",374,22,1,"PAH",1,1,1,0)
Patch 1 delivers the following fields as new content sent from RPMS to the ScriptPro 
"PKG",374,22,1,"PAH",1,1,2,0)
dispensing system.
"PKG",374,22,1,"PAH",1,1,3,0)

"PKG",374,22,1,"PAH",1,1,4,0)
       Patient Address
"PKG",374,22,1,"PAH",1,1,5,0)
       Patient Gender
"PKG",374,22,1,"PAH",1,1,6,0)
       Provider Class
"PKG",374,22,1,"PAH",1,1,7,0)
       License Number
"PKG",374,22,1,"PAH",1,1,8,0)
       Provider DEA#
"PKG",374,22,1,"PAH",1,1,9,0)
       Issue Date
"PKG",374,22,1,"PAH",1,1,10,0)
       Pharmacy Name
"PKG",374,22,1,"PAH",1,1,11,0)
       Site DEA#
"PKG",374,22,1,"PAH",1,1,12,0)

"PKG",374,22,1,"PAH",1,1,13,0)
-The ASK prompt was not checking for DUOUT. This is corrected in patch 1.
"PKG",374,22,1,"PAH",1,1,14,0)
-Added logic to suppress the ASK prompt when labels are tasked.
"PRE")
APSSINI0
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
YES
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
YES
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
YES
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
4
"RTN","APSSINI0")
0^3^B52704709
"RTN","APSSINI0",1,0)
APSSINI0 ;IHS/CIA/MDM - ScriptPro Interface;26-Jun-2008 15:01;DU
"RTN","APSSINI0",2,0)
 ;;1.0;IHS SCRIPTPRO INTERFACE;**1**;January 11, 2006
"RTN","APSSINI0",3,0)
 ; APSS COMMAND FILE (#9009033.3) Maintenance & Initialization routine
"RTN","APSSINI0",4,0)
 ; Direct entry not supported
"RTN","APSSINI0",5,0)
 Q
"RTN","APSSINI0",6,0)
EP1 ;MDM - Main entry point
"RTN","APSSINI0",7,0)
 ;
"RTN","APSSINI0",8,0)
 ; File structure
"RTN","APSSINI0",9,0)
 ; APSS COMMAND FILE (#9009033.3)
"RTN","APSSINI0",10,0)
 ; APSS COMMAND FILE DATA TAG (Multiple-9009033.31)
"RTN","APSSINI0",11,0)
 ; APSS COMMAND FILE DATA TAG DESCRIPTION (Multiple-9009033.312)
"RTN","APSSINI0",12,0)
 ;
"RTN","APSSINI0",13,0)
 ; Variable definitions
"RTN","APSSINI0",14,0)
 ; APSSDAT = Data
"RTN","APSSINI0",15,0)
 ; APSSCLC = Comment Line count
"RTN","APSSINI0",16,0)
 ; APSSTAG = Data Tag (.01)
"RTN","APSSINI0",17,0)
 ; APSSSEQ = Sequence (.02)
"RTN","APSSINI0",18,0)
 ; APSSFLD = File/Field (.03)
"RTN","APSSINI0",19,0)
 ; APSSFMT = Format (.04)
"RTN","APSSINI0",20,0)
 ; APSSTRAN = Transform (1)
"RTN","APSSINI0",21,0)
 ; APSSDESC = Description total line number (2)
"RTN","APSSINI0",22,0)
 ; APSSCMD = Command
"RTN","APSSINI0",23,0)
 ; APSSSIEN = DATA TAG Subfile IEN
"RTN","APSSINI0",24,0)
 ; APSSIEN = FDA Array FDA_ROOT Construct
"RTN","APSSINI0",25,0)
 ; APSSDIEN = DATA TAG DESCRIPTION Sub-Sub File Word Processing field IEN
"RTN","APSSINI0",26,0)
 ; APSSLINE = Description Text line being processed (Reading data statements)
"RTN","APSSINI0",27,0)
 ; APSSDEND = Description Text Ending line number (Reading data statements)
"RTN","APSSINI0",28,0)
 ; APSSDBEG = Description Text Beginning line number (Reading data statements)
"RTN","APSSINI0",29,0)
 ; ACTION = What action took place (ADD, EDIT, DELETE)
"RTN","APSSINI0",30,0)
 ; APSSUTAG = Original value that was modified
"RTN","APSSINI0",31,0)
 ;
"RTN","APSSINI0",32,0)
 ; Initialize working variables and control cleanup upon routine termination
"RTN","APSSINI0",33,0)
 N APSSDAT,APSSCLC,APSSTAG,APSSSEQ,APSSFLD,APSSFMT,APSSDESC,APSSTRAN,APSSUTAG
"RTN","APSSINI0",34,0)
 N APSSCMD,APSSSIEN,APSSIEN,APSSDIEN,FDA,APSSDEND,APSSDBEG,APSSLINE,ACTION
"RTN","APSSINI0",35,0)
 N ARY,SSEQ
"RTN","APSSINI0",36,0)
 ;
"RTN","APSSINI0",37,0)
 ; Grab the IEN for the FILL Command
"RTN","APSSINI0",38,0)
 S APSSCMD="",APSSCMD=$O(^APSSCOMD("B","FILL",APSSCMD)) Q:'APSSCMD
"RTN","APSSINI0",39,0)
 S SIEN=0 F  S SIEN=$O(^APSSCOMD(APSSCMD,1,SIEN)) Q:'SIEN  D
"RTN","APSSINI0",40,0)
 .S SSEQ=$P($G(^APSSCOMD(APSSCMD,1,SIEN,0)),U,2)
"RTN","APSSINI0",41,0)
 .I SSEQ S ARY(SSEQ)=$P(^APSSCOMD(APSSCMD,1,SIEN,0),U,1)
"RTN","APSSINI0",42,0)
 ;
"RTN","APSSINI0",43,0)
 ; MAIN PROCESSING LOOP
"RTN","APSSINI0",44,0)
 ; Loop through the data statement section of this routine
"RTN","APSSINI0",45,0)
 F APSSCLC=1:1 S APSSDAT=$P($T(DATA+APSSCLC),";",2) Q:APSSDAT="EOD"  D
"RTN","APSSINI0",46,0)
 . ; If there is no data on that line quit processing and go get the next line
"RTN","APSSINI0",47,0)
 . I APSSDAT="" Q
"RTN","APSSINI0",48,0)
 . ; If the line does not have a "^" in it then it is an invalid record so quit.
"RTN","APSSINI0",49,0)
 . I APSSDAT'["^" Q
"RTN","APSSINI0",50,0)
 . ; Piece out the major data elements
"RTN","APSSINI0",51,0)
 . S APSSTAG=$P(APSSDAT,"^",1)           ; Data Tag
"RTN","APSSINI0",52,0)
 . S APSSSEQ=$P(APSSDAT,"^",2)           ; Sequence
"RTN","APSSINI0",53,0)
 . ; if the sequence number is in use and the data tag does not match what is being delivered
"RTN","APSSINI0",54,0)
 . ; change this sequence number
"RTN","APSSINI0",55,0)
 . I $D(ARY(APSSSEQ))&($G(ARY(APSSSEQ))'=APSSTAG) S APSSSEQ=$$NEWSEQ(.ARY,APSSSEQ)
"RTN","APSSINI0",56,0)
 . S APSSFLD=$P(APSSDAT,"^",3)           ; File/Field
"RTN","APSSINI0",57,0)
 . S APSSFMT=$P($P(APSSDAT,"^",4),"~",1) ; Format
"RTN","APSSINI0",58,0)
 . S APSSTRAN=$P(APSSDAT,"~",2)          ; Transform
"RTN","APSSINI0",59,0)
 . S APSSDESC=$P(APSSDAT,"~",3)          ; Description
"RTN","APSSINI0",60,0)
 . ;
"RTN","APSSINI0",61,0)
 . ; Filing methods and requirements are determined in this section of code.
"RTN","APSSINI0",62,0)
 . ;
"RTN","APSSINI0",63,0)
 . ; *****************************DELETE**************************************
"RTN","APSSINI0",64,0)
 . ; Check for delete flag and if present, perform appropriate action.
"RTN","APSSINI0",65,0)
 . I APSSTAG["@",$D(^APSSCOMD(APSSCMD,1,"B",$P(APSSTAG,"@",2))) D  Q
"RTN","APSSINI0",66,0)
 . . W !,"DELETE RECORD"
"RTN","APSSINI0",67,0)
 . . S ACTION="DELETE"
"RTN","APSSINI0",68,0)
 . . ; Grab the IEN for this Data Tag
"RTN","APSSINI0",69,0)
 . . S APSSSIEN="",APSSSIEN=$O(^APSSCOMD(APSSCMD,1,"B",$P(APSSTAG,"@",2),APSSSIEN))
"RTN","APSSINI0",70,0)
 . . ; Build FDA Array IEN Construct
"RTN","APSSINI0",71,0)
 . . S APSSIEN=APSSSIEN_","_APSSCMD_","
"RTN","APSSINI0",72,0)
 . . ; Build FDA Array to define file structure and field values
"RTN","APSSINI0",73,0)
 . . S FDA(9009033.31,APSSIEN,.01)="@"
"RTN","APSSINI0",74,0)
 . . ;
"RTN","APSSINI0",75,0)
 . . ; Delete this record in the file
"RTN","APSSINI0",76,0)
 . . D FILE^DIE("","FDA","ERR")
"RTN","APSSINI0",77,0)
 . . ;
"RTN","APSSINI0",78,0)
 . . I +$G(ERR("ERR")) D RESET Q
"RTN","APSSINI0",79,0)
 . . ;
"RTN","APSSINI0",80,0)
 . . ; Display informational message
"RTN","APSSINI0",81,0)
 . . D MSG
"RTN","APSSINI0",82,0)
 . . ; DEVELOPEMENT DISPLAY
"RTN","APSSINI0",83,0)
 . . ;D DISP
"RTN","APSSINI0",84,0)
 . . ; Reset working variables
"RTN","APSSINI0",85,0)
 . . D RESET
"RTN","APSSINI0",86,0)
 . . ;
"RTN","APSSINI0",87,0)
 . . Q
"RTN","APSSINI0",88,0)
 . ;
"RTN","APSSINI0",89,0)
 . ; *****************************UPDATE***************************************
"RTN","APSSINI0",90,0)
 . ; If the Umlaut is found in the APSSTAG string then,
"RTN","APSSINI0",91,0)
 . ; Check for an existing entry and if present, perform appropriate action.
"RTN","APSSINI0",92,0)
 . ;I APSSTAG["`",$D(^APSSCOMD(APSSCMD,1,"B",$P(APSSTAG,"`",1))) D  Q
"RTN","APSSINI0",93,0)
 . I $D(^APSSCOMD(APSSCMD,1,"B",APSSTAG)) D  Q
"RTN","APSSINI0",94,0)
 . . W !,"UPDATE RECORD"
"RTN","APSSINI0",95,0)
 . . S ACTION="EDIT"
"RTN","APSSINI0",96,0)
 . . ; Strip off the umlaut character and separate the two values
"RTN","APSSINI0",97,0)
 . . ; If the DATA TAG value is changing them Piece 2 holds the new value
"RTN","APSSINI0",98,0)
 . . S APSSUTAG=$P(APSSTAG,"`",2)
"RTN","APSSINI0",99,0)
 . . ; Piece one holds the current value
"RTN","APSSINI0",100,0)
 . . S APSSTAG=$P(APSSTAG,"`",1)
"RTN","APSSINI0",101,0)
 . . ; If piece 1 has no value then
"RTN","APSSINI0",102,0)
 . . ; Data in another field is changing but the DATA TAG field is not changing
"RTN","APSSINI0",103,0)
 . . I APSSTAG="" S APSSTAG=APSSUTAG
"RTN","APSSINI0",104,0)
 . . ; Grab the IEN for this Data Tag
"RTN","APSSINI0",105,0)
 . . S APSSSIEN="",APSSSIEN=$O(^APSSCOMD(APSSCMD,1,"B",APSSTAG,APSSSIEN))
"RTN","APSSINI0",106,0)
 . . ; Build FDA Array IEN Construct
"RTN","APSSINI0",107,0)
 . . S APSSIEN=APSSSIEN_","_APSSCMD_","
"RTN","APSSINI0",108,0)
 . . ; Build FDA Array
"RTN","APSSINI0",109,0)
 . . D FDA
"RTN","APSSINI0",110,0)
 . . ;
"RTN","APSSINI0",111,0)
 . . ; Update the file
"RTN","APSSINI0",112,0)
 . . D FILE^DIE("","FDA","ERR")
"RTN","APSSINI0",113,0)
 . . ;
"RTN","APSSINI0",114,0)
 . . I +$G(ERR("ERR")) D RESET Q
"RTN","APSSINI0",115,0)
 . . ;
"RTN","APSSINI0",116,0)
 . . ; Display informational message
"RTN","APSSINI0",117,0)
 . . D MSG
"RTN","APSSINI0",118,0)
 . . ; Process Description Text if defined
"RTN","APSSINI0",119,0)
 . . D DESC(APSSSIEN)
"RTN","APSSINI0",120,0)
 . . ; DEVELOPEMENT DISPLAY
"RTN","APSSINI0",121,0)
 . . ;D DISP
"RTN","APSSINI0",122,0)
 . . ; Reset working variables
"RTN","APSSINI0",123,0)
 . . D RESET
"RTN","APSSINI0",124,0)
 . . Q
"RTN","APSSINI0",125,0)
 . ;
"RTN","APSSINI0",126,0)
 . ; **************************NEW ENTRY***************************************
"RTN","APSSINI0",127,0)
 . ; File a new entry
"RTN","APSSINI0",128,0)
 . ; Check for an existing entry and if NOT present, perform appropriate action.
"RTN","APSSINI0",129,0)
 . I '$D(^APSSCOMD(APSSCMD,1,"B",APSSTAG)) D  Q
"RTN","APSSINI0",130,0)
 . . W !,"RECORD NEW ENTRY"
"RTN","APSSINI0",131,0)
 . . S ACTION="ADD"
"RTN","APSSINI0",132,0)
 . . S APSSSIEN="+1"
"RTN","APSSINI0",133,0)
 . . ; Build FDA Array IEN Construct
"RTN","APSSINI0",134,0)
 . . S APSSIEN=APSSSIEN_","_APSSCMD_","
"RTN","APSSINI0",135,0)
 . . ; Build FDA Array
"RTN","APSSINI0",136,0)
 . . D FDA
"RTN","APSSINI0",137,0)
 . . ;
"RTN","APSSINI0",138,0)
 . . ; File the Data
"RTN","APSSINI0",139,0)
 . . D UPDATE^DIE("","FDA","ERR")
"RTN","APSSINI0",140,0)
 . . ;
"RTN","APSSINI0",141,0)
 . . I +$G(ERR("ERR")) D RESET Q
"RTN","APSSINI0",142,0)
 . . ;
"RTN","APSSINI0",143,0)
 . . ;Display informational message
"RTN","APSSINI0",144,0)
 . . D MSG
"RTN","APSSINI0",145,0)
 . . ; Process Description Text if defined
"RTN","APSSINI0",146,0)
 . . D DESC(ERR(1))
"RTN","APSSINI0",147,0)
 . . ; DEVELOPEMENT DISPLAY
"RTN","APSSINI0",148,0)
 . . ;D DISP
"RTN","APSSINI0",149,0)
 . . ; Reset working variables
"RTN","APSSINI0",150,0)
 . . D RESET
"RTN","APSSINI0",151,0)
 . . Q
"RTN","APSSINI0",152,0)
 . Q
"RTN","APSSINI0",153,0)
 ;
"RTN","APSSINI0",154,0)
 ; Kill the message arrays and variables that are produced by VA FileMan.
"RTN","APSSINI0",155,0)
 D CLEAN^DILF
"RTN","APSSINI0",156,0)
 ; End of processing
"RTN","APSSINI0",157,0)
 Q
"RTN","APSSINI0",158,0)
DESC(REC) ; Process description text and put it into the file
"RTN","APSSINI0",159,0)
 ; If there is no description text then quit
"RTN","APSSINI0",160,0)
 I 'APSSDESC Q
"RTN","APSSINI0",161,0)
 S APSSIEN=REC_","_APSSCMD_","
"RTN","APSSINI0",162,0)
 ; Process Description text data statements
"RTN","APSSINI0",163,0)
 S APSSDEND=APSSCLC+APSSDESC,APSSDBEG=APSSCLC+1  ; Initialize counters
"RTN","APSSINI0",164,0)
 ; Loop through the description text for this data tag
"RTN","APSSINI0",165,0)
 F APSSLINE=APSSDBEG:1:APSSDEND S APSSDAT=$P($T(DATA+APSSLINE),";",2) D
"RTN","APSSINI0",166,0)
 . ; Set up data array t be processed by VA Fileman.
"RTN","APSSINI0",167,0)
 . S TMP("WP",APSSLINE)=APSSDAT,APSSDAT=""
"RTN","APSSINI0",168,0)
 . Q
"RTN","APSSINI0",169,0)
 ;
"RTN","APSSINI0",170,0)
 ; If Description lines were defined then adjust process looping position
"RTN","APSSINI0",171,0)
 ; and send the data to VA Fileman to put into the database.
"RTN","APSSINI0",172,0)
 I APSSLINE S APSSCLC=APSSLINE,APSSLINE="" D
"RTN","APSSINI0",173,0)
 . ;
"RTN","APSSINI0",174,0)
 . ; File the description text
"RTN","APSSINI0",175,0)
 . D WP^DIE(9009033.31,APSSIEN,2,"K","TMP(""WP"")","ERR(""WP"")")
"RTN","APSSINI0",176,0)
 . Q
"RTN","APSSINI0",177,0)
 ;
"RTN","APSSINI0",178,0)
 Q
"RTN","APSSINI0",179,0)
FDA ;
"RTN","APSSINI0",180,0)
 ; Build FDA Array to define file structure and field values for use by Fileman
"RTN","APSSINI0",181,0)
 S FDA(9009033.31,APSSIEN,.01)=APSSTAG
"RTN","APSSINI0",182,0)
 I $G(APSSUTAG)]"" S FDA(9009033.31,APSSIEN,.01)=APSSUTAG
"RTN","APSSINI0",183,0)
 S FDA(9009033.31,APSSIEN,.02)=APSSSEQ
"RTN","APSSINI0",184,0)
 S FDA(9009033.31,APSSIEN,.03)=APSSFLD
"RTN","APSSINI0",185,0)
 S FDA(9009033.31,APSSIEN,.04)=APSSFMT
"RTN","APSSINI0",186,0)
 S FDA(9009033.31,APSSIEN,1)=APSSTRAN
"RTN","APSSINI0",187,0)
 Q
"RTN","APSSINI0",188,0)
RESET ;
"RTN","APSSINI0",189,0)
 ; Reset working variables to NULL once each record is processed
"RTN","APSSINI0",190,0)
 S APSSTAG=""           ; Data Tag
"RTN","APSSINI0",191,0)
 S APSSSEQ=""           ; Sequence
"RTN","APSSINI0",192,0)
 S APSSFLD=""           ; File/Field
"RTN","APSSINI0",193,0)
 S APSSFMT=""           ; Format
"RTN","APSSINI0",194,0)
 S APSSTRAN=""          ; Transform
"RTN","APSSINI0",195,0)
 S APSSDESC=""          ; Description
"RTN","APSSINI0",196,0)
 K TMP,FDA,ERR,ACTION,APSSUTAG
"RTN","APSSINI0",197,0)
 Q
"RTN","APSSINI0",198,0)
MSG ; Set up informational messages to display to the screen
"RTN","APSSINI0",199,0)
 ;
"RTN","APSSINI0",200,0)
 I '$G(ERR) D
"RTN","APSSINI0",201,0)
 . I ACTION="ADD" D MES("Data Record: "_APSSTAG_" has been ADDED.")
"RTN","APSSINI0",202,0)
 . I ACTION="DELETE" D MES("Data Record: "_$P(APSSTAG,"@",2)_" has been DELETED.")
"RTN","APSSINI0",203,0)
 . I ACTION="EDIT" D MES("Data Record: "_$P(APSSTAG,"`",1)_" has been MODIFIED.")
"RTN","APSSINI0",204,0)
 . Q
"RTN","APSSINI0",205,0)
 E  D MES("Data Field: "_APSSTAG_" resulted in ERROR "_ERR(1))
"RTN","APSSINI0",206,0)
 Q
"RTN","APSSINI0",207,0)
MES(MSG,QUIT) ; Display informational messages
"RTN","APSSINI0",208,0)
 D BMES^XPDUTL("  "_$G(MSG))
"RTN","APSSINI0",209,0)
 Q
"RTN","APSSINI0",210,0)
 ; INPUT  ARRAY - List of current sequence numbers being used at the facility
"RTN","APSSINI0",211,0)
 ;           SQ - Sequence number needing to be changed.
"RTN","APSSINI0",212,0)
 ;
"RTN","APSSINI0",213,0)
NEWSEQ(ARRAY,SQ) ;
"RTN","APSSINI0",214,0)
 N OFFSET,QUIT,NSQ
"RTN","APSSINI0",215,0)
 S QUIT=0,NSQ=SQ
"RTN","APSSINI0",216,0)
 F OFFSET=.1:.1:.9 D  Q:QUIT
"RTN","APSSINI0",217,0)
 .S NSQ=$P(SQ,".")+OFFSET
"RTN","APSSINI0",218,0)
 .I '$D(ARRAY(NSQ)) S QUIT=1 Q
"RTN","APSSINI0",219,0)
 I 'QUIT S NSQ=SQ+.01
"RTN","APSSINI0",220,0)
 Q NSQ
"RTN","APSSINI0",221,0)
 ; *************************************************************************
"RTN","APSSINI0",222,0)
 ; Structure of data statements found below the DATA line tag.
"RTN","APSSINI0",223,0)
 ;
"RTN","APSSINI0",224,0)
 ; DATA TAG^SEQUENCE^FILE,FIELD^FORMAT~TRANSFORM~NUMBER OF DESC. TEXT LINES
"RTN","APSSINI0",225,0)
 ; NOTE:
"RTN","APSSINI0",226,0)
 ; If there is a number in the last "~" piece then, there is description text
"RTN","APSSINI0",227,0)
 ; which may be multiple lines of text. That text will follow the data line
"RTN","APSSINI0",228,0)
 ; and preceed the next data line. The FOR loop reading the data statements
"RTN","APSSINI0",229,0)
 ; will be adjusted to skip over the description text. A secondary loop will
"RTN","APSSINI0",230,0)
 ; read and process the description data.
"RTN","APSSINI0",231,0)
 ;
"RTN","APSSINI0",232,0)
 ; To delete a record an "@" must appear as the first character of the data
"RTN","APSSINI0",233,0)
 ; string.
"RTN","APSSINI0",234,0)
 ;
"RTN","APSSINI0",235,0)
 ; To modify a record use the Umlaut "`" as a flag in the first piece of the
"RTN","APSSINI0",236,0)
 ; data string indicating it is an update.  If the first "^" piece is to be
"RTN","APSSINI0",237,0)
 ; modified then the NEW value must appear in the SECOND "`" piece.
"RTN","APSSINI0",238,0)
 ;
"RTN","APSSINI0",239,0)
DATA ; This module holds the data that will be put into the database.
"RTN","APSSINI0",240,0)
 ;
"RTN","APSSINI0",241,0)
 ;Patient Gender^3.2^2,.02^Z~S VAL=$$GET1^DIQ(2,$P(RX0,U,2),.02)~1
"RTN","APSSINI0",242,0)
 ;Patient Gender Designator
"RTN","APSSINI0",243,0)
 ;Patient Address^3.3^^Z~S VAL=$$PADDR^APSSLIC($P(RX0,U,2))~1
"RTN","APSSINI0",244,0)
 ;Patient Address
"RTN","APSSINI0",245,0)
 ;Provider Class^31^200,53.5^ZR~S VAL=$$GET1^DIQ($S(PARIEN:52.2,REFIEN:52.1,1:52),$S(PARIEN!REFIEN:RXIENS,1:$P(RXIENS,",",$L(RXIENS,",")-1)),$S(PARIEN:6,REFIEN:15,1:4),"I") S:VAL VAL=$$GET1^DIQ(200,VAL,53.5)~1
"RTN","APSSINI0",246,0)
 ;Provider Class
"RTN","APSSINI0",247,0)
 ;Provider DEA#^32^200,53.2^ZR~S VAL=$$GET1^DIQ($S(PARIEN:52.2,REFIEN:52.1,1:52),$S(PARIEN!REFIEN:RXIENS,1:$P(RXIENS,",",$L(RXIENS,",")-1)),$S(PARIEN:6,REFIEN:15,1:4),"I") S:VAL VAL=$$GET1^DIQ(200,VAL,53.2)~1
"RTN","APSSINI0",248,0)
 ;Provider DEA#
"RTN","APSSINI0",249,0)
 ;Site DEA#^33^^Z~S VAL=$$SDEA^APSSLIC($P(RX0,U,5))~1
"RTN","APSSINI0",250,0)
 ;Site DEA#
"RTN","APSSINI0",251,0)
 ;Site Name^34^^Z~S VAL=$$SNAME^APSSLIC($P(RX0,U,5))~1
"RTN","APSSINI0",252,0)
 ;Site Name
"RTN","APSSINI0",253,0)
 ;Issue Date^35^52,1^Z~S VAL=$$FMTE^XLFDT($P(RX0,U,13),"5Z")~1
"RTN","APSSINI0",254,0)
 ;Issue Date
"RTN","APSSINI0",255,0)
 ;Login Date^37^52,21^Z~S VAL=$$FMTE^XLFDT($P(RX2,U),"5Z")~1
"RTN","APSSINI0",256,0)
 ;Login Date
"RTN","APSSINI0",257,0)
 ;License Number^36^200.541,1^ZR~S VAL=$$EP1^APSSLIC($$GET1^DIQ($S(PARIEN:52.2,REFIEN:52.1,1:52),$S(PARIEN!REFIEN:RXIENS,1:$P(RXIENS,",",$L(RXIENS,",")-1)),$S(PARIEN:6,REFIEN:15,1:4),"I"),2)~17
"RTN","APSSINI0",258,0)
 ;Provider License Number
"RTN","APSSINI0",259,0)
 ;
"RTN","APSSINI0",260,0)
 ; Parameter 1 passed to APSSLIC routine represents the Provider Internal Entry Number
"RTN","APSSINI0",261,0)
 ; Paramneter 2 represents the processing method which is described below..
"RTN","APSSINI0",262,0)
 ;
"RTN","APSSINI0",263,0)
 ; Method 1
"RTN","APSSINI0",264,0)
 ; Match it to the state the facility is in
"RTN","APSSINI0",265,0)
 ; If there is no license for that state then return any valid license
"RTN","APSSINI0",266,0)
 ; If no valid license found for any state then return NULL
"RTN","APSSINI0",267,0)
 ;
"RTN","APSSINI0",268,0)
 ; Method 2
"RTN","APSSINI0",269,0)
 ; There is no license for the state the facility is in then,
"RTN","APSSINI0",270,0)
 ; return NULL even if other states have a valid license defined.
"RTN","APSSINI0",271,0)
 ;
"RTN","APSSINI0",272,0)
 ; Method 3
"RTN","APSSINI0",273,0)
 ; Return first valid license found regardless of state
"RTN","APSSINI0",274,0)
 ; No valid license found, then return NULL
"RTN","APSSINI0",275,0)
 ;
"RTN","APSSINI0",276,0)
 ;EOD
"RTN","APSSINI0",277,0)
 Q
"RTN","APSSLIC")
0^1^B17771025
"RTN","APSSLIC",1,0)
APSSLIC ;IHS/MSC/MDM - ScriptPro Interface;28-Sep-2007 10:47;SM
"RTN","APSSLIC",2,0)
 ;;1.0;IHS SCRIPTPRO INTERFACE;**1**;January 11, 2006
"RTN","APSSLIC",3,0)
 ; Call via entry point placed in Transform Field of File 9009033.3
"RTN","APSSLIC",4,0)
 ; Direct entry not supported
"RTN","APSSLIC",5,0)
 Q
"RTN","APSSLIC",6,0)
EP1(APSSPIEN,APSSMETH) ;MDM - Main entry point
"RTN","APSSLIC",7,0)
 ;
"RTN","APSSLIC",8,0)
 ; Provider IEN required
"RTN","APSSLIC",9,0)
 I '$G(APSSPIEN) Q ""
"RTN","APSSLIC",10,0)
 ; Processing Method Required
"RTN","APSSLIC",11,0)
 I '$G(APSSMETH) Q ""
"RTN","APSSLIC",12,0)
 ;
"RTN","APSSLIC",13,0)
 ; Data from Sub-File LICENSING STATE (#200.541)(multiple) from NEW PERSON File (#200)
"RTN","APSSLIC",14,0)
 ; Data from LOCATION FILE (#9999999.06)
"RTN","APSSLIC",15,0)
 ;
"RTN","APSSLIC",16,0)
 ; APSSPIEN = Provider Internal Entry Number passed from calling routine.
"RTN","APSSLIC",17,0)
 ; APSSMETH = Processing Method
"RTN","APSSLIC",18,0)
 ;
"RTN","APSSLIC",19,0)
 ; Method 1
"RTN","APSSLIC",20,0)
 ; Match it to the state the facility is in
"RTN","APSSLIC",21,0)
 ; If there is no license for that state then return any valid license
"RTN","APSSLIC",22,0)
 ; If no valid license found for any state then return NULL
"RTN","APSSLIC",23,0)
 ;
"RTN","APSSLIC",24,0)
 ; Method 2
"RTN","APSSLIC",25,0)
 ; There is no license for the state the facility is in then,
"RTN","APSSLIC",26,0)
 ; return NULL even if other states have a valid license defined.
"RTN","APSSLIC",27,0)
 ;
"RTN","APSSLIC",28,0)
 ; Method 3
"RTN","APSSLIC",29,0)
 ; Return first valid license found regardless of state
"RTN","APSSLIC",30,0)
 ; No valid license found, then return NULL
"RTN","APSSLIC",31,0)
 ;
"RTN","APSSLIC",32,0)
 ;
"RTN","APSSLIC",33,0)
 ; APSSENT = Entry in the LICENSING STATE(multiple)
"RTN","APSSLIC",34,0)
 ; APSSKEY = Key to the LICENSING STATE(multiple)
"RTN","APSSLIC",35,0)
 ; APSSLNO = Active License Number for the Provider
"RTN","APSSLIC",36,0)
 ; APSSEDT = The Expiration Date for the Provider's License
"RTN","APSSLIC",37,0)
 ; APSSIDT = The Internal Format Expiration Date for the Provider's License used to compare dates
"RTN","APSSLIC",38,0)
 ; APSSFLOC= Facility Location (State) as determined by the users facility ID in DUZ(2)
"RTN","APSSLIC",39,0)
 ; APSSTATE = License Issuing State
"RTN","APSSLIC",40,0)
 ; APSSTMP = Temporary holding variable
"RTN","APSSLIC",41,0)
 ; APSSTMP1 = Temporary holding variable
"RTN","APSSLIC",42,0)
 ;
"RTN","APSSLIC",43,0)
 N APSSLNO,APSSEDT,APSSDAT,APSSENT,APSSLNO,APSSKEY,APSSENT,APSSIDT,APSSEXIT,APSSFLOC,APSSTATE
"RTN","APSSLIC",44,0)
 N APSSTMP,APSSTMP1
"RTN","APSSLIC",45,0)
 ;
"RTN","APSSLIC",46,0)
 ; This section processes each entry.
"RTN","APSSLIC",47,0)
 ;
"RTN","APSSLIC",48,0)
 S (APSSENT,APSSEXIT)=0,(APSSLNO,APSSTMP)="" ; Initialize working variables
"RTN","APSSLIC",49,0)
 ;
"RTN","APSSLIC",50,0)
 ; To check for the License based on the state the facility is located in
"RTN","APSSLIC",51,0)
1 ; the LOCATION file# (9999999.06) must have the state defined in field .23
"RTN","APSSLIC",52,0)
 S APSSFLOC=$$GET1^DIQ(9999999.06,DUZ(2),.23) ; Facility Location (State)
"RTN","APSSLIC",53,0)
 ;
"RTN","APSSLIC",54,0)
 ; If the processing Method is 1 or 2 and the facility state is NULL then quit processing.
"RTN","APSSLIC",55,0)
 I (APSSMETH=1!(APSSMETH=2)),APSSFLOC="" Q APSSLNO
"RTN","APSSLIC",56,0)
 ;
"RTN","APSSLIC",57,0)
 ; Order through each file entry for this provider.
"RTN","APSSLIC",58,0)
 F  S APSSENT=$O(^VA(200,APSSPIEN,"PS1",APSSENT)) Q:('APSSENT)!(APSSEXIT)  D
"RTN","APSSLIC",59,0)
 . ; Initialize the key to the file
"RTN","APSSLIC",60,0)
 . S APSSKEY=APSSENT_","_APSSPIEN_","
"RTN","APSSLIC",61,0)
 . ; Retrieve data using FileMan API
"RTN","APSSLIC",62,0)
 . S APSSTATE=$$GET1^DIQ(200.541,APSSKEY,.01) ; Field .01 License Issuing State
"RTN","APSSLIC",63,0)
 . S APSSTMP=$$GET1^DIQ(200.541,APSSKEY,1) ; Field 1 License Number
"RTN","APSSLIC",64,0)
 . S APSSIDT=$$GET1^DIQ(200.541,APSSKEY,2,"I") ; Field 2 Expiration Date Internal format
"RTN","APSSLIC",65,0)
 . S APSSEDT=$$FMTE^XLFDT(APSSIDT,"5DZ0") ; Field 2 Expiration Date External format conversion
"RTN","APSSLIC",66,0)
 . ;
"RTN","APSSLIC",67,0)
 . ; Processing Method
"RTN","APSSLIC",68,0)
 . I APSSMETH=1 D
"RTN","APSSLIC",69,0)
 . . ; Grab the first valid License regardless of state
"RTN","APSSLIC",70,0)
 . . I (APSSIDT>DT)&(APSSTMP="") S APSSTMP1=APSSTMP
"RTN","APSSLIC",71,0)
 . . ; If the state matches the facility location AND the license is valid stop further processing
"RTN","APSSLIC",72,0)
 . . I (APSSTATE=APSSFLOC)&(APSSIDT>DT) S APSSLNO=APSSTMP,APSSEXIT=1 Q
"RTN","APSSLIC",73,0)
 . . Q
"RTN","APSSLIC",74,0)
 . I APSSMETH=2 D
"RTN","APSSLIC",75,0)
 . . ; If the state matches the facility location AND the license is valid stop further processing
"RTN","APSSLIC",76,0)
 . . I (APSSTATE=APSSFLOC)&(APSSIDT>DT) S APSSLNO=APSSTMP,APSSEXIT=1 Q
"RTN","APSSLIC",77,0)
 . . Q
"RTN","APSSLIC",78,0)
 . I APSSMETH=3 D
"RTN","APSSLIC",79,0)
 . .  ; Stop processing any more entries once valid entry is found.
"RTN","APSSLIC",80,0)
 . . I APSSIDT>DT S APSSLNO=APSSTMP,APSSEXIT=1 Q
"RTN","APSSLIC",81,0)
 . . Q
"RTN","APSSLIC",82,0)
 . Q
"RTN","APSSLIC",83,0)
 ; If processing Method 1 and no license number was found for the facility location
"RTN","APSSLIC",84,0)
 ; but a valid license was found from a different state than that of the
"RTN","APSSLIC",85,0)
 ; facility location then use the license that was found.
"RTN","APSSLIC",86,0)
 I (APSSLNO="")&(APSSMETH=1) S APSSLNO=APSSTMP
"RTN","APSSLIC",87,0)
 ; Return value
"RTN","APSSLIC",88,0)
 Q APSSLNO
"RTN","APSSLIC",89,0)
 ;
"RTN","APSSLIC",90,0)
SDEA(CLIN) ; Site DEA Number
"RTN","APSSLIC",91,0)
 N INST,SDEA
"RTN","APSSLIC",92,0)
 I CLIN="" Q $$GET1^DIQ(4,+$$SITE^VASITE,52,"E")
"RTN","APSSLIC",93,0)
 S SDEA=""
"RTN","APSSLIC",94,0)
 S INST=$$GET1^DIQ(44,CLIN,3,"I")
"RTN","APSSLIC",95,0)
 S SDEA=$$GET1^DIQ(4,INST,52,"E")
"RTN","APSSLIC",96,0)
 I SDEA="" S SDEA=$$GET1^DIQ(4,+$$SITE^VASITE,52,"E")
"RTN","APSSLIC",97,0)
 Q SDEA
"RTN","APSSLIC",98,0)
 ;
"RTN","APSSLIC",99,0)
SNAME(CLIN) ; Site Name
"RTN","APSSLIC",100,0)
 N INST,SNAME
"RTN","APSSLIC",101,0)
 I 'CLIN Q $P($$SITE^VASITE,U,2)
"RTN","APSSLIC",102,0)
 S INST=$$GET1^DIQ(44,CLIN,3,"I")
"RTN","APSSLIC",103,0)
 S SNAME=$$GET1^DIQ(4,INST,.01,"E")
"RTN","APSSLIC",104,0)
 I SNAME="" S SNAME=$P($$SITE^VASITE,U,2)
"RTN","APSSLIC",105,0)
 Q SNAME
"RTN","APSSLIC",106,0)
PADDR(PAT) ; Patient Address
"RTN","APSSLIC",107,0)
 N ADDR,ADDR1,ADDR2,ADDR3,CITY,STATE,ZIP,PADDR
"RTN","APSSLIC",108,0)
 S IENS=PAT_","
"RTN","APSSLIC",109,0)
 D GETS^DIQ(2,IENS,".111;.112;.113;.114;.115;.1112","E","PADDR")
"RTN","APSSLIC",110,0)
 S ADDR=$G(PADDR(2,IENS,.111,"E"))_U_$G(PADDR(2,IENS,.112,"E"))_U_$G(PADDR(2,IENS,.113,"E"))_U_$G(PADDR(2,IENS,.114,"E"))_U_$G(PADDR(2,IENS,.115,"E"))_U_$G(PADDR(2,IENS,.1112,"E"))
"RTN","APSSLIC",111,0)
 Q ADDR
"RTN","APSSNTE1")
0^4^B3150172
"RTN","APSSNTE1",1,0)
APSSNTE1 ;ISC/XTSUMBLD KERNEL - Package checksum checker ;3080627.125714
"RTN","APSSNTE1",2,0)
 ;;1.0;IHS SCRIPTPRO INTERFACE;;Jun 25,2008
"RTN","APSSNTE1",3,0)
 ;;7.3;3080627.125714
"RTN","APSSNTE1",4,0)
 S XT4="I 1",X=$T(+3) W !!,"Checksum routine created on ",$P(X,";",4)," by KERNEL V",$P(X,";",3),!
"RTN","APSSNTE1",5,0)
CONT F XT1=1:1 S XT2=$T(ROU+XT1) Q:XT2=""  S X=$P(XT2," ",1),XT3=$P(XT2,";",3) X XT4 I $T W !,X X ^%ZOSF("TEST") S:'$T XT3=0 X:XT3 ^%ZOSF("RSUM") W ?10,$S('XT3:"Routine not in UCI",XT3'=Y:"Calculated "_$C(7)_Y_", off by "_(Y-XT3),1:"ok")
"RTN","APSSNTE1",6,0)
 ;
"RTN","APSSNTE1",7,0)
 K %1,%2,%3,X,Y,XT1,XT2,XT3,XT4 Q
"RTN","APSSNTE1",8,0)
ONE S XT4="I $D(^UTILITY($J,X))",X=$T(+3) W !!,"Checksum routine created on ",$P(X,";",4)," by KERNEL V",$P(X,";",3),!
"RTN","APSSNTE1",9,0)
 W !,"Check a subset of routines:" K ^UTILITY($J) X ^%ZOSF("RSEL")
"RTN","APSSNTE1",10,0)
 W ! G CONT
"RTN","APSSNTE1",11,0)
ROU ;;
"RTN","APSSNTE1",12,0)
APSSLIC ;;5902284
"RTN","APSSNTE1",13,0)
APSSSPRO ;;5208041
"RTN","APSSNTE1",14,0)
APSSINI0 ;;10492702
"RTN","APSSSPRO")
0^2^B25035830
"RTN","APSSSPRO",1,0)
APSSSPRO ;IHS/CIA/PLS - ScriptPro Interface;06-Dec-2007 15:06;SM
"RTN","APSSSPRO",2,0)
 ;;1.0;IHS SCRIPTPRO INTERFACE;**1**;January 11, 2006
"RTN","APSSSPRO",3,0)
 ;Call via entry point placed in Field 900 of File 9009033
"RTN","APSSSPRO",4,0)
 ;Direct entry not supported
"RTN","APSSSPRO",5,0)
 ; Modified - IHS/MSC/PLS - 02/08/07 - Line ASK+2 - Added check for ZTSK
"RTN","APSSSPRO",6,0)
 ;                          12/06/07 - Line ASK+7 - Changed duplicate check for DTOUT to check for DUOUT
"RTN","APSSSPRO",7,0)
 Q
"RTN","APSSSPRO",8,0)
EP1(RXIEN,REPRINT,SGY,RXF,RXPI) ;PEP	- Main entry point
"RTN","APSSSPRO",9,0)
 N APSS,RX0,RX2,RX3,REFIEN,RXSTAT,QTY
"RTN","APSSSPRO",10,0)
 N ZTRTN,ZTIO,ZTDESC,ZTREQ,ZTSAVE,VAR,ZTSK
"RTN","APSSSPRO",11,0)
 Q:'$G(RXIEN)  ; Prescription IEN required
"RTN","APSSSPRO",12,0)
 Q:'$D(^APSSPARM($G(DUZ(2))))
"RTN","APSSSPRO",13,0)
 Q:'$$SETUP(DUZ(2),.APSS)
"RTN","APSSSPRO",14,0)
TASK ;
"RTN","APSSSPRO",15,0)
 I $G(APSS("ASK")),'$$ASK("Send to SCRIPT-PRO") U IO Q
"RTN","APSSSPRO",16,0)
 Q:'$G(APSS("DEV"))  ; No device
"RTN","APSSSPRO",17,0)
 S ZTRTN="EPTASK^APSSSPRO"
"RTN","APSSSPRO",18,0)
 S ZTDESC="ScriptPro Interface for RXIEN: "_RXIEN
"RTN","APSSSPRO",19,0)
 S ZTDTH=$H
"RTN","APSSSPRO",20,0)
 S ZTIO="`"_APSS("DEV")
"RTN","APSSSPRO",21,0)
 F VAR="RXIEN","REPRINT","SGY(","RXF","RXPI" S:$D(VAR) ZTSAVE(VAR)=""
"RTN","APSSSPRO",22,0)
 D ^%ZTLOAD
"RTN","APSSSPRO",23,0)
 Q
"RTN","APSSSPRO",24,0)
 ;
"RTN","APSSSPRO",25,0)
EPTASK ;EP - Tasked entry point
"RTN","APSSSPRO",26,0)
 Q:'$$SETUP(DUZ(2),.APSS)
"RTN","APSSSPRO",27,0)
 D INIT
"RTN","APSSSPRO",28,0)
 ;
"RTN","APSSSPRO",29,0)
 Q:'$$DRUGOK($$GETP(RX0,6))
"RTN","APSSSPRO",30,0)
 ;
"RTN","APSSSPRO",31,0)
 ; Build output from Table
"RTN","APSSSPRO",32,0)
 S APSSREC=""
"RTN","APSSSPRO",33,0)
 S APSSCMD=$$FIND1^DIC(9009033.3,,,"FILL")
"RTN","APSSSPRO",34,0)
 Q:'APSSCMD
"RTN","APSSSPRO",35,0)
 D BLDFARY(.APSSFARY,APSSCMD)
"RTN","APSSSPRO",36,0)
 ;
"RTN","APSSSPRO",37,0)
 D SETRM(0)
"RTN","APSSSPRO",38,0)
 U IO W $$PROCARY(APSSCMD,.APSSFARY,.APSSREC)
"RTN","APSSSPRO",39,0)
 D:APSS("LOG") LOG(APSSREC,.SGY)
"RTN","APSSSPRO",40,0)
 Q
"RTN","APSSSPRO",41,0)
 ; Build field array
"RTN","APSSSPRO",42,0)
BLDFARY(ARY,CIEN) ;
"RTN","APSSSPRO",43,0)
 N IEN,SEQ
"RTN","APSSSPRO",44,0)
 S IEN=0
"RTN","APSSSPRO",45,0)
 F  S IEN=$O(^APSSCOMD(CIEN,1,IEN)) Q:'IEN  D
"RTN","APSSSPRO",46,0)
 .S SEQ=+$P($G(^APSSCOMD(CIEN,1,IEN,0)),U,2)
"RTN","APSSSPRO",47,0)
 .S:SEQ>0 ARY(SEQ)=IEN
"RTN","APSSSPRO",48,0)
 Q
"RTN","APSSSPRO",49,0)
 ; Initialize output array
"RTN","APSSSPRO",50,0)
PROCARY(CIEN,FLDS,RET) ;
"RTN","APSSSPRO",51,0)
 N LP,VNM
"RTN","APSSSPRO",52,0)
 D ADD("|**|<COMMAND>FILL")
"RTN","APSSSPRO",53,0)
 S LP=0 F  S LP=$O(FLDS(LP)) Q:'LP  D
"RTN","APSSSPRO",54,0)
 .S VNM=$P(^APSSCOMD(CIEN,1,FLDS(LP),0),U)
"RTN","APSSSPRO",55,0)
 .D ADD("<"_VNM_">"_$$DATA(CIEN,FLDS(LP),RXIENS))
"RTN","APSSSPRO",56,0)
 D ADD("|##|"_$C(13,10))
"RTN","APSSSPRO",57,0)
 Q RET
"RTN","APSSSPRO",58,0)
 ; Return data for given tag
"RTN","APSSSPRO",59,0)
DATA(CMDIEN,TAGIEN,RXIENS) ;
"RTN","APSSSPRO",60,0)
 N TAG0,FILE,FLD
"RTN","APSSSPRO",61,0)
 S TAG0=$G(^APSSCOMD(CMDIEN,1,TAGIEN,0))
"RTN","APSSSPRO",62,0)
 S FILE=$P($P(TAG0,U,3),",")
"RTN","APSSSPRO",63,0)
 S FLD=$P($P(TAG0,U,3),",",2)
"RTN","APSSSPRO",64,0)
 S FMT=$P(TAG0,U,4)
"RTN","APSSSPRO",65,0)
 I $L(RXIENS,",")>2 D
"RTN","APSSSPRO",66,0)
 .S RXIENS=$S($F(FMT,"R"):RXIENS,1:$P(RXIENS,",",2)_",")
"RTN","APSSSPRO",67,0)
 S VAL=""
"RTN","APSSSPRO",68,0)
 I FILE,FLD D
"RTN","APSSSPRO",69,0)
 .S VAL=$$GET1^DIQ(FILE,RXIENS,FLD,$S(FMT["I":"I",1:"E"))
"RTN","APSSSPRO",70,0)
 ; Check for Transform code
"RTN","APSSSPRO",71,0)
 I $F(FMT,"Z")>0 D
"RTN","APSSSPRO",72,0)
 .X:$L($G(^APSSCOMD(CMDIEN,1,TAGIEN,1))) ^APSSCOMD(CMDIEN,1,TAGIEN,1)
"RTN","APSSSPRO",73,0)
 ; Check for Date Format
"RTN","APSSSPRO",74,0)
 I $F(FMT,"D")>0 D
"RTN","APSSSPRO",75,0)
 .S FMTD=$E(FMT,$F(FMT,"D"))
"RTN","APSSSPRO",76,0)
 .S VAL=$TR($$FMTE^XLFDT(VAL,$S(FMTD=2:"7",1:"5")_"Z"),"/","")
"RTN","APSSSPRO",77,0)
 .S:FMTD=3 VAL=$E(VAL,1,2)_$E(VAL,5,8)
"RTN","APSSSPRO",78,0)
 Q VAL
"RTN","APSSSPRO",79,0)
 ; Add a node to the output array
"RTN","APSSSPRO",80,0)
ADD(VAL) ;
"RTN","APSSSPRO",81,0)
 S RET=$G(RET,"")_VAL
"RTN","APSSSPRO",82,0)
 Q
"RTN","APSSSPRO",83,0)
SETUP(FAC,APSS) ;EP - Build configuration array
"RTN","APSSSPRO",84,0)
 N PARAM
"RTN","APSSSPRO",85,0)
 S APSS("PFL")="N"
"RTN","APSSSPRO",86,0)
 S (PARAM,APSS("PARM"))=$G(^APSSPARM(FAC,0))
"RTN","APSSSPRO",87,0)
 Q:'PARAM 0
"RTN","APSSSPRO",88,0)
 Q:'$$GETP(PARAM,2) 0   ; Interface is turned off
"RTN","APSSSPRO",89,0)
 S APSS("DEV")=+$$GETP(PARAM,3)
"RTN","APSSSPRO",90,0)
 S APSS("SIGLINE")=$S($$GETP(PARAM,4):$$GETP(PARAM,4),1:30)
"RTN","APSSSPRO",91,0)
 S APSS("CHKDRG")=''$$GETP(PARAM,5)
"RTN","APSSSPRO",92,0)
 S APSS("ASK")=''$$GETP(PARAM,6)
"RTN","APSSSPRO",93,0)
 S APSS("LOG")=''$$GETP(PARAM,7)
"RTN","APSSSPRO",94,0)
 Q 1
"RTN","APSSSPRO",95,0)
 ;
"RTN","APSSSPRO",96,0)
INIT ;EP - Build data for prescription
"RTN","APSSSPRO",97,0)
 S RX0=$G(^PSRX(RXIEN,0))
"RTN","APSSSPRO",98,0)
 S RX2=$G(^PSRX(RXIEN,2))
"RTN","APSSSPRO",99,0)
 S RX3=$G(^PSRX(RXIEN,3))
"RTN","APSSSPRO",100,0)
 S RXSTAT=$G(^PSRX(RXIEN,"STA"))
"RTN","APSSSPRO",101,0)
 S PARIEN=+$G(RXPI)
"RTN","APSSSPRO",102,0)
 ;S REFIEN=+$O(^PSRX(RXIEN,1,$C(1)),-1)
"RTN","APSSSPRO",103,0)
 S REFIEN=+$G(RXF)
"RTN","APSSSPRO",104,0)
 S QTY=+$S(PARIEN:$P($G(^PSRX(RXIEN,"P",PARIEN,0)),U,4),REFIEN:$P($G(^PSRX(RXIEN,1,REFIEN,0)),U,4),1:$P(RX0,U,7))
"RTN","APSSSPRO",105,0)
 S RXIENS=$S(PARIEN:PARIEN_",",REFIEN:REFIEN_",",1:"")_RXIEN_","
"RTN","APSSSPRO",106,0)
 Q
"RTN","APSSSPRO",107,0)
 ; Log transmission
"RTN","APSSSPRO",108,0)
LOG(REC,SGY) ;
"RTN","APSSSPRO",109,0)
 N APSSNOW,LP
"RTN","APSSSPRO",110,0)
 S APSSNOW=$$NOW^XLFDT
"RTN","APSSSPRO",111,0)
 L +^XTMP("APSSSPRO"):2
"RTN","APSSSPRO",112,0)
 S ^XTMP("APSSSPRO",0)=$$FMADD^XLFDT(DT,7)_U_$$DT^XLFDT
"RTN","APSSSPRO",113,0)
 S ^XTMP("APSSSPRO",RXIEN,APSSNOW)=REC
"RTN","APSSSPRO",114,0)
 S LP=0 F  S LP=$O(SGY(LP)) Q:'LP  S ^XTMP("APSSSPRO",RXIEN,APSSNOW,LP)=SGY(LP)
"RTN","APSSSPRO",115,0)
 L -^XTMP("APSSSPRO")
"RTN","APSSSPRO",116,0)
 Q
"RTN","APSSSPRO",117,0)
 ; Check drug availability in ScriptPro
"RTN","APSSSPRO",118,0)
DRUGOK(DRUGIEN) ;EP
"RTN","APSSSPRO",119,0)
 I 'APSS("CHKDRG") Q 1    ; Drug checking is disabled
"RTN","APSSSPRO",120,0)
 N PARAM
"RTN","APSSSPRO",121,0)
 S PARAM=$G(^APSSDRUG(DRUGIEN,0))
"RTN","APSSSPRO",122,0)
 Q:'$$GETP(PARAM,1) 0     ; Drug not present
"RTN","APSSSPRO",123,0)
 Q:'$$GETP(PARAM,3) 1     ; Inactive date not present
"RTN","APSSSPRO",124,0)
 I $$GETP(PARAM,3)<$$FMADD^XLFDT(DT,1) Q 0    ; Drug has been deactivated
"RTN","APSSSPRO",125,0)
 Q '(QTY>$$GETP(PARAM,2))    ; Quantity
"RTN","APSSSPRO",126,0)
 ;
"RTN","APSSSPRO",127,0)
CHKDRUG(RXIEN) ; PEP - Logic called from field 800 in APSP Control file
"RTN","APSSSPRO",128,0)
 N APSS,RX0,RX2,RX3,REFIEN,RXSTAT,QTY
"RTN","APSSSPRO",129,0)
 Q:'$$SETUP($G(DUZ(2)),.APSS) 0
"RTN","APSSSPRO",130,0)
 D INIT
"RTN","APSSSPRO",131,0)
 Q $$DRUGOK($$GETP(RX0,6))
"RTN","APSSSPRO",132,0)
 ; Returns given piece of supplied string
"RTN","APSSSPRO",133,0)
GETP(VAL,P) ;EP
"RTN","APSSSPRO",134,0)
 Q $P(VAL,U,P)
"RTN","APSSSPRO",135,0)
SIG() ;
"RTN","APSSSPRO",136,0)
 S APSS("SIG")=""
"RTN","APSSSPRO",137,0)
 S N=0
"RTN","APSSSPRO",138,0)
 F  S N=$O(SGY(N)) Q:'N  D
"RTN","APSSSPRO",139,0)
 .I APSS("SIG")="" S APSS("SIG")=SGY(N) Q
"RTN","APSSSPRO",140,0)
 .S APSS("SIG")=APSS("SIG")_SGY(N)
"RTN","APSSSPRO",141,0)
 Q:$Q APSS("SIG")
"RTN","APSSSPRO",142,0)
 Q
"RTN","APSSSPRO",143,0)
 ; Return priority
"RTN","APSSSPRO",144,0)
GETPRI(LOCIEN) ;EP
"RTN","APSSSPRO",145,0)
 Q:'$G(LOCIEN) 0
"RTN","APSSSPRO",146,0)
 Q $S($D(^APSSPARM(DUZ(2),1,LOCIEN,0)):+$$GETP(^APSSPARM(DUZ(2),1,LOCIEN,0),2),1:1)
"RTN","APSSSPRO",147,0)
 ;
"RTN","APSSSPRO",148,0)
ASK(PRMPT) ;EP - Prompt user for transmission to ScriptPro
"RTN","APSSSPRO",149,0)
 N DIR,DTOUT,DUOUT
"RTN","APSSSPRO",150,0)
 I $E(IOST,1)="P"!$G(ZTSK) Q 1  ; User input not available for queued tasks or print devices
"RTN","APSSSPRO",151,0)
 S DIR("A")=PRMPT  ;"Send to SCRIPT-PRO"
"RTN","APSSSPRO",152,0)
 S DIR("B")="N"
"RTN","APSSSPRO",153,0)
 S DIR(0)="Y"
"RTN","APSSSPRO",154,0)
 D ^DIR
"RTN","APSSSPRO",155,0)
 Q:$D(DTOUT)!($D(DUOUT)) 0
"RTN","APSSSPRO",156,0)
 Q Y>0
"RTN","APSSSPRO",157,0)
 ; Query for drug
"RTN","APSSSPRO",158,0)
HASDRUG(DRUG) ; EP
"RTN","APSSSPRO",159,0)
 Q:'$G(DRUG) 0
"RTN","APSSSPRO",160,0)
 Q ''$D(^APSSDRUG(DRUG))
"RTN","APSSSPRO",161,0)
 ; Set Right Margin of output device
"RTN","APSSSPRO",162,0)
SETRM(X) ;
"RTN","APSSSPRO",163,0)
 X ^%ZOSF("RM")
"RTN","APSSSPRO",164,0)
 Q
"VER")
8.0^22.0
**END**
**END**