                   V. A.  C R O S S  R E F E R E N C E R  7.3
                       [2008 VA Standards & Conventions]
                  UCI: VISTA CPU: ROU    Jun 28, 2016@13:15:59

The BUILD file Data Dictionaries are being processed.

The option and function files are being processed.


Routines are being processed.
Routines: 15  Faux Routines: 0

ORALWORD  ORY4270   ORY42701  ORY42702  ORY42703  ORY42704  ORY42705  ORY42706  
ORY42707  ORY42708  ORY4271   ORY4272   ORY4273   ORY4274   ORY427ES  

--- CROSS REFERENCING ---


Compiled list of Errors and Warnings              Jun 28, 2016@13:15:59 page 1
No errors or warnings to report


ORALWORD   11511     printed  Jun 28, 2016@13:15:59                    Page 2

ORALWORD  ; SLC/JMH - Utilities for Checking if an order can be ordered ; 5/10/0
7 5:55am
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,427**;Dec 17, 1997;Build 242
 +2       ;
ALLWORD(ORY,DFN,ORX,ORTYPE,PROV) ;
 +1        NEW OROI,ORYS,QOIEN,QPIEN,ORCLOZ,QOAA
 +2        SET OROI=0
           SET ^TMP("RJS",$JOB)=$GET(XQSAV)_"^"_$GET(XQY0)_"^"_$GET(XQZ)
 +3       ;
 +4       ;ORTYPE used to determine the type of data coming into the call
 +5       ;ORYTPE="E" existing order, ORX equal the IEN from file 100 (used with
 +6       ;copy,edit functionality)
 +7       ;ORTYPE="Q" Quick Order, ORX equal the IEN from file 101.43
 +8       ;ORTYPE="N" New order, ORX equal the IEN from file 101.41
 +9       ;
 +10       IF ORTYPE="E"
               SET OROI=$GET(^OR(100,ORX,.1,1,0))
 +11       IF ORTYPE="Q"
               Begin DoDot:1
 +12               SET QPIEN=$ORDER(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM","")
)
                   IF QPIEN'>0
                       QUIT 
 +13               SET QOIEN=$ORDER(^ORD(101.41,ORX,6,"D",QPIEN,""))
                   IF QOIEN'>0
                       QUIT 
 +14               SET OROI=$GET(^ORD(101.41,ORX,6,QOIEN,1))
 +15               SET QOAA=$PIECE($GET(^ORD(101.41,ORX,5)),U,8)
               End DoDot:1
 +16       IF ORTYPE="N"
               SET OROI=ORX
 +17       IF OROI'>0
               QUIT 
 +18       SET ORY=0
 +19      ;checks if the orderable item (OROI) is a clozapine med
 +20      ;  if not returns ORY=0
 +21       SET ORCLOZ=$$ISCLOZ(OROI)
           SET ORY=ORY_U_ORCLOZ
           SET ORY(0)=U_ORCLOZ
 +22       IF 'ORCLOZ
               QUIT 
 +23       NEW ORQUIT
 +24       SET ORQUIT=0
 +25       IF '$GET(PROV)
               SET PROV=DUZ
 +26       IF $GET(PROV)
               Begin DoDot:1
 +27               IF '$LENGTH($$DEA^XUSER(,PROV))
                       Begin DoDot:2
 +28                       SET ORQUIT=1
                           SET ORY=1
 +29                       SET ORQUIT=1
                           SET ORY=1
 +30                       SET ORY(1)="*** You are not authorized to place Cloza
pine orders."
 +31                       SET ORY(2)="You must have a DEA#.  Please contact you
r"
 +32                       SET ORY(3)="CAC or IRM for more information. ***"
                       End DoDot:2
 +33               IF ORQUIT
                       QUIT 
 +34               IF '$DATA(^XUSEC("YSCL AUTHORIZED",PROV))
                       Begin DoDot:2
 +35                       SET ORQUIT=1
                           SET ORY=1
 +36                       SET ORY(1)="*** You are not authorized to place Cloza
pine orders."
 +37                       SET ORY(2)="You must hold key YSCL AUTHORIZED.  Pleas
e contact your"
 +38                       SET ORY(3)="CAC or IRM for more information on this k
ey. ***"
                       End DoDot:2
               End DoDot:1
 +39       IF ORQUIT
               QUIT 
 +40      ;  if is a cloz med , check if patient (DFN) can have a clozapine med
 +41       SET ORYS=$$CL^YSCLTST2(DFN)
 +42      ;    if yes returns ORY=0
 +43       IF +ORYS>0
               DO BEFQUIT
               QUIT 
 +44      ;    if no 
 +45      ;      returns 
 +46      ;    ORY=1
 +47      ;    ORY(0)=CAPTION FOR DIALOG BOX
 +48      ;    ORY(1-N)=MESSAGE TO DISPLAY
 +49       SET ORY=1_U_ORCLOZ
           SET ORY(0)="Problem Ordering Clozapine Related Medication"_U_ORCLOZ
 +50      ;patient not in clozapine patient program
 +51      ;; START NCC REMEDIATION >> 427*RJS
 +52       IF +ORYS<0
               Begin DoDot:1
 +53               SET ORY(1)="*** This patient is not registered in the clozapi
ne treatment "
 +54               SET ORY(2)="program or has been discontinued from the program
. A new"
 +55               SET ORY(3)="registration number must be assigned. If this is 
not an emergency,"
 +56               SET ORY(4)="contact the NCCC. For emergency registration duri
ng non-NCCC duty"
 +57               SET ORY(5)="hours, a written order to the pharmacist can be u
sed to process a"
 +58               SET ORY(6)="registration override. ***"
               End DoDot:1
               QUIT 
 +59      ;problem with lab tests
 +60       IF +ORYS=0
               Begin DoDot:1
 +61      ;override allowed
                   IF $$OVERRIDE^YSCLTST2(DFN)
                       SET ORY=0_U_ORCLOZ
                       SET ORY(0)=U_ORCLOZ
                       DO BEFQUIT
                       QUIT 
 +62               IF +$PIECE(ORYS,"^",2)
                       IF $PIECE(ORYS,"^",4)<1000
                           Begin DoDot:2
 +63                           NEW COUNT
                               SET COUNT=0
 +64                           SET COUNT=COUNT+1
                               SET ORY(COUNT)="*** This clozapine drug may not b
e dispensed to the patient at this "
 +65                           SET COUNT=COUNT+1
                               SET ORY(COUNT)="time based on the available lab t
ests related to the clozapine "
 +66                           SET COUNT=COUNT+1
                               SET ORY(COUNT)="treatment program. Please contact
 the NCCC to request an override in"
 +67                           SET COUNT=COUNT+1
                               SET ORY(COUNT)="order to proceed with dispensing 
this drug. ***"
 +68                           IF '$LENGTH($PIECE(ORYS,U,3))!('$LENGTH($PIECE(OR
YS,U,5)))
                                   QUIT 
 +69                           SET COUNT=COUNT+1
                               SET ORY(COUNT)="Related Lab Test(s)"
 +70                           SET COUNT=COUNT+1
                               SET ORY(COUNT)="==================="
 +71      ;the lab values returned by Mental Health are given in 4 digit numbers
 to be standard with 
 +72      ;reporting formats to the NCCC, we are dividing by 1000 to align it wi
th the display of the
 +73      ;labs on the lab tab
 +74      ;S:$L($P(ORYS,U,3)) COUNT=COUNT+1,ORY(COUNT)=$P(ORYS,U,3)_":  "_($P(OR
YS,U,2)/1000)_" K/cmm"
 +75      ;S:$L($P(ORYS,U,5)) COUNT=COUNT+1,ORY(COUNT)=$P(ORYS,U,5)_":  "_($P(OR
YS,U,4)/1000)_" K/cmm"
 +76                           IF $LENGTH($PIECE(ORYS,U,3))
                                   SET COUNT=COUNT+1
                                   SET ORY(COUNT)="WBC:  "_($PIECE(ORYS,U,2)/100
0)_" K/cmm"
 +77                           IF $LENGTH($PIECE(ORYS,U,5))
                                   SET COUNT=COUNT+1
                                   SET ORY(COUNT)="ANC:  "_($PIECE(ORYS,U,4)/100
0)_" K/cmm"
 +78                           SET COUNT=COUNT+1
                               SET ORY(COUNT)="Date/Time of last tests: "_$$DATE
^ORU($PIECE(ORYS,U,6))
                           End DoDot:2
 +79               IF '+$PIECE(ORYS,"^",2)
                       IF +$PIECE(ORYS,"^",4)>1500
                           Begin DoDot:2
 +80                           NEW COUNT
                               SET COUNT=0
 +81                           SET COUNT=COUNT+1
                               SET ORY(COUNT)="*** Permission to dispense clozap
ine has been denied based on the available"
 +82                           SET COUNT=COUNT+1
                               SET ORY(COUNT)="lab tests related to the clozapin
e treatment program.***"
 +83                           SET COUNT=COUNT+1
                               SET ORY(COUNT)=""
 +84                           SET COUNT=COUNT+1
                               SET ORY(COUNT)="The latest lab test results drawn
 in the past 7 days have ANC results but no"
 +85                           SET COUNT=COUNT+1
                               SET ORY(COUNT)="matching WBC. Redo the lab tests 
or contact the NCCC for a National Override"
 +86                           SET COUNT=COUNT+1
                               SET ORY(COUNT)="to dispense clozapine with no mat
ching WBC results."
 +87                           IF '$LENGTH($PIECE(ORYS,U,3))!('$LENGTH($PIECE(OR
YS,U,5)))
                                   QUIT 
 +88                           SET COUNT=COUNT+1
                               SET ORY(COUNT)="Related Lab Test(s)"
 +89                           SET COUNT=COUNT+1
                               SET ORY(COUNT)="==================="
 +90      ;the lab values returned by Mental Health are given in 4 digit numbers
 to be standard with 
 +91      ;reporting formats to the NCCC, we are dividing by 1000 to align it wi
th the display of the
 +92      ;labs on the lab tab
 +93      ;S:$L($P(ORYS,U,3)) COUNT=COUNT+1,ORY(COUNT)=$P(ORYS,U,3)_":  "_($P(OR
YS,U,2)/1000)_" K/cmm"
 +94      ;S:$L($P(ORYS,U,5)) COUNT=COUNT+1,ORY(COUNT)=$P(ORYS,U,5)_":  "_($P(OR
YS,U,4)/1000)_" K/cmm"
 +95                           IF $LENGTH($PIECE(ORYS,U,3))
                                   SET COUNT=COUNT+1
                                   SET ORY(COUNT)="WBC:  "_($PIECE(ORYS,U,2)/100
0)_" K/cmm"
 +96                           IF $LENGTH($PIECE(ORYS,U,5))
                                   SET COUNT=COUNT+1
                                   SET ORY(COUNT)="ANC:  "_($PIECE(ORYS,U,4)/100
0)_" K/cmm"
 +97                           SET COUNT=COUNT+1
                               SET ORY(COUNT)="Date/Time of last tests: "_$$DATE
^ORU($PIECE(ORYS,U,6))
                           End DoDot:2
 +98               IF '+$PIECE(ORYS,"^",2)
                       IF '+$PIECE(ORYS,"^",4)
                           DO MSG
                           QUIT 
 +99               IF '+$PIECE(ORYS,"^",4)
                       IF +$PIECE(ORYS,"^",2)
                           DO MSG
                           QUIT 
               End DoDot:1
               QUIT 
 +100      QUIT 
MSG       ;
 +1        NEW COUNT
           SET COUNT=0
 +2        SET COUNT=COUNT+1
           SET ORY(COUNT)="*** Permission to dispense clozapine has been denied 
based on the"
 +3        SET COUNT=COUNT+1
           SET ORY(COUNT)="available lab tests related to the clozapine treatmen
t program. ***"
 +4        SET COUNT=COUNT+1
           SET ORY(COUNT)=""
 +5        SET COUNT=COUNT+1
           SET ORY(COUNT)="For a National Override to dispense at the patient's 
normal"
 +6        SET COUNT=COUNT+1
           SET ORY(COUNT)="frequency, contact the NCCC."
 +7        SET COUNT=COUNT+1
           SET ORY(COUNT)=""
 +8       ;; NCC REMEDIATION << 427 RTW Special Conditions selections for outpat
ient and inpatient RTW
           IF $DATA(X0)
               Begin DoDot:1
 +9                IF $PIECE(X0,U,1)["PSO"
                       Begin DoDot:2
 +10                       SET COUNT=COUNT+1
                           SET ORY(COUNT)="A local emergency override for an Out
patient can be approved for:"
 +11                       SET COUNT=COUNT+1
                           SET ORY(COUNT)="(1) weather-related conditions, (2) m
ail order delays of clozapine,"
 +12                       SET COUNT=COUNT+1
                           SET ORY(COUNT)="or (3) inpatient going on leave."
 +13                       SET COUNT=COUNT+1
                           SET ORY(COUNT)=""
 +14                       SET COUNT=COUNT+1
                           SET ORY(COUNT)="For an Outpatient Special Conditions 
Local Override, a written prescription from"
 +15                       SET COUNT=COUNT+1
                           SET ORY(COUNT)="the provider with documentation to th
e pharmacist is required to dispense"
 +16                       SET COUNT=COUNT+1
                           SET ORY(COUNT)="a one-time emergency 4-day supply."
                       End DoDot:2
 +17               IF $PIECE(X0,U,1)["PSJ"
                       Begin DoDot:2
 +18                       SET COUNT=COUNT+1
                           SET ORY(COUNT)="A local emergency override for an Inp
atient can be approved for:"
 +19                       SET COUNT=COUNT+1
                           SET ORY(COUNT)="IP Order Override with Outside Lab Re
sults"
 +20                       SET COUNT=COUNT+1
                           SET ORY(COUNT)=""
 +21                       SET COUNT=COUNT+1
                           SET ORY(COUNT)="For a Special Conditions Local Overri
de, a written order from"
 +22                       SET COUNT=COUNT+1
                           SET ORY(COUNT)="the provider with documentation to th
e pharmacist is required to"
 +23                       SET COUNT=COUNT+1
                           SET ORY(COUNT)="dispense a one-time 4-day supply."
 +24                       SET COUNT=COUNT+1
                           SET ORY(COUNT)=""
 +25                       SET COUNT=COUNT+1
                           SET ORY(COUNT)="The provider must record the ANC from
 another facility including date/time in both the Provider Progress Note and Com
ment field in CPRS."
                       End DoDot:2
               End DoDot:1
 +26       IF '$LENGTH($PIECE(ORYS,U,3))!('$LENGTH($PIECE(ORYS,U,5)))
               QUIT 
 +27       SET COUNT=COUNT+1
           SET ORY(COUNT)="Related Lab Test(s)"
 +28       SET COUNT=COUNT+1
           SET ORY(COUNT)="==================="
 +29       IF $LENGTH($PIECE(ORYS,U,3))
               SET COUNT=COUNT+1
               SET ORY(COUNT)="WBC:  "_($PIECE(ORYS,U,2)/1000)_" K/cmm"
 +30       IF $LENGTH($PIECE(ORYS,U,5))
               SET COUNT=COUNT+1
               SET ORY(COUNT)="ANC:  "_($PIECE(ORYS,U,4)/1000)_" K/cmm"
 +31       SET COUNT=COUNT+1
           SET ORY(COUNT)="Date/Time of last tests: "_$$DATE^ORU($PIECE(ORYS,U,6
))
 +32       QUIT 
 +33      ;; END NCC REMEDIATION << 427*RTW
BEFQUIT   ;
 +1        IF '$GET(QOAA)
               QUIT 
 +2        NEW QODS,QORF,ORMAX,ORCLPAT
 +3        SET QODS=$ORDER(^ORD(101.41,"AB","OR GTX DAYS SUPPLY",""))
           IF QODS'>0
               QUIT 
 +4        SET QODS=$ORDER(^ORD(101.41,ORX,6,"D",QODS,""))
           IF QOIEN'>0
               QUIT 
 +5        SET QODS=$GET(^ORD(101.41,ORX,6,QODS,1))
 +6        SET QORF=$ORDER(^ORD(101.41,"AB","OR GTX REFILLS",""))
           IF QORF'>0
               QUIT 
 +7        SET QORF=$ORDER(^ORD(101.41,ORX,6,"D",QORF,""))
           IF QOIEN'>0
               QUIT 
 +8        SET QORF=$GET(^ORD(101.41,ORX,6,QORF,1))
 +9        SET QORF=QORF+1
 +10       SET ORCLPAT=$PIECE(ORYS,U,7)
 +11       SET ORMAX=$SELECT(ORYS="M":28,ORYS="B":14,ORYS="W":7,1:90)
 +12       IF QORF*QODS>ORMAX
               Begin DoDot:1
 +13               KILL ORY
 +14               SET ORY=1_U_ORCLOZ
                   SET ORY(0)="Problem Ordering Clozapine Related Medication"_U_
ORCLOZ
 +15               SET ORY(1)="*** This patient is only allowed an order with a 
maximum Days Supply of "_ORMAX_"."
 +16               SET ORY(2)="This includes the amounts added by any refills en
tered in with the order also."
               End DoDot:1
 +17       QUIT 
ISCLOZ(OROI) ;
 +1        NEW ORPSOI,ORPSDRUG
 +2        SET ORPSOI=$PIECE(^ORD(101.43,OROI,0),U,2)
 +3        IF $PIECE(ORPSOI,";",2)'="99PSP"
               QUIT 0
 +4        KILL ^TMP($JOB,"ORCLOZ")
 +5        DO ASP^PSS50(+ORPSOI,,,"ORCLOZ")
 +6        SET ORPSDRUG=$ORDER(^TMP($JOB,"ORCLOZ",0))
 +7        IF 'ORPSDRUG
               KILL ^TMP($JOB,"ORCLOZ")
               QUIT 0
 +8        KILL ^TMP($JOB,"ORCLOZ")
 +9        DO CLOZ^PSS50(ORPSDRUG,,,,,"ORCLOZ")
 +10       IF $GET(^TMP($JOB,"ORCLOZ",ORPSDRUG,"CLOZ",0))>0
               KILL ^TMP($JOB,"ORCLOZ")
               QUIT 1
 +11       KILL ^TMP($JOB,"ORCLOZ")
 +12       QUIT 0
ALLWRN(ORY,ORN,REFILLS) ;allow order to be renewed
 +1       ;ORN is the order number
 +2       ;REFILLS is the number of refills to be included with the renewed orde
r
 +3        NEW ORDS,ORQT,ORUPD,ORSCH,ORDUR,ORDFN,ORDRG,OROI,ORMAXDS,ORMAXQT,ORCL
OZ,ORREF,ORMAXREF
 +4       ;default return 1 (ORY=1 means allow renew)
 +5        SET ORY=1
 +6       ;get DFN (ORDFN)
 +7        SET ORDFN=+$PIECE(^OR(100,ORN,0),U,2)
 +8        IF 'ORDFN
               QUIT 
 +9       ;get if order is a clozapine order (ORCLOZ)
 +10       SET OROI=$GET(^OR(100,ORN,.1,1,0))
           IF 'OROI
               QUIT 
 +11       SET ORCLOZ=$$ISCLOZ(OROI)
 +12      ;quit if order is not clozapine
 +13       IF 'ORCLOZ
               QUIT 
 +14      ;get schedule from order (ORSCH)
 +15       SET ORSCH=$GET(^OR(100,ORN,4.5,$ORDER(^OR(100,ORN,4.5,"ID","SCHEDULE"
,0)),1))
 +16      ;get units per dose from order (ORUPD)
 +17       SET ORSCH=$GET(^OR(100,ORN,4.5,$ORDER(^OR(100,ORN,4.5,"ID","DOSE",0))
,1))
 +18       SET ORSCH=$PIECE(ORSCH,"&",3)
 +19      ;get duration from order (ORDUR)
 +20       IF '$ORDER(^OR(100,ORN,4.5,"ID","DURATION",0))
               SET ORDUR="~^"
 +21      IF '$TEST
               SET ORSCH=$GET(^OR(100,ORN,4.5,$ORDER(^OR(100,ORN,4.5,"ID","DURAT
ION",0)),1))
 +22      ;get days supply from order (ORDS)
 +23       SET ORSCH=$GET(^OR(100,ORN,4.5,$ORDER(^OR(100,ORN,4.5,"ID","SUPPLY",0
)),1))
 +24      ;get drug (ptr50) from order (ORDRG)
 +25       SET ORSCH=$GET(^OR(100,ORN,4.5,$ORDER(^OR(100,ORN,4.5,"ID","DRUG",0))
,1))
 +26      ;get refills from order (ORREF)
 +27       SET ORSCH=$GET(^OR(100,ORN,4.5,$ORDER(^OR(100,ORN,4.5,"ID","REFILLS",
0)),1))
 +28      ;get quantity from order (ORQT)
 +29       SET ORSCH=$GET(^OR(100,ORN,4.5,$ORDER(^OR(100,ORN,4.5,"ID","QTY",0)),
1))
 +30      ;get max days supply for order (ORMAXDS)
 +31       SET ORMAXDS=$$DEFSPLY^ORWDPS1(ORDFN)
 +32      ;if ds from order is > max ds return 0 (ORY=0)
 +33       IF ORDS>ORMAXDS
               Begin DoDot:1
 +34               SET ORY=0
 +35               SET ORY(0)="Problem Renewing Clozapine Related Medication"_U_
ORCLOZ
 +36               SET ORY(1)="The Days Supply set for this order is greater tha
n the Max Days Supply"
 +37               SET ORY(2)="    allowed for this patient."
               End DoDot:1
               QUIT 
 +38      ;get max quantity for order (ORMAXQT)
 +39       DO DAY2QTY^ORWDPS2(.ORMAXQT,ORDS,ORUPD,ORSCH,ORDUR,ORDFN,ORDRG)
 +40      ;if qt from order is > max qt return 0 (ORY=0)
 +41       IF ORQT>ORMAXQT
               Begin DoDot:1
 +42               SET ORY=0
 +43               SET ORY(0)="Problem Renewing Clozapine Related Medication"_U_
ORCLOZ
 +44               SET ORY(1)="The Quantity set for this order is greater than t
he Max Quantity"
 +45               SET ORY(2)="    allowed for this patient."
               End DoDot:1
               QUIT 
 +46      ;get max refills for order (ORMAXREF)
 +47       DO MAXREF^ORWDPS2(.ORMAXREF,ORDFN,ORDRG,ORDS,OROI,1)
 +48      ;if refill from order is > max refills return 0 (ORY=0)
 +49       IF ORREF>ORMAXREF
               Begin DoDot:1
 +50               SET ORY=0
 +51               SET ORY(0)="Problem Renewing Clozapine Related Medication"_U_
ORCLOZ
 +52               SET ORY(1)="The Refills field set for this order is greater t
han the Refills"
 +53               SET ORY(2)="    allowed for this patient with the order havin
g a Days Supply "
 +54               SET ORY(3)="    of "_ORDS_"."
               End DoDot:1
               QUIT 
 +55       QUIT 


ORALWORD * *  225 Lines,  11511 Bytes, Checksum: B105282284
                                                  Jun 28, 2016@13:15:59 page 3
              2218 bytes in comments
ORALWORD ; SLC/JMH - Utilities for Checking if an order can be ordered ; 5/10/07
           5:55am
         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,427**;Dec 17, 1997;Build 242
         ;
ALLWORD(ORY,DFN,ORX,ORTYPE,PROV) --
          ;
         N OROI,ORYS,QOIEN,QPIEN,ORCLOZ,QOAA
         S OROI=0,^TMP("RJS",$J)=$G(XQSAV)_"^"_$G(XQY0)_"^"_$G(XQZ)
         ;
         ;ORTYPE used to determine the type of data coming into the call
         ;ORYTPE="E" existing order, ORX equal the IEN from file 100 (used with
         ;copy,edit functionality)
         ;ORTYPE="Q" Quick Order, ORX equal the IEN from file 101.43
         ;ORTYPE="N" New order, ORX equal the IEN from file 101.41
         ;
         I ORTYPE="E" S OROI=$G(^OR(100,ORX,.1,1,0))
         I ORTYPE="Q" D
         .S QPIEN=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM","")) Q:QPIEN'>0
         .S QOIEN=$O(^ORD(101.41,ORX,6,"D",QPIEN,"")) Q:QOIEN'>0
         .S OROI=$G(^ORD(101.41,ORX,6,QOIEN,1))
         .S QOAA=$P($G(^ORD(101.41,ORX,5)),U,8)
         I ORTYPE="N" S OROI=ORX
         Q:OROI'>0
         S ORY=0
         ;checks if the orderable item (OROI) is a clozapine med
         ;  if not returns ORY=0
         S ORCLOZ=$$ISCLOZ(OROI),ORY=ORY_U_ORCLOZ,ORY(0)=U_ORCLOZ
         Q:'ORCLOZ
         N ORQUIT
         S ORQUIT=0
         I '$G(PROV) S PROV=DUZ
         I $G(PROV) D
         .I '$L($$DEA^XUSER(,PROV)) D
         ..S ORQUIT=1,ORY=1
         ..S ORQUIT=1,ORY=1
         ..S ORY(1)="*** You are not authorized to place Clozapine orders."
         ..S ORY(2)="You must have a DEA#.  Please contact your"
         ..S ORY(3)="CAC or IRM for more information. ***"
         .Q:ORQUIT
         .I '$D(^XUSEC("YSCL AUTHORIZED",PROV)) D
         ..S ORQUIT=1,ORY=1
         ..S ORY(1)="*** You are not authorized to place Clozapine orders."
         ..S ORY(2)="You must hold key YSCL AUTHORIZED.  Please contact your"
         ..S ORY(3)="CAC or IRM for more information on this key. ***"
         Q:ORQUIT
         ;  if is a cloz med , check if patient (DFN) can have a clozapine med
         S ORYS=$$CL^YSCLTST2(DFN)
         ;    if yes returns ORY=0
         I +ORYS>0 D BEFQUIT  Q
         ;    if no 
         ;      returns 
         ;    ORY=1
         ;    ORY(0)=CAPTION FOR DIALOG BOX
         ;    ORY(1-N)=MESSAGE TO DISPLAY
         S ORY=1_U_ORCLOZ,ORY(0)="Problem Ordering Clozapine Related Medication"
          _U_ORCLOZ
         ;patient not in clozapine patient program
         ;; START NCC REMEDIATION >> 427*RJS
         I +ORYS<0 D  Q
         .S ORY(1)="*** This patient is not registered in the clozapine treatmen
          t "
         .S ORY(2)="program or has been discontinued from the program. A new"
         .S ORY(3)="registration number must be assigned. If this is not an emer
          gency,"
         .S ORY(4)="contact the NCCC. For emergency registration during non-NCCC
           duty"
         .S ORY(5)="hours, a written order to the pharmacist can be used to proc
          ess a"
         .S ORY(6)="registration override. ***"
         ;problem with lab tests
         I +ORYS=0 D  Q
         .I $$OVERRIDE^YSCLTST2(DFN) S ORY=0_U_ORCLOZ,ORY(0)=U_ORCLOZ D BEFQUIT 
           Q  ;override allowed
         .I +$P(ORYS,"^",2),$P(ORYS,"^",4)<1000 D
         ..N COUNT S COUNT=0
         ..S COUNT=COUNT+1,ORY(COUNT)="*** This clozapine drug may not be dispen
          sed to the patient at this "
         ..S COUNT=COUNT+1,ORY(COUNT)="time based on the available lab tests rel
          ated to the clozapine "
         ..S COUNT=COUNT+1,ORY(COUNT)="treatment program. Please contact the NCC
          C to request an override in"
         ..S COUNT=COUNT+1,ORY(COUNT)="order to proceed with dispensing this dru
          g. ***"
         ..Q:'$L($P(ORYS,U,3))!('$L($P(ORYS,U,5)))
         ..S COUNT=COUNT+1,ORY(COUNT)="Related Lab Test(s)"
         ..S COUNT=COUNT+1,ORY(COUNT)="==================="
         ..;the lab values returned by Mental Health are given in 4 digit number
          s to be standard with 
         ..;reporting formats to the NCCC, we are dividing by 1000 to align it w
          ith the display of the
         ..;labs on the lab tab
         ..;S:$L($P(ORYS,U,3)) COUNT=COUNT+1,ORY(COUNT)=$P(ORYS,U,3)_":  "_($P(O
          RYS,U,2)/1000)_" K/cmm"
         ..;S:$L($P(ORYS,U,5)) COUNT=COUNT+1,ORY(COUNT)=$P(ORYS,U,5)_":  "_($P(O
          RYS,U,4)/1000)_" K/cmm"
         ..S:$L($P(ORYS,U,3)) COUNT=COUNT+1,ORY(COUNT)="WBC:  "_($P(ORYS,U,2)/10
          00)_" K/cmm"
         ..S:$L($P(ORYS,U,5)) COUNT=COUNT+1,ORY(COUNT)="ANC:  "_($P(ORYS,U,4)/10
          00)_" K/cmm"
         ..S COUNT=COUNT+1,ORY(COUNT)="Date/Time of last tests: "_$$DATE^ORU($P(
          ORYS,U,6))
         .I '+$P(ORYS,"^",2),+$P(ORYS,"^",4)>1500 D
         ..N COUNT S COUNT=0
         ..S COUNT=COUNT+1,ORY(COUNT)="*** Permission to dispense clozapine has 
          been denied based on the available"
         ..S COUNT=COUNT+1,ORY(COUNT)="lab tests related to the clozapine treatm
          ent program.***"
         ..S COUNT=COUNT+1,ORY(COUNT)=""
         ..S COUNT=COUNT+1,ORY(COUNT)="The latest lab test results drawn in the 
          past 7 days have ANC results but no"
         ..S COUNT=COUNT+1,ORY(COUNT)="matching WBC. Redo the lab tests or conta
          ct the NCCC for a National Override"
         ..S COUNT=COUNT+1,ORY(COUNT)="to dispense clozapine with no matching WB
          C results."
         ..Q:'$L($P(ORYS,U,3))!('$L($P(ORYS,U,5)))
         ..S COUNT=COUNT+1,ORY(COUNT)="Related Lab Test(s)"
         ..S COUNT=COUNT+1,ORY(COUNT)="==================="
         ..;the lab values returned by Mental Health are given in 4 digit number
          s to be standard with 
         ..;reporting formats to the NCCC, we are dividing by 1000 to align it w
          ith the display of the
         ..;labs on the lab tab
         ..;S:$L($P(ORYS,U,3)) COUNT=COUNT+1,ORY(COUNT)=$P(ORYS,U,3)_":  "_($P(O
          RYS,U,2)/1000)_" K/cmm"
         ..;S:$L($P(ORYS,U,5)) COUNT=COUNT+1,ORY(COUNT)=$P(ORYS,U,5)_":  "_($P(O
          RYS,U,4)/1000)_" K/cmm"
         ..S:$L($P(ORYS,U,3)) COUNT=COUNT+1,ORY(COUNT)="WBC:  "_($P(ORYS,U,2)/10
          00)_" K/cmm"
         ..S:$L($P(ORYS,U,5)) COUNT=COUNT+1,ORY(COUNT)="ANC:  "_($P(ORYS,U,4)/10
          00)_" K/cmm"
         ..S COUNT=COUNT+1,ORY(COUNT)="Date/Time of last tests: "_$$DATE^ORU($P(
          ORYS,U,6))
         .I '+$P(ORYS,"^",2),'+$P(ORYS,"^",4) D MSG Q
         .I '+$P(ORYS,"^",4),+$P(ORYS,"^",2) D MSG Q
         Q
MSG      ;
         N COUNT S COUNT=0
         S COUNT=COUNT+1,ORY(COUNT)="*** Permission to dispense clozapine has be
          en denied based on the"
         S COUNT=COUNT+1,ORY(COUNT)="available lab tests related to the clozapin
          e treatment program. ***"
         S COUNT=COUNT+1,ORY(COUNT)=""
         S COUNT=COUNT+1,ORY(COUNT)="For a National Override to dispense at the 
          patient's normal"
         S COUNT=COUNT+1,ORY(COUNT)="frequency, contact the NCCC."
         S COUNT=COUNT+1,ORY(COUNT)=""
         D:$D(X0)  ;; NCC REMEDIATION << 427 RTW Special Conditions selections f
          or outpatient and inpatient RTW
         . I $P(X0,U,1)["PSO" D
         . . S COUNT=COUNT+1,ORY(COUNT)="A local emergency override for an Outpa
          tient can be approved for:"
         . . S COUNT=COUNT+1,ORY(COUNT)="(1) weather-related conditions, (2) mai
          l order delays of clozapine,"
         . . S COUNT=COUNT+1,ORY(COUNT)="or (3) inpatient going on leave."
         . . S COUNT=COUNT+1,ORY(COUNT)=""
         . . S COUNT=COUNT+1,ORY(COUNT)="For an Outpatient Special Conditions Lo
          cal Override, a written prescription from"
         . . S COUNT=COUNT+1,ORY(COUNT)="the provider with documentation to the 
          pharmacist is required to dispense"
         . . S COUNT=COUNT+1,ORY(COUNT)="a one-time emergency 4-day supply."
         . I $P(X0,U,1)["PSJ" D
         . . S COUNT=COUNT+1,ORY(COUNT)="A local emergency override for an Inpat
          ient can be approved for:"
         . . S COUNT=COUNT+1,ORY(COUNT)="IP Order Override with Outside Lab Resu
          lts"
         . . S COUNT=COUNT+1,ORY(COUNT)=""
         . . S COUNT=COUNT+1,ORY(COUNT)="For a Special Conditions Local Override
          , a written order from"
         . . S COUNT=COUNT+1,ORY(COUNT)="the provider with documentation to the 
          pharmacist is required to"
         . . S COUNT=COUNT+1,ORY(COUNT)="dispense a one-time 4-day supply."
         . . S COUNT=COUNT+1,ORY(COUNT)=""
         . . S COUNT=COUNT+1,ORY(COUNT)="The provider must record the ANC from a
          nother facility including date/time in both the Provider Progress Note
           and Comment field in CPRS."
         Q:'$L($P(ORYS,U,3))!('$L($P(ORYS,U,5)))
         S COUNT=COUNT+1,ORY(COUNT)="Related Lab Test(s)"
         S COUNT=COUNT+1,ORY(COUNT)="==================="
         S:$L($P(ORYS,U,3)) COUNT=COUNT+1,ORY(COUNT)="WBC:  "_($P(ORYS,U,2)/1000
          )_" K/cmm"
         S:$L($P(ORYS,U,5)) COUNT=COUNT+1,ORY(COUNT)="ANC:  "_($P(ORYS,U,4)/1000
          )_" K/cmm"
         S COUNT=COUNT+1,ORY(COUNT)="Date/Time of last tests: "_$$DATE^ORU($P(OR
          YS,U,6))
         Q
         ;; END NCC REMEDIATION << 427*RTW
BEFQUIT  ;
         Q:'$G(QOAA)
         N QODS,QORF,ORMAX,ORCLPAT
         S QODS=$O(^ORD(101.41,"AB","OR GTX DAYS SUPPLY","")) Q:QODS'>0
         S QODS=$O(^ORD(101.41,ORX,6,"D",QODS,"")) Q:QOIEN'>0
         S QODS=$G(^ORD(101.41,ORX,6,QODS,1))
         S QORF=$O(^ORD(101.41,"AB","OR GTX REFILLS","")) Q:QORF'>0
         S QORF=$O(^ORD(101.41,ORX,6,"D",QORF,"")) Q:QOIEN'>0
         S QORF=$G(^ORD(101.41,ORX,6,QORF,1))
         S QORF=QORF+1
         S ORCLPAT=$P(ORYS,U,7)
         S ORMAX=$S(ORYS="M":28,ORYS="B":14,ORYS="W":7,1:90)
         I QORF*QODS>ORMAX D
         .K ORY
         .S ORY=1_U_ORCLOZ,ORY(0)="Problem Ordering Clozapine Related Medication
          "_U_ORCLOZ
         .S ORY(1)="*** This patient is only allowed an order with a maximum Day
          s Supply of "_ORMAX_"."
         .S ORY(2)="This includes the amounts added by any refills entered in wi
          th the order also."
         Q
ISCLOZ(OROI) --
          ;
         N ORPSOI,ORPSDRUG
         S ORPSOI=$P(^ORD(101.43,OROI,0),U,2)
         I $P(ORPSOI,";",2)'="99PSP" Q 0
         K ^TMP($J,"ORCLOZ")
         D ASP^PSS50(+ORPSOI,,,"ORCLOZ")
         S ORPSDRUG=$O(^TMP($J,"ORCLOZ",0))
         I 'ORPSDRUG K ^TMP($J,"ORCLOZ") Q 0
         K ^TMP($J,"ORCLOZ")
         D CLOZ^PSS50(ORPSDRUG,,,,,"ORCLOZ")
         I $G(^TMP($J,"ORCLOZ",ORPSDRUG,"CLOZ",0))>0 K ^TMP($J,"ORCLOZ") Q 1
         K ^TMP($J,"ORCLOZ")
         Q 0
ALLWRN(ORY,ORN,REFILLS) --
          ;allow order to be renewed
         ;ORN is the order number
         ;REFILLS is the number of refills to be included with the renewed order
         N ORDS,ORQT,ORUPD,ORSCH,ORDUR,ORDFN,ORDRG,OROI,ORMAXDS,ORMAXQT,ORCLOZ,O
          RREF,ORMAXREF
         ;default return 1 (ORY=1 means allow renew)
         S ORY=1
         ;get DFN (ORDFN)
         S ORDFN=+$P(^OR(100,ORN,0),U,2)
         Q:'ORDFN
         ;get if order is a clozapine order (ORCLOZ)
         S OROI=$G(^OR(100,ORN,.1,1,0)) Q:'OROI
         S ORCLOZ=$$ISCLOZ(OROI)
         ;quit if order is not clozapine
         I 'ORCLOZ Q
         ;get schedule from order (ORSCH)
         S ORSCH=$G(^OR(100,ORN,4.5,$O(^OR(100,ORN,4.5,"ID","SCHEDULE",0)),1))
         ;get units per dose from order (ORUPD)
         S ORSCH=$G(^OR(100,ORN,4.5,$O(^OR(100,ORN,4.5,"ID","DOSE",0)),1))
         S ORSCH=$P(ORSCH,"&",3)
         ;get duration from order (ORDUR)
         I '$O(^OR(100,ORN,4.5,"ID","DURATION",0)) S ORDUR="~^"
         E  S ORSCH=$G(^OR(100,ORN,4.5,$O(^OR(100,ORN,4.5,"ID","DURATION",0)),1)
          )
         ;get days supply from order (ORDS)
         S ORSCH=$G(^OR(100,ORN,4.5,$O(^OR(100,ORN,4.5,"ID","SUPPLY",0)),1))
         ;get drug (ptr50) from order (ORDRG)
         S ORSCH=$G(^OR(100,ORN,4.5,$O(^OR(100,ORN,4.5,"ID","DRUG",0)),1))
         ;get refills from order (ORREF)
         S ORSCH=$G(^OR(100,ORN,4.5,$O(^OR(100,ORN,4.5,"ID","REFILLS",0)),1))
         ;get quantity from order (ORQT)
         S ORSCH=$G(^OR(100,ORN,4.5,$O(^OR(100,ORN,4.5,"ID","QTY",0)),1))
         ;get max days supply for order (ORMAXDS)
         S ORMAXDS=$$DEFSPLY^ORWDPS1(ORDFN)
         ;if ds from order is > max ds return 0 (ORY=0)
         I ORDS>ORMAXDS D  Q
         .S ORY=0
         .S ORY(0)="Problem Renewing Clozapine Related Medication"_U_ORCLOZ
         .S ORY(1)="The Days Supply set for this order is greater than the Max D
          ays Supply"
         .S ORY(2)="    allowed for this patient."
         ;get max quantity for order (ORMAXQT)
         D DAY2QTY^ORWDPS2(.ORMAXQT,ORDS,ORUPD,ORSCH,ORDUR,ORDFN,ORDRG)
         ;if qt from order is > max qt return 0 (ORY=0)
         I ORQT>ORMAXQT D  Q
         .S ORY=0
         .S ORY(0)="Problem Renewing Clozapine Related Medication"_U_ORCLOZ
         .S ORY(1)="The Quantity set for this order is greater than the Max Quan
          tity"
         .S ORY(2)="    allowed for this patient."
         ;get max refills for order (ORMAXREF)
         D MAXREF^ORWDPS2(.ORMAXREF,ORDFN,ORDRG,ORDS,OROI,1)
         ;if refill from order is > max refills return 0 (ORY=0)
         I ORREF>ORMAXREF D  Q
         .S ORY=0
         .S ORY(0)="Problem Renewing Clozapine Related Medication"_U_ORCLOZ
         .S ORY(1)="The Refills field set for this order is greater than the Ref
          ills"
         .S ORY(2)="    allowed for this patient with the order having a Days Su
          pply "
         .S ORY(3)="    of "_ORDS_"."
         Q

*****   INDEX OF ORALWORD   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
   COUNT        ALLWORD+63~*,ALLWORD+64*,ALLWORD+65*,ALLWORD+66*,ALLWORD+67*
                ALLWORD+69*,ALLWORD+70*,ALLWORD+76*,ALLWORD+77*,ALLWORD+78*
                ALLWORD+80~*,ALLWORD+81*,ALLWORD+82*,ALLWORD+83*,ALLWORD+84*
                ALLWORD+85*,ALLWORD+86*,ALLWORD+88*,ALLWORD+89*,ALLWORD+95*
                ALLWORD+96*,ALLWORD+97*,MSG+1~*,MSG+2*,MSG+3*,MSG+4*,MSG+5*
                MSG+6*,MSG+7*,MSG+10*,MSG+11*,MSG+12*,MSG+13*,MSG+14*,MSG+15*
                MSG+16*,MSG+18*,MSG+19*,MSG+20*,MSG+21*,MSG+22*,MSG+23*,MSG+24*
                MSG+25*,MSG+27*,MSG+28*,MSG+29*,MSG+30*,MSG+31*
   DFN          ALLWORD~,ALLWORD+41,ALLWORD+61
   DUZ          ALLWORD+25
   ORCLOZ       ALLWORD+1~,ALLWORD+21*,ALLWORD+22,ALLWORD+49,ALLWORD+61
                BEFQUIT+14,ALLWRN+3~,ALLWRN+11*,ALLWRN+13,ALLWRN+35,ALLWRN+43
                ALLWRN+51
   ORCLPAT      BEFQUIT+2~,BEFQUIT+10*
   ORDFN        ALLWRN+3~,ALLWRN+7*,ALLWRN+8,ALLWRN+31,ALLWRN+39,ALLWRN+47
   ORDRG        ALLWRN+3~,ALLWRN+39,ALLWRN+47
   ORDS         ALLWRN+3~,ALLWRN+33,ALLWRN+39,ALLWRN+47,ALLWRN+54
   ORDUR        ALLWRN+3~,ALLWRN+20*,ALLWRN+39
   ORMAX        BEFQUIT+2~,BEFQUIT+11*,BEFQUIT+12,BEFQUIT+15
   ORMAXDS      ALLWRN+3~,ALLWRN+31*,ALLWRN+33
   ORMAXQT      ALLWRN+3~,ALLWRN+39,ALLWRN+41
   ORMAXREF     ALLWRN+3~,ALLWRN+47,ALLWRN+49
   ORN          ALLWRN~,ALLWRN+7,ALLWRN+10,ALLWRN+15,ALLWRN+17,ALLWRN+20
                ALLWRN+21,ALLWRN+23,ALLWRN+25,ALLWRN+27,ALLWRN+29
   OROI         ALLWORD+1~,ALLWORD+2*,ALLWORD+10*,ALLWORD+14*,ALLWORD+16*
                ALLWORD+17,ALLWORD+21,ISCLOZ~,ISCLOZ+2,ALLWRN+3~,ALLWRN+10*
                ALLWRN+11,ALLWRN+47
   ORPSDRUG     ISCLOZ+1~,ISCLOZ+6*,ISCLOZ+7,ISCLOZ+9,ISCLOZ+10
   ORPSOI       ISCLOZ+1~,ISCLOZ+2*,ISCLOZ+3,ISCLOZ+5
   ORQT         ALLWRN+3~,ALLWRN+41
   ORQUIT       ALLWORD+23~,ALLWORD+24*,ALLWORD+28*,ALLWORD+29*,ALLWORD+33
                ALLWORD+35*,ALLWORD+39
   ORREF        ALLWRN+3~,ALLWRN+49
   ORSCH        ALLWRN+3~,ALLWRN+15*,ALLWRN+17*,ALLWRN+18*,ALLWRN+21*
                ALLWRN+23*,ALLWRN+25*,ALLWRN+27*,ALLWRN+29*,ALLWRN+39
   ORTYPE       ALLWORD~,ALLWORD+10,ALLWORD+11,ALLWORD+16
   ORUPD        ALLWRN+3~,ALLWRN+39
   ORX          ALLWORD~,ALLWORD+10,ALLWORD+13,ALLWORD+14,ALLWORD+15,ALLWORD+16
                BEFQUIT+4,BEFQUIT+5,BEFQUIT+7,BEFQUIT+8
   ORY          ALLWORD~,ALLWORD+18*,ALLWORD+21*,ALLWORD+28*,ALLWORD+29*
                ALLWORD+35*,ALLWORD+49*,ALLWORD+61*,BEFQUIT+13!,BEFQUIT+14*
                ALLWRN~,ALLWRN+5*,ALLWRN+34*,ALLWRN+42*,ALLWRN+50*
   ORY(         ALLWORD+64*,ALLWORD+65*,ALLWORD+66*,ALLWORD+67*,ALLWORD+69*
                ALLWORD+70*,ALLWORD+76*,ALLWORD+77*,ALLWORD+78*,ALLWORD+81*
                ALLWORD+82*,ALLWORD+83*,ALLWORD+84*,ALLWORD+85*,ALLWORD+86*
                ALLWORD+88*,ALLWORD+89*,ALLWORD+95*,ALLWORD+96*,ALLWORD+97*
                MSG+2*,MSG+3*,MSG+4*,MSG+5*,MSG+6*,MSG+7*,MSG+10*,MSG+11*
                MSG+12*,MSG+13*,MSG+14*,MSG+15*,MSG+16*,MSG+18*,MSG+19*,MSG+20*
                MSG+21*,MSG+22*,MSG+23*,MSG+24*,MSG+25*,MSG+27*,MSG+28*,MSG+29*
                MSG+30*,MSG+31*
   ORY(0        ALLWORD+21*,ALLWORD+49*,ALLWORD+61*,BEFQUIT+14*,ALLWRN+35*
                ALLWRN+43*,ALLWRN+51*
   ORY(1        ALLWORD+30*,ALLWORD+36*,ALLWORD+53*,BEFQUIT+15*,ALLWRN+36*
                ALLWRN+44*,ALLWRN+52*
   ORY(2        ALLWORD+31*,ALLWORD+37*,ALLWORD+54*,BEFQUIT+16*,ALLWRN+37*
                ALLWRN+45*,ALLWRN+53*
   ORY(3        ALLWORD+32*,ALLWORD+38*,ALLWORD+55*,ALLWRN+54*
   ORY(4        ALLWORD+56*
   ORY(5        ALLWORD+57*
   ORY(6        ALLWORD+58*
   ORYS         ALLWORD+1~,ALLWORD+41*,ALLWORD+43,ALLWORD+52,ALLWORD+60
                ALLWORD+62,ALLWORD+68,ALLWORD+76,ALLWORD+77,ALLWORD+78
                ALLWORD+79,ALLWORD+87,ALLWORD+95,ALLWORD+96,ALLWORD+97
                ALLWORD+98,ALLWORD+99,MSG+26,MSG+29,MSG+30,MSG+31,BEFQUIT+10
                BEFQUIT+11
   PROV         ALLWORD~,ALLWORD+25*,ALLWORD+26,ALLWORD+27,ALLWORD+34
   QOAA         ALLWORD+1~,ALLWORD+15*,BEFQUIT+1
   QODS         BEFQUIT+2~,BEFQUIT+3*,BEFQUIT+4*,BEFQUIT+5*,BEFQUIT+12
   QOIEN        ALLWORD+1~,ALLWORD+13*,ALLWORD+14,BEFQUIT+4,BEFQUIT+7
   QORF         BEFQUIT+2~,BEFQUIT+6*,BEFQUIT+7*,BEFQUIT+8*,BEFQUIT+9*
                BEFQUIT+12
   QPIEN        ALLWORD+1~,ALLWORD+12*,ALLWORD+13
   REFILLS      ALLWRN~
   U            ALLWORD+15,ALLWORD+21,ALLWORD+49,ALLWORD+61,ALLWORD+68
                ALLWORD+76,ALLWORD+77,ALLWORD+78,ALLWORD+87,ALLWORD+95
                ALLWORD+96,ALLWORD+97,MSG+9,MSG+17,MSG+26,MSG+29,MSG+30,MSG+31
                BEFQUIT+10,BEFQUIT+14,ISCLOZ+2,ALLWRN+7,ALLWRN+35,ALLWRN+43
                ALLWRN+51
>> X0           MSG+8,MSG+9,MSG+17
>> XQSAV        ALLWORD+2
>> XQY0         ALLWORD+2
>> XQZ          ALLWORD+2

Global Variables  ( * Changed  ! Killed)
   ^OR(100             ALLWORD+10,ALLWRN+7,ALLWRN+10,ALLWRN+15,ALLWRN+17
                       ALLWRN+20,ALLWRN+21,ALLWRN+23,ALLWRN+25,ALLWRN+27
                       ALLWRN+29
   ^ORD(101.41         ALLWORD+12,ALLWORD+13,ALLWORD+14,ALLWORD+15,BEFQUIT+3
                       BEFQUIT+4,BEFQUIT+5,BEFQUIT+6,BEFQUIT+7,BEFQUIT+8
   ^ORD(101.43         ISCLOZ+2
   ^TMP("RJS"          ALLWORD+2*
   ^TMP($J             ISCLOZ+4!,ISCLOZ+6,ISCLOZ+7!,ISCLOZ+8!,ISCLOZ+10!
                       ISCLOZ+11!
   ^XUSEC("YSCL AUTHORIZED"
                       ALLWORD+34

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   NONE

Label References
   $$ISCLOZ     ALLWORD+21,ALLWRN+11
   BEFQUIT      ALLWORD+43,ALLWORD+61
   MSG          ALLWORD+98,ALLWORD+99

External References
   $$DATE^ORU          ALLWORD+78,ALLWORD+97,MSG+31
   $$DEFSPLY^ORWDPS1   ALLWRN+31
   DAY2QTY^ORWDPS2     ALLWRN+39
   MAXREF^ORWDPS2      ALLWRN+47
   ASP^PSS50           ISCLOZ+5
   CLOZ^PSS50          ISCLOZ+9
   $$DEA^XUSER         ALLWORD+27
   $$CL^YSCLTST2       ALLWORD+41
   $$OVERRIDE^YSCLTST2 ALLWORD+61

*****   END   *****
ORY4270   3299     printed  Jun 28, 2016@13:15:59                      Page 4

ORY4270   ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Instal
l of OR*3*427) ;MAY 10,2016 at 13:31
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 +3       ;
S         ;
 +1       ;
 +2        QUIT 
 +3       ;
WARN(RTN,MSG,LINES) ;
 +1       ;
 +2        IF $GET(OCXAUTO)
               QUIT 
 +3       ;
 +4        NEW DASH,LINE,NLINE,PLINE
 +5       ;
 +6        SET DASH=""
           SET $PIECE(DASH,"-",(55-$LENGTH(MSG)-2))="-"
 +7        WRITE !!,"--------------",MSG,DASH
 +8       ;
 +9        WRITE !,RTN,?10,"[NCCLAB1.AAC.DNS   ] -> [",$$NETNAME^OCXSEND,"] Line
"
 +10      ;
 +11       IF $ORDER(LINES($ORDER(LINES(0))))
               WRITE "s: "
 +12      IF '$TEST
               WRITE ": "
 +13      ;
 +14       SET LINE=0
           FOR 
               SET LINE=$ORDER(LINES(LINE))
               IF 'LINE
                   QUIT 
               Begin DoDot:1
 +15               IF ($X>60)
                       WRITE !,?40
 +16               SET NLINE=LINE
                   FOR 
                       SET PLINE=NLINE
                       SET NLINE=$ORDER(LINES(NLINE))
                       IF (NLINE-PLINE-1)
                           QUIT 
 +17               IF (PLINE=LINE)
                       WRITE " ",LINE
 +18              IF '$TEST
                       WRITE " ",LINE,"-",PLINE
                       SET LINE=PLINE
               End DoDot:1
 +19      ;
 +20       WRITE !
           QUIT 
 +21      ;
TEXT(RTN,LINE) ;
 +1       ;
 +2        NEW TEXT
           XECUTE "S TEXT=$T(+"_(+LINE)_"^"_RTN_")"
           QUIT TEXT
 +3       ;
HEADER    ;
 +1       ;
 +2        WRITE !," Created: MAY 10,2016 at 13:31  at  NCCLAB1.AAC.DNS   "
 +3        WRITE !," Current Date: ",$$NOW,"  at  ",$$NETNAME^OCXSEND,!!
 +4        SET LASTFILE=0
           KILL ^TMP("OCXRULE",$JOB)
 +5        SET ^TMP("OCXRULE",$JOB)=($PIECE($HOROLOG,",",2)+($HOROLOG*86400)+(1*
60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
 +6        QUIT 
 +7       ;
GETFILE(FILE,RECNAME,ARRAY) ;
 +1       ;
 +2        NEW CHECK,GLNEXT,GLREF,LINES,REC,DD,FLD
 +3        SET REC=$$LOOKUP(FILE,RECNAME)
 +4        IF 'REC
               WRITE !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME
               QUIT 0
 +5        IF (REC=-1)
               WRITE !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME,"  duplicate loca
l entries.",!
               QUIT 0
 +6        IF (REC=-2)
               WRITE !!,$$FILENAME^OCXSENDD(FILE)," (",FILE,") local file not fo
und."
               WRITE !
               IF $$PAUSE
                   QUIT -10
               QUIT REC
 +7        IF (REC<0)
               WRITE !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME,"  unknown lookup
 error."
               WRITE !
               IF $$PAUSE
                   QUIT -10
               QUIT REC
 +8        IF (REC>0)
               Begin DoDot:1
 +9                SET CHECK=0
                   SET LINES=0
 +10               DO GETREC($$FILE^OCXSENDD(FILE,"GLOBAL NAME"),"ARRAY(",REC,.A
RRAY)
 +11               SET GLREF="ARRAY"
                   FOR 
                       SET GLREF=$QUERY(@GLREF)
                       IF '$LENGTH(GLREF)
                           QUIT 
                       IF '($EXTRACT(GLREF,1,6)="ARRAY(")
                           QUIT 
                       IF '$LENGTH(@GLREF)
                           KILL @GLREF
               End DoDot:1
 +12      ;
 +13       QUIT REC
 +14      ;
LKUPARRY(DD,KEY,ARRAY) ;
 +1       ;
 +2        NEW D0
           SET D0=0
           FOR 
               SET D0=$ORDER(ARRAY(DD,D0))
               IF 'D0
                   QUIT 
               IF ($GET(ARRAY(DD,D0,.01,"E"))=KEY)
                   QUIT 
 +3        QUIT D0
 +4       ;
LOOKUP(FILE,KEY) ;
 +1        IF $ORDER(^TMP("OCXRULE",$JOB,"B",FILE,KEY,0))
               QUIT 0
 +2        NEW RECNAM,REC,D0,CNT,SHORT
           SET (REC,CNT)=0
 +3        SET GL=$$FILE^OCXSENDD(FILE,"GLOBAL NAME")
           IF '$LENGTH(GL)
               QUIT -2
           SET GL=$EXTRACT(GL,1,$LENGTH(GL)-1)_")"
 +4        SET SHORT=$EXTRACT(KEY,1,30)
           SET RECNAM=SHORT
           Begin DoDot:1
 +5            SET D0=0
               FOR 
                   SET D0=$ORDER(@GL@("B",RECNAM,D0))
                   IF 'D0
                       QUIT 
                   IF ($PIECE($GET(@GL@(D0,0)),U,1)=KEY)
                       SET CNT=CNT+1
                       SET REC=D0_U_RECNAME
           End DoDot:1
           FOR 
               SET RECNAM=$ORDER(@GL@("B",RECNAM))
               IF '$LENGTH(RECNAM)
                   QUIT 
               IF '($EXTRACT(RECNAM,1,$LENGTH(SHORT))=SHORT)
                   QUIT 
               Begin DoDot:1
               End DoDot:1
 +6        IF (CNT>1)
               QUIT -1
 +7        IF $LENGTH($PIECE(REC,U,2))
               SET ^TMP("OCXRULE",$JOB,"A",FILE,$PIECE(REC,U,2))=""
 +8        QUIT +REC
 +9       ;
GETREC(GL,PATH,D0,REM) ;
 +1       ;
 +2        IF '($PIECE($GET(@(GL_"0)")),U,2))
               QUIT 
 +3        NEW S1,DATA,DD
 +4        SET DATA=""
           DO DIQ(GL,D0,.DATA)
 +5        SET DD=$ORDER(DATA(0))
           IF 'DD
               QUIT 
 +6       ;
 +7        IF $LENGTH($$FILE^OCXSENDD(DD,"NAME"))
               SET PATH=PATH_""""_DD_":"_D0_""""
 +8        IF '$LENGTH($$FILE^OCXSENDD(DD,"NAME"))
               SET PATH=PATH_","""_DD_":"_D0_""""
 +9        MERGE @(PATH_")")=DATA(DD,D0)
 +10      ;
 +11       SET S1=""
           FOR 
               SET S1=$ORDER(@(GL_D0_","_$$SUB(S1)_")"))
               IF '$LENGTH(S1)
                   QUIT 
               IF ($DATA(@(GL_D0_","_$$SUB(S1)_")"))>3)
                   Begin DoDot:1
 +12                   NEW D1,GLREF
                       SET GLREF=GL_D0_","_$$SUB(S1)_","
 +13                   SET D1=0
                       FOR 
                           SET D1=$ORDER(@(GLREF_D1_")"))
                           IF 'D1
                               QUIT 
                           DO GETREC(GLREF,PATH,D1,.REM)
                   End DoDot:1
 +14      ;
 +15       QUIT 
 +16      ;
SUB(X)     IF '(X=+X)
               QUIT """"_X_""""
           QUIT X
 +1       ;
DIQ(DIC,DA,OCXARY) ;
 +1        NEW DR,DIQ
           SET DR=".01:99999"
           SET DIQ="OCXARY("
           SET DIQ(0)="EN"
           DO EN^DIQ1
 +2        QUIT 
 +3       ;
PAUSE()    WRITE "  Press Enter "
           READ X:DTIME
           WRITE !
           QUIT (X[U)
 +1       ;
NOW()      NEW X,Y,%DT
           SET X="N"
           SET %DT="T"
           DO ^%DT
           SET Y=$$DATE^OCXSENDD(Y)
           IF (Y["@")
               SET Y=$PIECE(Y,"@",1)_" at "_$PIECE(Y,"@",2)
           QUIT Y
 +1       ;


ORY4270  * *  99 Lines,  3299 Bytes, Checksum: B15569729
                                                  Jun 28, 2016@13:15:59 page 5
              145 bytes in comments
ORY4270  ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install
           of OR*3*427) ;MAY 10,2016 at 13:31
         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
         ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
         ;
S        ;
         ;
         Q
         ;
WARN(RTN,MSG,LINES) --
          ;
         ;
         Q:$G(OCXAUTO)
         ;
         N DASH,LINE,NLINE,PLINE
         ;
         S DASH="",$P(DASH,"-",(55-$L(MSG)-2))="-"
         W !!,"--------------",MSG,DASH
         ;
         W !,RTN,?10,"[NCCLAB1.AAC.DNS   ] -> [",$$NETNAME^OCXSEND,"] Line"
         ;
         I $O(LINES($O(LINES(0)))) W "s: "
         E  W ": "
         ;
         S LINE=0 F  S LINE=$O(LINES(LINE)) Q:'LINE  D
         .W:($X>60) !,?40
         .S NLINE=LINE F  S PLINE=NLINE,NLINE=$O(LINES(NLINE)) Q:(NLINE-PLINE-1)
         .I (PLINE=LINE) W " ",LINE
         .E  W " ",LINE,"-",PLINE S LINE=PLINE
         ;
         W ! Q
         ;
TEXT(RTN,LINE) --
          ;
         ;
         N TEXT X "S TEXT=$T(+"_(+LINE)_"^"_RTN_")" Q TEXT
         ;
HEADER   ;
         ;
         W !," Created: MAY 10,2016 at 13:31  at  NCCLAB1.AAC.DNS   "
         W !," Current Date: ",$$NOW,"  at  ",$$NETNAME^OCXSEND,!!
         S LASTFILE=0 K ^TMP("OCXRULE",$J)
         S ^TMP("OCXRULE",$J)=($P($H,",",2)+($H*86400)+(1*60*60))_" <- ^TMP ENTR
          Y EXPIRATION DATE FOR ^OCXOPURG"
         Q
         ;
GETFILE(FILE,RECNAME,ARRAY) --
          ;
         ;
         N CHECK,GLNEXT,GLREF,LINES,REC,DD,FLD
         S REC=$$LOOKUP(FILE,RECNAME)
         I 'REC W !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME Q 0
         I (REC=-1) W !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME,"  duplicate loc
          al entries.",! Q 0
         I (REC=-2) W !!,$$FILENAME^OCXSENDD(FILE)," (",FILE,") local file not f
          ound." W ! Q:$$PAUSE -10 Q REC
         I (REC<0) W !!,$$FILENAME^OCXSENDD(FILE),": ",RECNAME,"  unknown lookup
           error." W ! Q:$$PAUSE -10 Q REC
         I (REC>0) D
         .S CHECK=0,LINES=0
         .D GETREC($$FILE^OCXSENDD(FILE,"GLOBAL NAME"),"ARRAY(",REC,.ARRAY)
         .S GLREF="ARRAY" F  S GLREF=$Q(@GLREF) Q:'$L(GLREF)  Q:'($E(GLREF,1,6)=
          "ARRAY(")  K:'$L(@GLREF) @GLREF
         ;
         Q REC
         ;
LKUPARRY(DD,KEY,ARRAY) --
          ;
         ;
         N D0 S D0=0 F  S D0=$O(ARRAY(DD,D0)) Q:'D0  Q:($G(ARRAY(DD,D0,.01,"E"))
          =KEY)
         Q D0
         ;
LOOKUP(FILE,KEY) --
          ;
         I $O(^TMP("OCXRULE",$J,"B",FILE,KEY,0)) Q 0
         N RECNAM,REC,D0,CNT,SHORT S (REC,CNT)=0
         S GL=$$FILE^OCXSENDD(FILE,"GLOBAL NAME") Q:'$L(GL) -2 S GL=$E(GL,1,$L(G
          L)-1)_")"
         S SHORT=$E(KEY,1,30),RECNAM=SHORT D  F  S RECNAM=$O(@GL@("B",RECNAM)) Q
          :'$L(RECNAM)  Q:'($E(RECNAM,1,$L(SHORT))=SHORT)  D
         .S D0=0 F  S D0=$O(@GL@("B",RECNAM,D0)) Q:'D0  I ($P($G(@GL@(D0,0)),U,1
          )=KEY) S CNT=CNT+1,REC=D0_U_RECNAME
         Q:(CNT>1) -1
         S:$L($P(REC,U,2)) ^TMP("OCXRULE",$J,"A",FILE,$P(REC,U,2))=""
         Q +REC
         ;
GETREC(GL,PATH,D0,REM) --
          ;
         ;
         Q:'($P($G(@(GL_"0)")),U,2))
         N S1,DATA,DD
         S DATA="" D DIQ(GL,D0,.DATA)
         S DD=$O(DATA(0)) Q:'DD
         ;
         I $L($$FILE^OCXSENDD(DD,"NAME")) S PATH=PATH_""""_DD_":"_D0_""""
         I '$L($$FILE^OCXSENDD(DD,"NAME")) S PATH=PATH_","""_DD_":"_D0_""""
         M @(PATH_")")=DATA(DD,D0)
         ;
         S S1="" F  S S1=$O(@(GL_D0_","_$$SUB(S1)_")")) Q:'$L(S1)  I ($D(@(GL_D0
          _","_$$SUB(S1)_")"))>3) D
         .N D1,GLREF S GLREF=GL_D0_","_$$SUB(S1)_","
         .S D1=0 F  S D1=$O(@(GLREF_D1_")")) Q:'D1  D GETREC(GLREF,PATH,D1,.REM)
         ;
         Q
         ;
SUB(X)   Q:'(X=+X) """"_X_"""" Q X
         ;
DIQ(DIC,DA,OCXARY) --
          ;
         N DR,DIQ S DR=".01:99999",DIQ="OCXARY(",DIQ(0)="EN" D EN^DIQ1
         Q
         ;
PAUSE()  W "  Press Enter " R X:DTIME W ! Q (X[U)
         ;
NOW()    N X,Y,%DT S X="N",%DT="T" D ^%DT S Y=$$DATE^OCXSENDD(Y) S:(Y["@") Y=$P(
          Y,"@",1)_" at "_$P(Y,"@",2) Q Y
         ;

*****   INDEX OF ORY4270   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
   %DT          NOW~*
   ARRAY        GETFILE~,GETFILE+10,LKUPARRY~
   ARRAY(       LKUPARRY+2
   CHECK        GETFILE+2~,GETFILE+9*
   CNT          LOOKUP+2~*,LOOKUP+5*,LOOKUP+6
   D0           LKUPARRY+2~*,LKUPARRY+3,LOOKUP+2~,LOOKUP+5*,GETREC~,GETREC+4
                GETREC+7,GETREC+8,GETREC+9,GETREC+11,GETREC+12
   D1           GETREC+12~,GETREC+13*
   DA           DIQ~
   DASH         WARN+4~,WARN+6*,WARN+7
   DATA         GETREC+3~,GETREC+4*
   DATA(        GETREC+9
   DATA(0       GETREC+5
   DD           GETFILE+2~,LKUPARRY~,LKUPARRY+2,GETREC+3~,GETREC+5*,GETREC+7
                GETREC+8,GETREC+9
   DIC          DIQ~
   DIQ          DIQ+1~*
   DIQ(0        DIQ+1*
   DR           DIQ+1~*
   DTIME        PAUSE
   FILE         GETFILE~,GETFILE+3,GETFILE+4,GETFILE+5,GETFILE+6,GETFILE+7
                GETFILE+10,LOOKUP~,LOOKUP+1,LOOKUP+3,LOOKUP+7
   FLD          GETFILE+2~
   GL           LOOKUP+3*,LOOKUP+4,LOOKUP+5,GETREC~,GETREC+2,GETREC+4,GETREC+11
                GETREC+12
   GLNEXT       GETFILE+2~
   GLREF        GETFILE+2~,GETFILE+11*,GETREC+12~*,GETREC+13
   KEY          LKUPARRY~,LKUPARRY+2,LOOKUP~,LOOKUP+1,LOOKUP+4,LOOKUP+5
>> LASTFILE     HEADER+4*
   LINE         WARN+4~,WARN+14*,WARN+16,WARN+17,WARN+18*,TEXT~,TEXT+2
   LINES        WARN~,GETFILE+2~,GETFILE+9*
   LINES(       WARN+11,WARN+14,WARN+16
   LINES(0      WARN+11
   MSG          WARN~,WARN+6,WARN+7
   NLINE        WARN+4~,WARN+16*
   OCXARY       DIQ~
>> OCXAUTO      WARN+2
   PATH         GETREC~,GETREC+7*,GETREC+8*,GETREC+9,GETREC+13
   PLINE        WARN+4~,WARN+16*,WARN+17,WARN+18
   REC          GETFILE+2~,GETFILE+3*,GETFILE+4,GETFILE+5,GETFILE+6,GETFILE+7
                GETFILE+8,GETFILE+10,GETFILE+13,LOOKUP+2~*,LOOKUP+5*,LOOKUP+7
                LOOKUP+8
   RECNAM       LOOKUP+2~,LOOKUP+4*,LOOKUP+5
   RECNAME      GETFILE~,GETFILE+3,GETFILE+4,GETFILE+5,GETFILE+7,LOOKUP+5
   REM          GETREC~,GETREC+13
   RTN          WARN~,WARN+9,TEXT~,TEXT+2
   S1           GETREC+3~,GETREC+11*,GETREC+12
   SHORT        LOOKUP+2~,LOOKUP+4*
   TEXT         TEXT+2~
   U            LOOKUP+5,LOOKUP+7,GETREC+2,PAUSE
   X            SUB~,PAUSE*,NOW~*
   Y            NOW~*

Global Variables  ( * Changed  ! Killed)
   ^TMP("OCXRULE"      HEADER+4!,HEADER+5*,LOOKUP+1,LOOKUP+7*

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   NONE

Label References
   $$LOOKUP     GETFILE+3
   $$NOW        HEADER+3
   $$PAUSE      GETFILE+6,GETFILE+7
   $$SUB        GETREC+11,GETREC+12
   DIQ          GETREC+4
   GETREC       GETFILE+10,GETREC+13

External References
   ^%DT                NOW
   EN^DIQ1             DIQ+1
   $$NETNAME^OCXSEND   WARN+9,HEADER+3
   $$DATE^OCXSENDD     NOW
   $$FILE^OCXSENDD     GETFILE+10,LOOKUP+3,GETREC+7,GETREC+8
   $$FILENAME^OCXSENDD GETFILE+4,GETFILE+5,GETFILE+6,GETFILE+7

*****   END   *****
ORY42701   7824     printed  Jun 28, 2016@13:15:59                     Page 6

ORY42701  ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Instal
l of OR*3*427) ;MAY 10,2016 at 13:31
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 +3       ;
S         ;
 +1       ;
 +2        DO DOT^ORY427ES
 +3       ;
 +4       ;
 +5        KILL REMOTE,LOCAL,OPCODE,REF
 +6        FOR LINE=1:1:500
               SET TEXT=$PIECE($TEXT(DATA+LINE),";",2,999)
               IF TEXT
                   QUIT 
               IF $LENGTH(TEXT)
                   Begin DoDot:1
 +7                    SET ^TMP("OCXRULE",$JOB,$ORDER(^TMP("OCXRULE",$JOB,"A"),-
1)+1)=TEXT
                   End DoDot:1
                   IF QUIT
                       QUIT 
 +8       ;
 +9        GOTO ^ORY42702
 +10      ;
 +11       QUIT 
 +12      ;
DATA      ;
 +1       ;
 +2       ;;ROOT^OCXS(860.2,0)^ORDER CHECK RULE^860.2I
 +3       ;;ROOT^OCXS(860.3,0)^ORDER CHECK ELEMENT^860.3
 +4       ;;ROOT^OCXS(860.4,0)^ORDER CHECK DATA FIELD^860.4I
 +5       ;;ROOT^OCXS(860.5,0)^ORDER CHECK DATA SOURCE^860.5
 +6       ;;ROOT^OCXS(860.6,0)^ORDER CHECK DATA CONTEXT^860.6
 +7       ;;ROOT^OCXS(860.8,0)^ORDER CHECK COMPILER FUNCTIONS^860.8
 +8       ;;ROOT^OCXS(860.9,0)^ORDER CHECK NATIONAL TERM^860.9
 +9       ;;ROOT^OCXS(863,0)^OCX MDD CLASS^863
 +10      ;;ROOT^OCXS(863.1,0)^OCX MDD APPLICATION^863.1
 +11      ;;ROOT^OCXS(863.2,0)^OCX MDD SUBJECT^863.2
 +12      ;;ROOT^OCXS(863.3,0)^OCX MDD LINK^863.3I
 +13      ;;ROOT^OCXS(863.4,0)^OCX MDD ATTRIBUTE^863.4
 +14      ;;ROOT^OCXS(863.5,0)^OCX MDD VALUES^863.5
 +15      ;;ROOT^OCXS(863.6,0)^OCX MDD METHOD^863.6
 +16      ;;ROOT^OCXS(863.7,0)^OCX MDD PUBLIC FUNCTION^863.7
 +17      ;;ROOT^OCXS(863.8,0)^OCX MDD PARAMETER^863.8
 +18      ;;ROOT^OCXS(863.9,0)^OCX MDD CONDITION/FUNCTION^863.9I
 +19      ;;ROOT^OCXS(864,0)^OCX MDD SITE PREFERENCES^864P
 +20      ;;ROOT^OCXS(864.1,0)^OCX MDD DATATYPE^864.1
 +21      ;;ROOT^OCXD(860.1,0)^ORDER CHECK PATIENT ACTIVE DATA^860.1P
 +22      ;;ROOT^OCXD(860.7,0)^ORDER CHECK PATIENT RULE EVENT^860.7P
 +23      ;;ROOT^OCXD(861,0)^ORDER CHECK RAW DATA LOG^861
 +24      ;;SOF^863.8  OCX MDD PARAMETER
 +25      ;;KEY^863.8:^COMPARISON VALUE
 +26      ;;R^"863.8:",.01,"E"
 +27      ;;D^COMPARISON VALUE
 +28      ;;R^"863.8:",.02,"E"
 +29      ;;D^CVAL
 +30      ;;R^"863.8:",1,1
 +31      ;;D^ 
 +32      ;;R^"863.8:",1,2
 +33      ;;D^   This is a value to be compared with PRIMARY DATA FIELD
 +34      ;;R^"863.8:",1,3
 +35      ;;D^ in a truth conditional.
 +36      ;;R^"863.8:",1,4
 +37      ;;D^ 
 +38      ;;EOR^
 +39      ;;KEY^863.8:^DATA TYPE
 +40      ;;R^"863.8:",.01,"E"
 +41      ;;D^DATA TYPE
 +42      ;;R^"863.8:",.02,"E"
 +43      ;;D^DATA TYPE
 +44      ;;R^"863.8:",1,1
 +45      ;;D^An MDD data type; i.e., an entry in the OCX MDD DATA TYPE file.
 +46      ;;R^"863.8:","863.84:6",.01,"E"
 +47      ;;D^QUERY
 +48      ;;R^"863.8:","863.84:6",1,"E"
 +49      ;;D^Enter the datatype
 +50      ;;R^"863.8:","863.84:7",.01,"E"
 +51      ;;D^DIC
 +52      ;;R^"863.8:","863.84:7",1,"E"
 +53      ;;D^864.1
 +54      ;;R^"863.8:","863.84:8",.01,"E"
 +55      ;;D^DATA TYPE
 +56      ;;R^"863.8:","863.84:8",1,"E"
 +57      ;;D^POINTER TO A FILEMAN FILE
 +58      ;;R^"863.8:","863.84:9",.01,"E"
 +59      ;;D^DIC LOOKUP INDEX STRING
 +60      ;;R^"863.8:","863.84:9",1,"E"
 +61      ;;D^B^C
 +62      ;;EOR^
 +63      ;;KEY^863.8:^DIC
 +64      ;;R^"863.8:",.01,"E"
 +65      ;;D^DIC
 +66      ;;R^"863.8:",.02,"E"
 +67      ;;D^DIC
 +68      ;;R^"863.8:",1,1
 +69      ;;D^An open reference used to specify the file in a DIC lookup
 +70      ;;R^"863.8:","863.84:1",.01,"E"
 +71      ;;D^DATA TYPE
 +72      ;;R^"863.8:","863.84:1",1,"E"
 +73      ;;D^POINTER TO A FILEMAN FILE
 +74      ;;R^"863.8:","863.84:2",.01,"E"
 +75      ;;D^DIC
 +76      ;;R^"863.8:","863.84:2",1,"E"
 +77      ;;D^1
 +78      ;;R^"863.8:","863.84:3",.01,"E"
 +79      ;;D^QUERY
 +80      ;;R^"863.8:","863.84:3",1,"E"
 +81      ;;D^Enter the name of the file you are pointing to
 +82      ;;EOR^
 +83      ;;KEY^863.8:^DIC LOOKUP INDEX STRING
 +84      ;;R^"863.8:",.01,"E"
 +85      ;;D^DIC LOOKUP INDEX STRING
 +86      ;;R^"863.8:",.02,"E"
 +87      ;;D^DICIX
 +88      ;;R^"863.8:",1,1
 +89      ;;D^Contains the names of indices to be used in a DIC lookup in a comm
a
 +90      ;;R^"863.8:",1,2
 +91      ;;D^delimited string.
 +92      ;;R^"863.8:","863.84:1",.01,"E"
 +93      ;;D^DATA TYPE
 +94      ;;R^"863.8:","863.84:1",1,"E"
 +95      ;;D^FREE TEXT
 +96      ;;R^"863.8:","863.84:2",.01,"E"
 +97      ;;D^QUERY
 +98      ;;R^"863.8:","863.84:2",1,"E"
 +99      ;;D^Enter a DIC lookup index string
 +100     ;;R^"863.8:","863.84:3",.01,"E"
 +101     ;;D^HELP MESSAGE
 +102     ;;R^"863.8:","863.84:3",1,"E"
 +103     ;;D^This is an '^' delimited string which contains the names of indice
s which are to be used in a DIC lookup; e.g., B^C^DOB.
 +104     ;;EOR^
 +105     ;;KEY^863.8:^FILE
 +106     ;;R^"863.8:",.01,"E"
 +107     ;;D^FILE
 +108     ;;R^"863.8:",.02,"E"
 +109     ;;D^FILE
 +110     ;;R^"863.8:",1,1
 +111     ;;D^The internal entry number of a file.
 +112     ;;R^"863.8:","863.84:6",.01,"E"
 +113     ;;D^QUERY
 +114     ;;R^"863.8:","863.84:6",1,"E"
 +115     ;;D^File
 +116     ;;R^"863.8:","863.84:7",.01,"E"
 +117     ;;D^DATA TYPE
 +118     ;;R^"863.8:","863.84:7",1,"E"
 +119     ;;D^POINTER TO A FILEMAN FILE
 +120     ;;R^"863.8:","863.84:8",.01,"E"
 +121     ;;D^DIC
 +122     ;;R^"863.8:","863.84:8",1,"E"
 +123     ;;D^1
 +124     ;;EOR^
 +125     ;;KEY^863.8:^FM MASK
 +126     ;;R^"863.8:",.01,"E"
 +127     ;;D^FM MASK
 +128     ;;R^"863.8:",.02,"E"
 +129     ;;D^FM MASK
 +130     ;;R^"863.8:",1,1
 +131     ;;D^Tag^routine where code is located to parse the FM DD and override 
the parameter value
 +132     ;;R^"863.8:","863.84:4",.01,"E"
 +133     ;;D^QUERY
 +134     ;;R^"863.8:","863.84:4",1,"E"
 +135     ;;D^Enter tag^routine where the FM MASK parser is located
 +136     ;;R^"863.8:","863.84:5",.01,"E"
 +137     ;;D^DATA TYPE
 +138     ;;R^"863.8:","863.84:5",1,"E"
 +139     ;;D^LINE TAG
 +140     ;;EOR^
 +141     ;;KEY^863.8:^FREE TEXT MAXIMUM LENGTH
 +142     ;;R^"863.8:",.01,"E"
 +143     ;;D^FREE TEXT MAXIMUM LENGTH
 +144     ;;R^"863.8:",.02,"E"
 +145     ;;D^FMAX
 +146     ;;R^"863.8:",1,1
 +147     ;;D^Maximum string length allowed
 +148     ;;R^"863.8:",2,"E"
 +149     ;;D^245
 +150     ;;R^"863.8:","863.84:3",.01,"E"
 +151     ;;D^QUERY
 +152     ;;R^"863.8:","863.84:3",1,"E"
 +153     ;;D^Maximum text string length allowed
 +154     ;;R^"863.8:","863.84:4",.01,"E"
 +155     ;;D^FM MASK
 +156     ;;R^"863.8:","863.84:4",1,"E"
 +157     ;;D^FMAX^OCXF6
 +158     ;;R^"863.8:","863.84:5",.01,"E"
 +159     ;;D^DATA TYPE
 +160     ;;R^"863.8:","863.84:5",1,"E"
 +161     ;;D^POSITIVE INTEGER
 +162     ;;EOR^
 +163     ;;KEY^863.8:^HELP MESSAGE
 +164     ;;R^"863.8:",.01,"E"
 +165     ;;D^HELP MESSAGE
 +166     ;;R^"863.8:",.02,"E"
 +167     ;;D^HELP
 +168     ;;R^"863.8:",1,1
 +169     ;;D^A text string 1-250 characters long which overrides the Fileman he
lp
 +170     ;;R^"863.8:",1,2
 +171     ;;D^message.
 +172     ;;R^"863.8:","863.84:10",.01,"E"
 +173     ;;D^QUERY
 +174     ;;R^"863.8:","863.84:10",1,"E"
 +175     ;;D^Enter a brief help message
 +176     ;;R^"863.8:","863.84:8",.01,"E"
 +177     ;;D^DATA TYPE
 +178     ;;R^"863.8:","863.84:8",1,"E"
 +179     ;;D^FREE TEXT
 +180     ;;R^"863.8:","863.84:9",.01,"E"
 +181     ;;D^FM MASK
 +182     ;;R^"863.8:","863.84:9",1,"E"
 +183     ;;D^HELP^OCXF6
 +184     ;;EOR^
 +185     ;;KEY^863.8:^LOOP QUERY
 +186     ;;R^"863.8:",.01,"E"
 +187     ;;D^LOOP QUERY
 +188     ;;R^"863.8:",.02,"E"
 +189     ;;D^LOOP QUERY
 +190     ;;R^"863.8:",1,1
 +191     ;;D^Alternate query used when repeated answers are required
 +192     ;;R^"863.8:","863.84:1",.01,"E"
 +193     ;;D^DATA TYPE
 +194     ;;R^"863.8:","863.84:1",1,"E"
 +195     ;;D^FREE TEXT
 +196     ;;R^"863.8:","863.84:2",.01,"E"
 +197     ;;D^QUERY
 +198     ;;R^"863.8:","863.84:2",1,"E"
 +199     ;;D^Enter loop query text
 +200     ;;R^"863.8:","863.84:3",.01,"E"
 +201     ;;D^HELP MESSAGE
 +202     ;;R^"863.8:","863.84:3",1,"E"
 +203     ;;D^This is the query text for all entries after the first one
 +204     ;;EOR^
 +205     ;;KEY^863.8:^MANDATORY MESSAGE
 +206     ;;R^"863.8:",.01,"E"
 +207     ;;D^MANDATORY MESSAGE
 +208     ;;R^"863.8:",.02,"E"
 +209     ;;D^MAND MSG
 +210     ;;R^"863.8:",1,1
 +211     ;;D^Message sent to user telling him that his entry is mandatory
 +212     ;;R^"863.8:",2,"E"
 +213     ;;D^Mandatory answer.  You must enter a value or '^' to exit.
 +214     ;;R^"863.8:","863.84:4",.01,"E"
 +215     ;;D^QUERY
 +216     ;;R^"863.8:","863.84:4",1,"E"
 +217     ;;D^Enter message
 +218     ;;R^"863.8:","863.84:5",.01,"E"
 +219     ;;D^DATA TYPE
 +220     ;;R^"863.8:","863.84:5",1,"E"
 +221     ;;D^FREE TEXT
 +222     ;;EOR^
 +223     ;;KEY^863.8:^OCXO DATA DRIVE SOURCE
 +224     ;;R^"863.8:",.01,"E"
 +225     ;;D^OCXO DATA DRIVE SOURCE
 +226     ;;EOR^
 +227     ;;KEY^863.8:^OCXO EXTERNAL FUNCTION CALL
 +228     ;;R^"863.8:",.01,"E"
 +229     ;;D^OCXO EXTERNAL FUNCTION CALL
 +230     ;;EOR^
 +231     ;;KEY^863.8:^OCXO FILE POINTER
 +232     ;;R^"863.8:",.01,"E"
 +233     ;;D^OCXO FILE POINTER
 +234     ;;EOR^
 +235     ;;KEY^863.8:^OCXO GENERATE CODE FUNCTION
 +236     ;;R^"863.8:",.01,"E"
 +237     ;;D^OCXO GENERATE CODE FUNCTION
 +238     ;;R^"863.8:",.02,"E"
 +239     ;;D^GEN
 +240     ;;EOR^
 +241     ;;KEY^863.8:^OCXO HL7 SEGMENT ID
 +242     ;;R^"863.8:",.01,"E"
 +243     ;;D^OCXO HL7 SEGMENT ID
 +244     ;;R^"863.8:",.02,"E"
 +245     ;;D^HL7SEGID
 +246     ;;EOR^
 +247     ;;KEY^863.8:^OCXO SEMI-COLON PIECE NUMBER
 +248     ;;R^"863.8:",.01,"E"
 +249     ;;D^OCXO SEMI-COLON PIECE NUMBER
 +250     ;;EOR^
 +251     ;;KEY^863.8:^OCXO UP-ARROW PIECE NUMBER
 +252     ;;R^"863.8:",.01,"E"
 +253     ;;D^OCXO UP-ARROW PIECE NUMBER
 +254     ;;EOR^
 +255     ;;KEY^863.8:^OCXO VARIABLE NAME
 +256     ;;R^"863.8:",.01,"E"
 +257     ;;D^OCXO VARIABLE NAME
 +258     ;;EOR^
 +259     ;;KEY^863.8:^OCXO VT-BAR PIECE NUMBER
 +260     ;;R^"863.8:",.01,"E"
 +261     ;;D^OCXO VT-BAR PIECE NUMBER
 +262     ;;EOR^
 +263     ;;KEY^863.8:^PRIMARY DATA FIELD
 +264     ;1;
 +265     ;


ORY42701 * *  283 Lines,  7824 Bytes, Checksum: B71551106
                                                  Jun 28, 2016@13:15:59 page 7
              120 bytes in comments
ORY42701 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install
           of OR*3*427) ;MAY 10,2016 at 13:31
         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
         ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
         ;
S        ;
         ;
         D DOT^ORY427ES
         ;
         ;
         K REMOTE,LOCAL,OPCODE,REF
         F LINE=1:1:500 S TEXT=$P($T(DATA+LINE),";",2,999) Q:TEXT  I $L(TEXT) D 
           Q:QUIT
         .S ^TMP("OCXRULE",$J,$O(^TMP("OCXRULE",$J,"A"),-1)+1)=TEXT
         ;
         G ^ORY42702
         ;
         Q
         ;
DATA     ;
         ;
         ;;ROOT^OCXS(860.2,0)^ORDER CHECK RULE^860.2I
         ;;ROOT^OCXS(860.3,0)^ORDER CHECK ELEMENT^860.3
         ;;ROOT^OCXS(860.4,0)^ORDER CHECK DATA FIELD^860.4I
         ;;ROOT^OCXS(860.5,0)^ORDER CHECK DATA SOURCE^860.5
         ;;ROOT^OCXS(860.6,0)^ORDER CHECK DATA CONTEXT^860.6
         ;;ROOT^OCXS(860.8,0)^ORDER CHECK COMPILER FUNCTIONS^860.8
         ;;ROOT^OCXS(860.9,0)^ORDER CHECK NATIONAL TERM^860.9
         ;;ROOT^OCXS(863,0)^OCX MDD CLASS^863
         ;;ROOT^OCXS(863.1,0)^OCX MDD APPLICATION^863.1
         ;;ROOT^OCXS(863.2,0)^OCX MDD SUBJECT^863.2
         ;;ROOT^OCXS(863.3,0)^OCX MDD LINK^863.3I
         ;;ROOT^OCXS(863.4,0)^OCX MDD ATTRIBUTE^863.4
         ;;ROOT^OCXS(863.5,0)^OCX MDD VALUES^863.5
         ;;ROOT^OCXS(863.6,0)^OCX MDD METHOD^863.6
         ;;ROOT^OCXS(863.7,0)^OCX MDD PUBLIC FUNCTION^863.7
         ;;ROOT^OCXS(863.8,0)^OCX MDD PARAMETER^863.8
         ;;ROOT^OCXS(863.9,0)^OCX MDD CONDITION/FUNCTION^863.9I
         ;;ROOT^OCXS(864,0)^OCX MDD SITE PREFERENCES^864P
         ;;ROOT^OCXS(864.1,0)^OCX MDD DATATYPE^864.1
         ;;ROOT^OCXD(860.1,0)^ORDER CHECK PATIENT ACTIVE DATA^860.1P
         ;;ROOT^OCXD(860.7,0)^ORDER CHECK PATIENT RULE EVENT^860.7P
         ;;ROOT^OCXD(861,0)^ORDER CHECK RAW DATA LOG^861
         ;;SOF^863.8  OCX MDD PARAMETER
         ;;KEY^863.8:^COMPARISON VALUE
         ;;R^"863.8:",.01,"E"
         ;;D^COMPARISON VALUE
         ;;R^"863.8:",.02,"E"
         ;;D^CVAL
         ;;R^"863.8:",1,1
         ;;D^ 
         ;;R^"863.8:",1,2
         ;;D^   This is a value to be compared with PRIMARY DATA FIELD
         ;;R^"863.8:",1,3
         ;;D^ in a truth conditional.
         ;;R^"863.8:",1,4
         ;;D^ 
         ;;EOR^
         ;;KEY^863.8:^DATA TYPE
         ;;R^"863.8:",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.8:",.02,"E"
         ;;D^DATA TYPE
         ;;R^"863.8:",1,1
         ;;D^An MDD data type; i.e., an entry in the OCX MDD DATA TYPE file.
         ;;R^"863.8:","863.84:6",.01,"E"
         ;;D^QUERY
         ;;R^"863.8:","863.84:6",1,"E"
         ;;D^Enter the datatype
         ;;R^"863.8:","863.84:7",.01,"E"
         ;;D^DIC
         ;;R^"863.8:","863.84:7",1,"E"
         ;;D^864.1
         ;;R^"863.8:","863.84:8",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.8:","863.84:8",1,"E"
         ;;D^POINTER TO A FILEMAN FILE
         ;;R^"863.8:","863.84:9",.01,"E"
         ;;D^DIC LOOKUP INDEX STRING
         ;;R^"863.8:","863.84:9",1,"E"
         ;;D^B^C
         ;;EOR^
         ;;KEY^863.8:^DIC
         ;;R^"863.8:",.01,"E"
         ;;D^DIC
         ;;R^"863.8:",.02,"E"
         ;;D^DIC
         ;;R^"863.8:",1,1
         ;;D^An open reference used to specify the file in a DIC lookup
         ;;R^"863.8:","863.84:1",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.8:","863.84:1",1,"E"
         ;;D^POINTER TO A FILEMAN FILE
         ;;R^"863.8:","863.84:2",.01,"E"
         ;;D^DIC
         ;;R^"863.8:","863.84:2",1,"E"
         ;;D^1
         ;;R^"863.8:","863.84:3",.01,"E"
         ;;D^QUERY
         ;;R^"863.8:","863.84:3",1,"E"
         ;;D^Enter the name of the file you are pointing to
         ;;EOR^
         ;;KEY^863.8:^DIC LOOKUP INDEX STRING
         ;;R^"863.8:",.01,"E"
         ;;D^DIC LOOKUP INDEX STRING
         ;;R^"863.8:",.02,"E"
         ;;D^DICIX
         ;;R^"863.8:",1,1
         ;;D^Contains the names of indices to be used in a DIC lookup in a comma
         ;;R^"863.8:",1,2
         ;;D^delimited string.
         ;;R^"863.8:","863.84:1",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.8:","863.84:1",1,"E"
         ;;D^FREE TEXT
         ;;R^"863.8:","863.84:2",.01,"E"
         ;;D^QUERY
         ;;R^"863.8:","863.84:2",1,"E"
         ;;D^Enter a DIC lookup index string
         ;;R^"863.8:","863.84:3",.01,"E"
         ;;D^HELP MESSAGE
         ;;R^"863.8:","863.84:3",1,"E"
         ;;D^This is an '^' delimited string which contains the names of indices
           which are to be used in a DIC lookup; e.g., B^C^DOB.
         ;;EOR^
         ;;KEY^863.8:^FILE
         ;;R^"863.8:",.01,"E"
         ;;D^FILE
         ;;R^"863.8:",.02,"E"
         ;;D^FILE
         ;;R^"863.8:",1,1
         ;;D^The internal entry number of a file.
         ;;R^"863.8:","863.84:6",.01,"E"
         ;;D^QUERY
         ;;R^"863.8:","863.84:6",1,"E"
         ;;D^File
         ;;R^"863.8:","863.84:7",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.8:","863.84:7",1,"E"
         ;;D^POINTER TO A FILEMAN FILE
         ;;R^"863.8:","863.84:8",.01,"E"
         ;;D^DIC
         ;;R^"863.8:","863.84:8",1,"E"
         ;;D^1
         ;;EOR^
         ;;KEY^863.8:^FM MASK
         ;;R^"863.8:",.01,"E"
         ;;D^FM MASK
         ;;R^"863.8:",.02,"E"
         ;;D^FM MASK
         ;;R^"863.8:",1,1
         ;;D^Tag^routine where code is located to parse the FM DD and override t
          he parameter value
         ;;R^"863.8:","863.84:4",.01,"E"
         ;;D^QUERY
         ;;R^"863.8:","863.84:4",1,"E"
         ;;D^Enter tag^routine where the FM MASK parser is located
         ;;R^"863.8:","863.84:5",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.8:","863.84:5",1,"E"
         ;;D^LINE TAG
         ;;EOR^
         ;;KEY^863.8:^FREE TEXT MAXIMUM LENGTH
         ;;R^"863.8:",.01,"E"
         ;;D^FREE TEXT MAXIMUM LENGTH
         ;;R^"863.8:",.02,"E"
         ;;D^FMAX
         ;;R^"863.8:",1,1
         ;;D^Maximum string length allowed
         ;;R^"863.8:",2,"E"
         ;;D^245
         ;;R^"863.8:","863.84:3",.01,"E"
         ;;D^QUERY
         ;;R^"863.8:","863.84:3",1,"E"
         ;;D^Maximum text string length allowed
         ;;R^"863.8:","863.84:4",.01,"E"
         ;;D^FM MASK
         ;;R^"863.8:","863.84:4",1,"E"
         ;;D^FMAX^OCXF6
         ;;R^"863.8:","863.84:5",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.8:","863.84:5",1,"E"
         ;;D^POSITIVE INTEGER
         ;;EOR^
         ;;KEY^863.8:^HELP MESSAGE
         ;;R^"863.8:",.01,"E"
         ;;D^HELP MESSAGE
         ;;R^"863.8:",.02,"E"
         ;;D^HELP
         ;;R^"863.8:",1,1
         ;;D^A text string 1-250 characters long which overrides the Fileman hel
          p
         ;;R^"863.8:",1,2
         ;;D^message.
         ;;R^"863.8:","863.84:10",.01,"E"
         ;;D^QUERY
         ;;R^"863.8:","863.84:10",1,"E"
         ;;D^Enter a brief help message
         ;;R^"863.8:","863.84:8",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.8:","863.84:8",1,"E"
         ;;D^FREE TEXT
         ;;R^"863.8:","863.84:9",.01,"E"
         ;;D^FM MASK
         ;;R^"863.8:","863.84:9",1,"E"
         ;;D^HELP^OCXF6
         ;;EOR^
         ;;KEY^863.8:^LOOP QUERY
         ;;R^"863.8:",.01,"E"
         ;;D^LOOP QUERY
         ;;R^"863.8:",.02,"E"
         ;;D^LOOP QUERY
         ;;R^"863.8:",1,1
         ;;D^Alternate query used when repeated answers are required
         ;;R^"863.8:","863.84:1",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.8:","863.84:1",1,"E"
         ;;D^FREE TEXT
         ;;R^"863.8:","863.84:2",.01,"E"
         ;;D^QUERY
         ;;R^"863.8:","863.84:2",1,"E"
         ;;D^Enter loop query text
         ;;R^"863.8:","863.84:3",.01,"E"
         ;;D^HELP MESSAGE
         ;;R^"863.8:","863.84:3",1,"E"
         ;;D^This is the query text for all entries after the first one
         ;;EOR^
         ;;KEY^863.8:^MANDATORY MESSAGE
         ;;R^"863.8:",.01,"E"
         ;;D^MANDATORY MESSAGE
         ;;R^"863.8:",.02,"E"
         ;;D^MAND MSG
         ;;R^"863.8:",1,1
         ;;D^Message sent to user telling him that his entry is mandatory
         ;;R^"863.8:",2,"E"
         ;;D^Mandatory answer.  You must enter a value or '^' to exit.
         ;;R^"863.8:","863.84:4",.01,"E"
         ;;D^QUERY
         ;;R^"863.8:","863.84:4",1,"E"
         ;;D^Enter message
         ;;R^"863.8:","863.84:5",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.8:","863.84:5",1,"E"
         ;;D^FREE TEXT
         ;;EOR^
         ;;KEY^863.8:^OCXO DATA DRIVE SOURCE
         ;;R^"863.8:",.01,"E"
         ;;D^OCXO DATA DRIVE SOURCE
         ;;EOR^
         ;;KEY^863.8:^OCXO EXTERNAL FUNCTION CALL
         ;;R^"863.8:",.01,"E"
         ;;D^OCXO EXTERNAL FUNCTION CALL
         ;;EOR^
         ;;KEY^863.8:^OCXO FILE POINTER
         ;;R^"863.8:",.01,"E"
         ;;D^OCXO FILE POINTER
         ;;EOR^
         ;;KEY^863.8:^OCXO GENERATE CODE FUNCTION
         ;;R^"863.8:",.01,"E"
         ;;D^OCXO GENERATE CODE FUNCTION
         ;;R^"863.8:",.02,"E"
         ;;D^GEN
         ;;EOR^
         ;;KEY^863.8:^OCXO HL7 SEGMENT ID
         ;;R^"863.8:",.01,"E"
         ;;D^OCXO HL7 SEGMENT ID
         ;;R^"863.8:",.02,"E"
         ;;D^HL7SEGID
         ;;EOR^
         ;;KEY^863.8:^OCXO SEMI-COLON PIECE NUMBER
         ;;R^"863.8:",.01,"E"
         ;;D^OCXO SEMI-COLON PIECE NUMBER
         ;;EOR^
         ;;KEY^863.8:^OCXO UP-ARROW PIECE NUMBER
         ;;R^"863.8:",.01,"E"
         ;;D^OCXO UP-ARROW PIECE NUMBER
         ;;EOR^
         ;;KEY^863.8:^OCXO VARIABLE NAME
         ;;R^"863.8:",.01,"E"
         ;;D^OCXO VARIABLE NAME
         ;;EOR^
         ;;KEY^863.8:^OCXO VT-BAR PIECE NUMBER
         ;;R^"863.8:",.01,"E"
         ;;D^OCXO VT-BAR PIECE NUMBER
         ;;EOR^
         ;;KEY^863.8:^PRIMARY DATA FIELD
         ;1;
         ;

*****   INDEX OF ORY42701   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
>> LINE         S+6*
   LOCAL        S+5!
   OPCODE       S+5!
>> QUIT         S+6
   REF          S+5!
   REMOTE       S+5!
>> TEXT         S+6*,S+7

Global Variables  ( * Changed  ! Killed)
   ^TMP("OCXRULE"      S+7*

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   $T(DATA+LINE S+6

Label References
   NONE

External References
   ^ORY42702           S+9
   DOT^ORY427ES        S+2

*****   END   *****
ORY42702   8047     printed  Jun 28, 2016@13:15:59                     Page 8

ORY42702  ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Instal
l of OR*3*427) ;MAY 10,2016 at 13:31
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 +3       ;
S         ;
 +1       ;
 +2        DO DOT^ORY427ES
 +3       ;
 +4       ;
 +5        KILL REMOTE,LOCAL,OPCODE,REF
 +6        FOR LINE=1:1:500
               SET TEXT=$PIECE($TEXT(DATA+LINE),";",2,999)
               IF TEXT
                   QUIT 
               IF $LENGTH(TEXT)
                   Begin DoDot:1
 +7                    SET ^TMP("OCXRULE",$JOB,$ORDER(^TMP("OCXRULE",$JOB,"A"),-
1)+1)=TEXT
                   End DoDot:1
                   IF QUIT
                       QUIT 
 +8       ;
 +9        GOTO ^ORY42703
 +10      ;
 +11       QUIT 
 +12      ;
DATA      ;
 +1       ;
 +2       ;;R^"863.8:",.01,"E"
 +3       ;;D^PRIMARY DATA FIELD
 +4       ;;R^"863.8:",.02,"E"
 +5       ;;D^PDFLD
 +6       ;;R^"863.8:",1,1
 +7       ;;D^ 
 +8       ;;R^"863.8:",1,2
 +9       ;;D^  Primary data field in a comparison expression that
 +10      ;;R^"863.8:",1,3
 +11      ;;D^ is to be tested.
 +12      ;;R^"863.8:",1,4
 +13      ;;D^ 
 +14      ;;EOR^
 +15      ;;KEY^863.8:^QUERY
 +16      ;;R^"863.8:",.01,"E"
 +17      ;;D^QUERY
 +18      ;;R^"863.8:",.02,"E"
 +19      ;;D^QUERY
 +20      ;;R^"863.8:",1,1
 +21      ;;D^Used with methods that manage interactive dialogues.  Equivalent t
o DIC("A")
 +22      ;;R^"863.8:","863.84:1",.01,"E"
 +23      ;;D^DATA TYPE
 +24      ;;R^"863.8:","863.84:1",1,"E"
 +25      ;;D^FREE TEXT
 +26      ;;R^"863.8:","863.84:2",.01,"E"
 +27      ;;D^QUERY
 +28      ;;R^"863.8:","863.84:2",1,"E"
 +29      ;;D^Enter the query (free text string)
 +30      ;;EOR^
 +31      ;;KEY^863.8:^REPEAT THE QUERY
 +32      ;;R^"863.8:",.01,"E"
 +33      ;;D^REPEAT THE QUERY
 +34      ;;R^"863.8:",.02,"E"
 +35      ;;D^LOOP
 +36      ;;R^"863.8:",1,1
 +37      ;;D^Set this = 1 to repetitively ask the user to enter a value
 +38      ;;R^"863.8:","863.84:1",.01,"E"
 +39      ;;D^DATA TYPE
 +40      ;;R^"863.8:","863.84:1",1,"E"
 +41      ;;D^YES NO
 +42      ;;R^"863.8:","863.84:2",.01,"E"
 +43      ;;D^HELP MESSAGE
 +44      ;;R^"863.8:","863.84:2",1,"E"
 +45      ;;D^Answer 'YES' if you want the user to repetitively enter a value.
 +46      ;;R^"863.8:","863.84:3",.01,"E"
 +47      ;;D^QUERY
 +48      ;;R^"863.8:","863.84:3",1,"E"
 +49      ;;D^Is the query repetitive
 +50      ;;EOR^
 +51      ;;KEY^863.8:^TERMINATOR
 +52      ;;R^"863.8:",.01,"E"
 +53      ;;D^TERMINATOR
 +54      ;;R^"863.8:",.02,"E"
 +55      ;;D^TERMINATOR
 +56      ;;R^"863.8:",1,1
 +57      ;;D^A text string terminator; e.g., '?', ': ', '=>'
 +58      ;;R^"863.8:",2,"E"
 +59      ;;D^:
 +60      ;;R^"863.8:","863.84:4",.01,"E"
 +61      ;;D^QUERY
 +62      ;;R^"863.8:","863.84:4",1,"E"
 +63      ;;D^Enter text string terminator
 +64      ;;R^"863.8:","863.84:5",.01,"E"
 +65      ;;D^DATA TYPE
 +66      ;;R^"863.8:","863.84:5",1,"E"
 +67      ;;D^FREE TEXT
 +68      ;;R^"863.8:","863.84:6",.01,"E"
 +69      ;;D^FREE TEXT MAXIMUM LENGTH
 +70      ;;R^"863.8:","863.84:6",1,"E"
 +71      ;;D^9
 +72      ;;EOR^
 +73      ;;KEY^863.8:^VALUE CALL
 +74      ;;R^"863.8:",.01,"E"
 +75      ;;D^VALUE CALL
 +76      ;;R^"863.8:",.02,"E"
 +77      ;;D^VAL CALL
 +78      ;;R^"863.8:",.03,"E"
 +79      ;;D^NO
 +80      ;;R^"863.8:",1,1
 +81      ;;D^tag^routine which manages the dialogue for collecting and validati
ng a value
 +82      ;;R^"863.8:","863.84:3",.01,"E"
 +83      ;;D^QUERY
 +84      ;;R^"863.8:","863.84:3",1,"E"
 +85      ;;D^Enter tag^routine
 +86      ;;R^"863.8:","863.84:4",.01,"E"
 +87      ;;D^DATA TYPE
 +88      ;;R^"863.8:","863.84:4",1,"E"
 +89      ;;D^LINE TAG
 +90      ;;EOR^
 +91      ;;EOF^OCXS(863.8)^1
 +92      ;;SOF^864.1  OCX MDD DATATYPE
 +93      ;;KEY^864.1:^BOOLEAN
 +94      ;;R^"864.1:",.01,"E"
 +95      ;;D^BOOLEAN
 +96      ;;R^"864.1:",.02,"E"
 +97      ;;D^BOOL
 +98      ;;EOR^
 +99      ;;KEY^864.1:^FREE TEXT
 +100     ;;R^"864.1:",.01,"E"
 +101     ;;D^FREE TEXT
 +102     ;;R^"864.1:",.02,"E"
 +103     ;;D^FT
 +104     ;;R^"864.1:",2,"E"
 +105     ;;D^GENERIC
 +106     ;;R^"864.1:","864.11:1",.01,"E"
 +107     ;;D^VALUE CALL
 +108     ;;R^"864.1:","864.11:1",1,"E"
 +109     ;;D^FT^OCXFDFT
 +110     ;;R^"864.1:","864.11:2",.01,"E"
 +111     ;;D^QUERY
 +112     ;;R^"864.1:","864.11:2",1,"E"
 +113     ;;D^Enter a free text string
 +114     ;;R^"864.1:","864.11:3",.01,"E"
 +115     ;;D^FREE TEXT MAXIMUM LENGTH
 +116     ;;R^"864.1:","864.11:3",1,"E"
 +117     ;;D^240
 +118     ;;R^"864.1:","864.11:4",.01,"E"
 +119     ;;D^HELP MESSAGE
 +120     ;;R^"864.1:","864.11:4",1,"E"
 +121     ;;D^Enter a free text string.  Do not use control characters.  |FTMM H
ELP|
 +122     ;;R^"864.1:","864.11:5",.01,"E"
 +123     ;;D^LOOP QUERY
 +124     ;;R^"864.1:","864.11:5",1,"E"
 +125     ;;D^Enter another free text string
 +126     ;;R^"864.1:","864.11:6",.01,"E"
 +127     ;;D^REPEAT THE QUERY
 +128     ;;R^"864.1:","864.11:6",1,"E"
 +129     ;;D^0
 +130     ;;EOR^
 +131     ;;KEY^864.1:^GENERIC
 +132     ;;R^"864.1:",.01,"E"
 +133     ;;D^GENERIC
 +134     ;;R^"864.1:",.02,"E"
 +135     ;;D^GENERIC
 +136     ;;R^"864.1:","864.11:11",.01,"E"
 +137     ;;D^MANDATORY MESSAGE
 +138     ;;R^"864.1:","864.11:11",1,"E"
 +139     ;;D^This answer is mandatory.  Enter a response or press '^' to exit.
 +140     ;;R^"864.1:","864.11:12",.01,"E"
 +141     ;;D^TERMINATOR
 +142     ;;R^"864.1:","864.11:12",1,"E"
 +143     ;;D^:
 +144     ;;R^"864.1:","864.11:13",.01,"E"
 +145     ;;D^LOOP QUERY
 +146     ;;R^"864.1:","864.11:13",1,"E"
 +147     ;;D^Enter another value
 +148     ;;R^"864.1:","864.11:7",.01,"E"
 +149     ;;D^VALUE CALL
 +150     ;;R^"864.1:","864.11:7",1,"E"
 +151     ;;D^GEN^OCXFDMOM
 +152     ;;R^"864.1:","864.11:8",.01,"E"
 +153     ;;D^QUERY
 +154     ;;R^"864.1:","864.11:8",1,"E"
 +155     ;;D^Enter a value
 +156     ;;R^"864.1:","864.11:9",.01,"E"
 +157     ;;D^HELP MESSAGE
 +158     ;;R^"864.1:","864.11:9",1,"E"
 +159     ;;D^ 
 +160     ;;EOR^
 +161     ;;KEY^864.1:^NUMERIC
 +162     ;;R^"864.1:",.01,"E"
 +163     ;;D^NUMERIC
 +164     ;;R^"864.1:",.02,"E"
 +165     ;;D^NUMERIC
 +166     ;;R^"864.1:",2,"E"
 +167     ;;D^GENERIC
 +168     ;;R^"864.1:","864.11:1",.01,"E"
 +169     ;;D^VALUE CALL
 +170     ;;R^"864.1:","864.11:1",1,"E"
 +171     ;;D^NU^OCXFDNU
 +172     ;;R^"864.1:","864.11:2",.01,"E"
 +173     ;;D^QUERY
 +174     ;;R^"864.1:","864.11:2",1,"E"
 +175     ;;D^Enter a number
 +176     ;;R^"864.1:","864.11:3",.01,"E"
 +177     ;;D^LOOP QUERY
 +178     ;;R^"864.1:","864.11:3",1,"E"
 +179     ;;D^Enter another number
 +180     ;;R^"864.1:","864.11:4",.01,"E"
 +181     ;;D^REPEAT THE QUERY
 +182     ;;R^"864.1:","864.11:4",1,"E"
 +183     ;;D^0
 +184     ;;EOR^
 +185     ;;EOF^OCXS(864.1)^1
 +186     ;;SOF^863.7  OCX MDD PUBLIC FUNCTION
 +187     ;;KEY^863.7:^GCC BOOLEAN LOGICAL FALSE
 +188     ;;R^"863.7:",.01,"E"
 +189     ;;D^GCC BOOLEAN LOGICAL FALSE
 +190     ;;R^"863.7:",.02,"E"
 +191     ;;D^EXTRINSIC FUNCTION
 +192     ;;R^"863.7:",3,"E"
 +193     ;;D^FALSE^OCXF23
 +194     ;;R^"863.7:","863.74:1",.01,"E"
 +195     ;;D^PRIMARY DATA FIELD
 +196     ;;R^"863.7:","863.74:1",1.1,"E"
 +197     ;;D^1
 +198     ;;EOR^
 +199     ;;KEY^863.7:^GCC BOOLEAN LOGICAL TRUE
 +200     ;;R^"863.7:",.01,"E"
 +201     ;;D^GCC BOOLEAN LOGICAL TRUE
 +202     ;;R^"863.7:",.02,"E"
 +203     ;;D^EXTRINSIC FUNCTION
 +204     ;;R^"863.7:",3,"E"
 +205     ;;D^TRUE^OCXF23
 +206     ;;R^"863.7:","863.74:1",.01,"E"
 +207     ;;D^PRIMARY DATA FIELD
 +208     ;;R^"863.7:","863.74:1",1.1,"E"
 +209     ;;D^1
 +210     ;;EOR^
 +211     ;;KEY^863.7:^GCC FREE TEXT EQUALS
 +212     ;;R^"863.7:",.01,"E"
 +213     ;;D^GCC FREE TEXT EQUALS
 +214     ;;R^"863.7:",.02,"E"
 +215     ;;D^EXTRINSIC FUNCTION
 +216     ;;R^"863.7:",3,"E"
 +217     ;;D^AEQ^OCXF22
 +218     ;;R^"863.7:","863.74:1",.01,"E"
 +219     ;;D^PRIMARY DATA FIELD
 +220     ;;R^"863.7:","863.74:1",1.1,"E"
 +221     ;;D^1
 +222     ;;R^"863.7:","863.74:2",.01,"E"
 +223     ;;D^COMPARISON VALUE
 +224     ;;R^"863.7:","863.74:2",1.1,"E"
 +225     ;;D^2
 +226     ;;EOR^
 +227     ;;KEY^863.7:^GCC FREE TEXT STARTS WITH
 +228     ;;R^"863.7:",.01,"E"
 +229     ;;D^GCC FREE TEXT STARTS WITH
 +230     ;;R^"863.7:",.02,"E"
 +231     ;;D^EXTRINSIC FUNCTION
 +232     ;;R^"863.7:",3,"E"
 +233     ;;D^START^OCXF22
 +234     ;;R^"863.7:","863.74:1",.01,"E"
 +235     ;;D^PRIMARY DATA FIELD
 +236     ;;R^"863.7:","863.74:1",1.1,"E"
 +237     ;;D^1
 +238     ;;R^"863.7:","863.74:2",.01,"E"
 +239     ;;D^COMPARISON VALUE
 +240     ;;R^"863.7:","863.74:2",1.1,"E"
 +241     ;;D^2
 +242     ;;EOR^
 +243     ;;KEY^863.7:^GCC NUMERIC GREATER THAN
 +244     ;;R^"863.7:",.01,"E"
 +245     ;;D^GCC NUMERIC GREATER THAN
 +246     ;;R^"863.7:",.02,"E"
 +247     ;;D^EXTRINSIC FUNCTION
 +248     ;;R^"863.7:",3,"E"
 +249     ;;D^GRT^OCXF20
 +250     ;;R^"863.7:","863.74:1",.01,"E"
 +251     ;;D^PRIMARY DATA FIELD
 +252     ;;R^"863.7:","863.74:1",1.1,"E"
 +253     ;;D^1
 +254     ;;R^"863.7:","863.74:2",.01,"E"
 +255     ;;D^COMPARISON VALUE
 +256     ;;R^"863.7:","863.74:2",1.1,"E"
 +257     ;;D^2
 +258     ;;EOR^
 +259     ;;KEY^863.7:^GCC NUMERIC LESS THAN
 +260     ;;R^"863.7:",.01,"E"
 +261     ;;D^GCC NUMERIC LESS THAN
 +262     ;;R^"863.7:",.02,"E"
 +263     ;;D^EXTRINSIC FUNCTION
 +264     ;;R^"863.7:",3,"E"
 +265     ;;D^LESS^OCXF20
 +266     ;;R^"863.7:","863.74:1",.01,"E"
 +267     ;;D^PRIMARY DATA FIELD
 +268     ;;R^"863.7:","863.74:1",1.1,"E"
 +269     ;;D^1
 +270     ;;R^"863.7:","863.74:2",.01,"E"
 +271     ;;D^COMPARISON VALUE
 +272     ;;R^"863.7:","863.74:2",1.1,"E"
 +273     ;;D^2
 +274     ;;EOR^
 +275     ;;EOF^OCXS(863.7)^1
 +276     ;;SOF^863.9  OCX MDD CONDITION/FUNCTION
 +277     ;;KEY^863.9:^EQ FREE TEXT
 +278     ;;R^"863.9:",.01,"E"
 +279     ;;D^EQ FREE TEXT
 +280     ;;R^"863.9:",.02,"E"
 +281     ;;D^FREE TEXT
 +282     ;;R^"863.9:",.04,"E"
 +283     ;;D^IS EQUAL TO
 +284     ;;R^"863.9:","863.91:3",.01,"E"
 +285     ;;D^OCXO GENERATE CODE FUNCTION
 +286     ;;R^"863.9:","863.91:3",1,"E"
 +287     ;;D^GCC FREE TEXT EQUALS
 +288     ;;R^"863.9:","863.92:1",.01,"E"
 +289     ;;D^EQUALS
 +290     ;;EOR^
 +291     ;;KEY^863.9:^GREATER THAN
 +292     ;;R^"863.9:",.01,"E"
 +293     ;;D^GREATER THAN
 +294     ;;R^"863.9:",.02,"E"
 +295     ;;D^NUMERIC
 +296     ;;R^"863.9:",.04,"E"
 +297     ;;D^IS GREATER THAN
 +298     ;;R^"863.9:","863.91:3",.01,"E"
 +299     ;;D^OCXO GENERATE CODE FUNCTION
 +300     ;;R^"863.9:","863.91:3",1,"E"
 +301     ;;D^GCC NUMERIC GREATER THAN
 +302     ;;EOR^
 +303     ;;KEY^863.9:^LESS THAN
 +304     ;;R^"863.9:",.01,"E"
 +305     ;;D^LESS THAN
 +306     ;;R^"863.9:",.02,"E"
 +307     ;;D^NUMERIC
 +308     ;;R^"863.9:",.04,"E"
 +309     ;1;
 +310     ;


ORY42702 * *  328 Lines,  8047 Bytes, Checksum: B79020863
                                                  Jun 28, 2016@13:15:59 page 9
              120 bytes in comments
ORY42702 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install
           of OR*3*427) ;MAY 10,2016 at 13:31
         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
         ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
         ;
S        ;
         ;
         D DOT^ORY427ES
         ;
         ;
         K REMOTE,LOCAL,OPCODE,REF
         F LINE=1:1:500 S TEXT=$P($T(DATA+LINE),";",2,999) Q:TEXT  I $L(TEXT) D 
           Q:QUIT
         .S ^TMP("OCXRULE",$J,$O(^TMP("OCXRULE",$J,"A"),-1)+1)=TEXT
         ;
         G ^ORY42703
         ;
         Q
         ;
DATA     ;
         ;
         ;;R^"863.8:",.01,"E"
         ;;D^PRIMARY DATA FIELD
         ;;R^"863.8:",.02,"E"
         ;;D^PDFLD
         ;;R^"863.8:",1,1
         ;;D^ 
         ;;R^"863.8:",1,2
         ;;D^  Primary data field in a comparison expression that
         ;;R^"863.8:",1,3
         ;;D^ is to be tested.
         ;;R^"863.8:",1,4
         ;;D^ 
         ;;EOR^
         ;;KEY^863.8:^QUERY
         ;;R^"863.8:",.01,"E"
         ;;D^QUERY
         ;;R^"863.8:",.02,"E"
         ;;D^QUERY
         ;;R^"863.8:",1,1
         ;;D^Used with methods that manage interactive dialogues.  Equivalent to
           DIC("A")
         ;;R^"863.8:","863.84:1",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.8:","863.84:1",1,"E"
         ;;D^FREE TEXT
         ;;R^"863.8:","863.84:2",.01,"E"
         ;;D^QUERY
         ;;R^"863.8:","863.84:2",1,"E"
         ;;D^Enter the query (free text string)
         ;;EOR^
         ;;KEY^863.8:^REPEAT THE QUERY
         ;;R^"863.8:",.01,"E"
         ;;D^REPEAT THE QUERY
         ;;R^"863.8:",.02,"E"
         ;;D^LOOP
         ;;R^"863.8:",1,1
         ;;D^Set this = 1 to repetitively ask the user to enter a value
         ;;R^"863.8:","863.84:1",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.8:","863.84:1",1,"E"
         ;;D^YES NO
         ;;R^"863.8:","863.84:2",.01,"E"
         ;;D^HELP MESSAGE
         ;;R^"863.8:","863.84:2",1,"E"
         ;;D^Answer 'YES' if you want the user to repetitively enter a value.
         ;;R^"863.8:","863.84:3",.01,"E"
         ;;D^QUERY
         ;;R^"863.8:","863.84:3",1,"E"
         ;;D^Is the query repetitive
         ;;EOR^
         ;;KEY^863.8:^TERMINATOR
         ;;R^"863.8:",.01,"E"
         ;;D^TERMINATOR
         ;;R^"863.8:",.02,"E"
         ;;D^TERMINATOR
         ;;R^"863.8:",1,1
         ;;D^A text string terminator; e.g., '?', ': ', '=>'
         ;;R^"863.8:",2,"E"
         ;;D^:
         ;;R^"863.8:","863.84:4",.01,"E"
         ;;D^QUERY
         ;;R^"863.8:","863.84:4",1,"E"
         ;;D^Enter text string terminator
         ;;R^"863.8:","863.84:5",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.8:","863.84:5",1,"E"
         ;;D^FREE TEXT
         ;;R^"863.8:","863.84:6",.01,"E"
         ;;D^FREE TEXT MAXIMUM LENGTH
         ;;R^"863.8:","863.84:6",1,"E"
         ;;D^9
         ;;EOR^
         ;;KEY^863.8:^VALUE CALL
         ;;R^"863.8:",.01,"E"
         ;;D^VALUE CALL
         ;;R^"863.8:",.02,"E"
         ;;D^VAL CALL
         ;;R^"863.8:",.03,"E"
         ;;D^NO
         ;;R^"863.8:",1,1
         ;;D^tag^routine which manages the dialogue for collecting and validatin
          g a value
         ;;R^"863.8:","863.84:3",.01,"E"
         ;;D^QUERY
         ;;R^"863.8:","863.84:3",1,"E"
         ;;D^Enter tag^routine
         ;;R^"863.8:","863.84:4",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.8:","863.84:4",1,"E"
         ;;D^LINE TAG
         ;;EOR^
         ;;EOF^OCXS(863.8)^1
         ;;SOF^864.1  OCX MDD DATATYPE
         ;;KEY^864.1:^BOOLEAN
         ;;R^"864.1:",.01,"E"
         ;;D^BOOLEAN
         ;;R^"864.1:",.02,"E"
         ;;D^BOOL
         ;;EOR^
         ;;KEY^864.1:^FREE TEXT
         ;;R^"864.1:",.01,"E"
         ;;D^FREE TEXT
         ;;R^"864.1:",.02,"E"
         ;;D^FT
         ;;R^"864.1:",2,"E"
         ;;D^GENERIC
         ;;R^"864.1:","864.11:1",.01,"E"
         ;;D^VALUE CALL
         ;;R^"864.1:","864.11:1",1,"E"
         ;;D^FT^OCXFDFT
         ;;R^"864.1:","864.11:2",.01,"E"
         ;;D^QUERY
         ;;R^"864.1:","864.11:2",1,"E"
         ;;D^Enter a free text string
         ;;R^"864.1:","864.11:3",.01,"E"
         ;;D^FREE TEXT MAXIMUM LENGTH
         ;;R^"864.1:","864.11:3",1,"E"
         ;;D^240
         ;;R^"864.1:","864.11:4",.01,"E"
         ;;D^HELP MESSAGE
         ;;R^"864.1:","864.11:4",1,"E"
         ;;D^Enter a free text string.  Do not use control characters.  |FTMM HE
          LP|
         ;;R^"864.1:","864.11:5",.01,"E"
         ;;D^LOOP QUERY
         ;;R^"864.1:","864.11:5",1,"E"
         ;;D^Enter another free text string
         ;;R^"864.1:","864.11:6",.01,"E"
         ;;D^REPEAT THE QUERY
         ;;R^"864.1:","864.11:6",1,"E"
         ;;D^0
         ;;EOR^
         ;;KEY^864.1:^GENERIC
         ;;R^"864.1:",.01,"E"
         ;;D^GENERIC
         ;;R^"864.1:",.02,"E"
         ;;D^GENERIC
         ;;R^"864.1:","864.11:11",.01,"E"
         ;;D^MANDATORY MESSAGE
         ;;R^"864.1:","864.11:11",1,"E"
         ;;D^This answer is mandatory.  Enter a response or press '^' to exit.
         ;;R^"864.1:","864.11:12",.01,"E"
         ;;D^TERMINATOR
         ;;R^"864.1:","864.11:12",1,"E"
         ;;D^:
         ;;R^"864.1:","864.11:13",.01,"E"
         ;;D^LOOP QUERY
         ;;R^"864.1:","864.11:13",1,"E"
         ;;D^Enter another value
         ;;R^"864.1:","864.11:7",.01,"E"
         ;;D^VALUE CALL
         ;;R^"864.1:","864.11:7",1,"E"
         ;;D^GEN^OCXFDMOM
         ;;R^"864.1:","864.11:8",.01,"E"
         ;;D^QUERY
         ;;R^"864.1:","864.11:8",1,"E"
         ;;D^Enter a value
         ;;R^"864.1:","864.11:9",.01,"E"
         ;;D^HELP MESSAGE
         ;;R^"864.1:","864.11:9",1,"E"
         ;;D^ 
         ;;EOR^
         ;;KEY^864.1:^NUMERIC
         ;;R^"864.1:",.01,"E"
         ;;D^NUMERIC
         ;;R^"864.1:",.02,"E"
         ;;D^NUMERIC
         ;;R^"864.1:",2,"E"
         ;;D^GENERIC
         ;;R^"864.1:","864.11:1",.01,"E"
         ;;D^VALUE CALL
         ;;R^"864.1:","864.11:1",1,"E"
         ;;D^NU^OCXFDNU
         ;;R^"864.1:","864.11:2",.01,"E"
         ;;D^QUERY
         ;;R^"864.1:","864.11:2",1,"E"
         ;;D^Enter a number
         ;;R^"864.1:","864.11:3",.01,"E"
         ;;D^LOOP QUERY
         ;;R^"864.1:","864.11:3",1,"E"
         ;;D^Enter another number
         ;;R^"864.1:","864.11:4",.01,"E"
         ;;D^REPEAT THE QUERY
         ;;R^"864.1:","864.11:4",1,"E"
         ;;D^0
         ;;EOR^
         ;;EOF^OCXS(864.1)^1
         ;;SOF^863.7  OCX MDD PUBLIC FUNCTION
         ;;KEY^863.7:^GCC BOOLEAN LOGICAL FALSE
         ;;R^"863.7:",.01,"E"
         ;;D^GCC BOOLEAN LOGICAL FALSE
         ;;R^"863.7:",.02,"E"
         ;;D^EXTRINSIC FUNCTION
         ;;R^"863.7:",3,"E"
         ;;D^FALSE^OCXF23
         ;;R^"863.7:","863.74:1",.01,"E"
         ;;D^PRIMARY DATA FIELD
         ;;R^"863.7:","863.74:1",1.1,"E"
         ;;D^1
         ;;EOR^
         ;;KEY^863.7:^GCC BOOLEAN LOGICAL TRUE
         ;;R^"863.7:",.01,"E"
         ;;D^GCC BOOLEAN LOGICAL TRUE
         ;;R^"863.7:",.02,"E"
         ;;D^EXTRINSIC FUNCTION
         ;;R^"863.7:",3,"E"
         ;;D^TRUE^OCXF23
         ;;R^"863.7:","863.74:1",.01,"E"
         ;;D^PRIMARY DATA FIELD
         ;;R^"863.7:","863.74:1",1.1,"E"
         ;;D^1
         ;;EOR^
         ;;KEY^863.7:^GCC FREE TEXT EQUALS
         ;;R^"863.7:",.01,"E"
         ;;D^GCC FREE TEXT EQUALS
         ;;R^"863.7:",.02,"E"
         ;;D^EXTRINSIC FUNCTION
         ;;R^"863.7:",3,"E"
         ;;D^AEQ^OCXF22
         ;;R^"863.7:","863.74:1",.01,"E"
         ;;D^PRIMARY DATA FIELD
         ;;R^"863.7:","863.74:1",1.1,"E"
         ;;D^1
         ;;R^"863.7:","863.74:2",.01,"E"
         ;;D^COMPARISON VALUE
         ;;R^"863.7:","863.74:2",1.1,"E"
         ;;D^2
         ;;EOR^
         ;;KEY^863.7:^GCC FREE TEXT STARTS WITH
         ;;R^"863.7:",.01,"E"
         ;;D^GCC FREE TEXT STARTS WITH
         ;;R^"863.7:",.02,"E"
         ;;D^EXTRINSIC FUNCTION
         ;;R^"863.7:",3,"E"
         ;;D^START^OCXF22
         ;;R^"863.7:","863.74:1",.01,"E"
         ;;D^PRIMARY DATA FIELD
         ;;R^"863.7:","863.74:1",1.1,"E"
         ;;D^1
         ;;R^"863.7:","863.74:2",.01,"E"
         ;;D^COMPARISON VALUE
         ;;R^"863.7:","863.74:2",1.1,"E"
         ;;D^2
         ;;EOR^
         ;;KEY^863.7:^GCC NUMERIC GREATER THAN
         ;;R^"863.7:",.01,"E"
         ;;D^GCC NUMERIC GREATER THAN
         ;;R^"863.7:",.02,"E"
         ;;D^EXTRINSIC FUNCTION
         ;;R^"863.7:",3,"E"
         ;;D^GRT^OCXF20
         ;;R^"863.7:","863.74:1",.01,"E"
         ;;D^PRIMARY DATA FIELD
         ;;R^"863.7:","863.74:1",1.1,"E"
         ;;D^1
         ;;R^"863.7:","863.74:2",.01,"E"
         ;;D^COMPARISON VALUE
         ;;R^"863.7:","863.74:2",1.1,"E"
         ;;D^2
         ;;EOR^
         ;;KEY^863.7:^GCC NUMERIC LESS THAN
         ;;R^"863.7:",.01,"E"
         ;;D^GCC NUMERIC LESS THAN
         ;;R^"863.7:",.02,"E"
         ;;D^EXTRINSIC FUNCTION
         ;;R^"863.7:",3,"E"
         ;;D^LESS^OCXF20
         ;;R^"863.7:","863.74:1",.01,"E"
         ;;D^PRIMARY DATA FIELD
         ;;R^"863.7:","863.74:1",1.1,"E"
         ;;D^1
         ;;R^"863.7:","863.74:2",.01,"E"
         ;;D^COMPARISON VALUE
         ;;R^"863.7:","863.74:2",1.1,"E"
         ;;D^2
         ;;EOR^
         ;;EOF^OCXS(863.7)^1
         ;;SOF^863.9  OCX MDD CONDITION/FUNCTION
         ;;KEY^863.9:^EQ FREE TEXT
         ;;R^"863.9:",.01,"E"
         ;;D^EQ FREE TEXT
         ;;R^"863.9:",.02,"E"
         ;;D^FREE TEXT
         ;;R^"863.9:",.04,"E"
         ;;D^IS EQUAL TO
         ;;R^"863.9:","863.91:3",.01,"E"
         ;;D^OCXO GENERATE CODE FUNCTION
         ;;R^"863.9:","863.91:3",1,"E"
         ;;D^GCC FREE TEXT EQUALS
         ;;R^"863.9:","863.92:1",.01,"E"
         ;;D^EQUALS
         ;;EOR^
         ;;KEY^863.9:^GREATER THAN
         ;;R^"863.9:",.01,"E"
         ;;D^GREATER THAN
         ;;R^"863.9:",.02,"E"
         ;;D^NUMERIC
         ;;R^"863.9:",.04,"E"
         ;;D^IS GREATER THAN
         ;;R^"863.9:","863.91:3",.01,"E"
         ;;D^OCXO GENERATE CODE FUNCTION
         ;;R^"863.9:","863.91:3",1,"E"
         ;;D^GCC NUMERIC GREATER THAN
         ;;EOR^
         ;;KEY^863.9:^LESS THAN
         ;;R^"863.9:",.01,"E"
         ;;D^LESS THAN
         ;;R^"863.9:",.02,"E"
         ;;D^NUMERIC
         ;;R^"863.9:",.04,"E"
         ;1;
         ;

*****   INDEX OF ORY42702   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
>> LINE         S+6*
   LOCAL        S+5!
   OPCODE       S+5!
>> QUIT         S+6
   REF          S+5!
   REMOTE       S+5!
>> TEXT         S+6*,S+7

Global Variables  ( * Changed  ! Killed)
   ^TMP("OCXRULE"      S+7*

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   $T(DATA+LINE S+6

Label References
   NONE

External References
   ^ORY42703           S+9
   DOT^ORY427ES        S+2

*****   END   *****
ORY42703   8061     printed  Jun 28, 2016@13:15:59                     Page 10

ORY42703  ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Instal
l of OR*3*427) ;MAY 10,2016 at 13:31
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 +3       ;
S         ;
 +1       ;
 +2        DO DOT^ORY427ES
 +3       ;
 +4       ;
 +5        KILL REMOTE,LOCAL,OPCODE,REF
 +6        FOR LINE=1:1:500
               SET TEXT=$PIECE($TEXT(DATA+LINE),";",2,999)
               IF TEXT
                   QUIT 
               IF $LENGTH(TEXT)
                   Begin DoDot:1
 +7                    SET ^TMP("OCXRULE",$JOB,$ORDER(^TMP("OCXRULE",$JOB,"A"),-
1)+1)=TEXT
                   End DoDot:1
                   IF QUIT
                       QUIT 
 +8       ;
 +9        GOTO ^ORY42704
 +10      ;
 +11       QUIT 
 +12      ;
DATA      ;
 +1       ;
 +2       ;;D^IS LESS THAN
 +3       ;;R^"863.9:","863.91:3",.01,"E"
 +4       ;;D^OCXO GENERATE CODE FUNCTION
 +5       ;;R^"863.9:","863.91:3",1,"E"
 +6       ;;D^GCC NUMERIC LESS THAN
 +7       ;;EOR^
 +8       ;;KEY^863.9:^LOGICAL FALSE
 +9       ;;R^"863.9:",.01,"E"
 +10      ;;D^LOGICAL FALSE
 +11      ;;R^"863.9:",.02,"E"
 +12      ;;D^BOOLEAN
 +13      ;;R^"863.9:",.03,"E"
 +14      ;;D^GCC BOOLEAN LOGICAL FALSE
 +15      ;;R^"863.9:",.04,"E"
 +16      ;;D^IS FALSE
 +17      ;;R^"863.9:","863.91:1",.01,"E"
 +18      ;;D^OCXO GENERATE CODE FUNCTION
 +19      ;;R^"863.9:","863.91:1",1,"E"
 +20      ;;D^GCC BOOLEAN LOGICAL FALSE
 +21      ;;R^"863.9:","863.92:1",.01,"E"
 +22      ;;D^FALSE
 +23      ;;EOR^
 +24      ;;KEY^863.9:^LOGICAL TRUE
 +25      ;;R^"863.9:",.01,"E"
 +26      ;;D^LOGICAL TRUE
 +27      ;;R^"863.9:",.02,"E"
 +28      ;;D^BOOLEAN
 +29      ;;R^"863.9:",.03,"E"
 +30      ;;D^GCC BOOLEAN LOGICAL TRUE
 +31      ;;R^"863.9:",.04,"E"
 +32      ;;D^IS TRUE
 +33      ;;R^"863.9:","863.91:1",.01,"E"
 +34      ;;D^OCXO GENERATE CODE FUNCTION
 +35      ;;R^"863.9:","863.91:1",1,"E"
 +36      ;;D^GCC BOOLEAN LOGICAL TRUE
 +37      ;;R^"863.9:","863.92:1",.01,"E"
 +38      ;;D^TRUE
 +39      ;;EOR^
 +40      ;;KEY^863.9:^STARTS WITH
 +41      ;;R^"863.9:",.01,"E"
 +42      ;;D^STARTS WITH
 +43      ;;R^"863.9:",.02,"E"
 +44      ;;D^FREE TEXT
 +45      ;;R^"863.9:",.04,"E"
 +46      ;;D^STARTS WITH
 +47      ;;R^"863.9:","863.91:3",.01,"E"
 +48      ;;D^OCXO GENERATE CODE FUNCTION
 +49      ;;R^"863.9:","863.91:3",1,"E"
 +50      ;;D^GCC FREE TEXT STARTS WITH
 +51      ;;R^"863.9:","863.92:1",.01,"E"
 +52      ;;D^BEGINS WITH
 +53      ;;EOR^
 +54      ;;EOF^OCXS(863.9)^1
 +55      ;;SOF^863.4  OCX MDD ATTRIBUTE
 +56      ;;KEY^863.4:^CLOZAPINE ANC W/IN 7 FLAG
 +57      ;;R^"863.4:",.01,"E"
 +58      ;;D^CLOZAPINE ANC W/IN 7 FLAG
 +59      ;;R^"863.4:","863.41:1",.01,"E"
 +60      ;;D^DATA TYPE
 +61      ;;R^"863.4:","863.41:1",1,"E"
 +62      ;;D^BOOLEAN
 +63      ;;EOR^
 +64      ;;KEY^863.4:^CLOZAPINE ANC W/IN 7 RESULT
 +65      ;;R^"863.4:",.01,"E"
 +66      ;;D^CLOZAPINE ANC W/IN 7 RESULT
 +67      ;;R^"863.4:","863.41:1",.01,"E"
 +68      ;;D^DATA TYPE
 +69      ;;R^"863.4:","863.41:1",1,"E"
 +70      ;;D^NUMERIC
 +71      ;;EOR^
 +72      ;;KEY^863.4:^CLOZAPINE LAB RESULTS
 +73      ;;R^"863.4:",.01,"E"
 +74      ;;D^CLOZAPINE LAB RESULTS
 +75      ;;R^"863.4:","863.41:1",.01,"E"
 +76      ;;D^DATA TYPE
 +77      ;;R^"863.4:","863.41:1",1,"E"
 +78      ;;D^FREE TEXT
 +79      ;;EOR^
 +80      ;;KEY^863.4:^CLOZAPINE MED
 +81      ;;R^"863.4:",.01,"E"
 +82      ;;D^CLOZAPINE MED
 +83      ;;R^"863.4:","863.41:1",.01,"E"
 +84      ;;D^DATA TYPE
 +85      ;;R^"863.4:","863.41:1",1,"E"
 +86      ;;D^BOOLEAN
 +87      ;;EOR^
 +88      ;;KEY^863.4:^DISPENSE DRUG
 +89      ;;R^"863.4:",.01,"E"
 +90      ;;D^DISPENSE DRUG
 +91      ;;R^"863.4:","863.41:1",.01,"E"
 +92      ;;D^DATA TYPE
 +93      ;;R^"863.4:","863.41:1",1,"E"
 +94      ;;D^FREE TEXT
 +95      ;;EOR^
 +96      ;;KEY^863.4:^FILLER
 +97      ;;R^"863.4:",.01,"E"
 +98      ;;D^FILLER
 +99      ;;R^"863.4:","863.41:1",.01,"E"
 +100     ;;D^DATA TYPE
 +101     ;;R^"863.4:","863.41:1",1,"E"
 +102     ;;D^FREE TEXT
 +103     ;;EOR^
 +104     ;;KEY^863.4:^HL7 FILLER
 +105     ;;R^"863.4:",.01,"E"
 +106     ;;D^HL7 FILLER
 +107     ;;R^"863.4:",.02,"E"
 +108     ;;D^HL7FILLR
 +109     ;;R^"863.4:","863.41:1",.01,"E"
 +110     ;;D^DATA TYPE
 +111     ;;R^"863.4:","863.41:1",1,"E"
 +112     ;;D^FREE TEXT
 +113     ;;EOR^
 +114     ;;KEY^863.4:^IEN
 +115     ;;R^"863.4:",.01,"E"
 +116     ;;D^IEN
 +117     ;;R^"863.4:","863.41:1",.01,"E"
 +118     ;;D^DATA TYPE
 +119     ;;R^"863.4:","863.41:1",1,"E"
 +120     ;;D^NUMERIC
 +121     ;;EOR^
 +122     ;;KEY^863.4:^ORDER MODE
 +123     ;;R^"863.4:",.01,"E"
 +124     ;;D^ORDER MODE
 +125     ;;R^"863.4:","863.41:1",.01,"E"
 +126     ;;D^DATA TYPE
 +127     ;;R^"863.4:","863.41:1",1,"E"
 +128     ;;D^FREE TEXT
 +129     ;;EOR^
 +130     ;;KEY^863.4:^ORDER PATIENT
 +131     ;;R^"863.4:",.01,"E"
 +132     ;;D^ORDER PATIENT
 +133     ;;R^"863.4:","863.41:1",.01,"E"
 +134     ;;D^DATA TYPE
 +135     ;;R^"863.4:","863.41:1",1,"E"
 +136     ;;D^NUMERIC
 +137     ;;EOR^
 +138     ;;EOF^OCXS(863.4)^1
 +139     ;;SOF^863.2  OCX MDD SUBJECT
 +140     ;;KEY^863.2:^PATIENT
 +141     ;;R^"863.2:",.01,"E"
 +142     ;;D^PATIENT
 +143     ;;R^"863.2:","863.21:1",.01,"E"
 +144     ;;D^FILE
 +145     ;;R^"863.2:","863.21:1",1,"E"
 +146     ;;D^2
 +147     ;;EOR^
 +148     ;;EOF^OCXS(863.2)^1
 +149     ;;SOF^863.3  OCX MDD LINK
 +150     ;;KEY^863.3:^PATIENT.CLOZAPINE MED
 +151     ;;R^"863.3:",.01,"E"
 +152     ;;D^PATIENT.CLOZAPINE MED
 +153     ;;R^"863.3:",.02,"E"
 +154     ;;D^PATIENT
 +155     ;;R^"863.3:",.05,"E"
 +156     ;;D^CLOZAPINE MED
 +157     ;;R^"863.3:",.06,"E"
 +158     ;;D^3555
 +159     ;;R^"863.3:","863.32:1",.01,"E"
 +160     ;;D^OCXO EXTERNAL FUNCTION CALL
 +161     ;;R^"863.3:","863.32:1",1,"E"
 +162     ;;D^CLOZLABS^ORKLR(|PATIENT IEN|,7,|DISP DRUG IEN|)
 +163     ;;R^"863.3:","863.32:2",.01,"E"
 +164     ;;D^OCXO UP-ARROW PIECE NUMBER
 +165     ;;R^"863.3:","863.32:2",1,"E"
 +166     ;;D^1
 +167     ;;EOR^
 +168     ;;KEY^863.3:^PATIENT.CLOZ_ANC_W/IN_7_FLAG
 +169     ;;R^"863.3:",.01,"E"
 +170     ;;D^PATIENT.CLOZ_ANC_W/IN_7_FLAG
 +171     ;;R^"863.3:",.02,"E"
 +172     ;;D^PATIENT
 +173     ;;R^"863.3:",.05,"E"
 +174     ;;D^CLOZAPINE ANC W/IN 7 FLAG
 +175     ;;R^"863.3:","863.32:1",.01,"E"
 +176     ;;D^OCXO EXTERNAL FUNCTION CALL
 +177     ;;R^"863.3:","863.32:1",1,"E"
 +178     ;;D^CLOZLABS^ORKLR(|PATIENT IEN|,7,|DISP DRUG IEN|)
 +179     ;;R^"863.3:","863.32:2",.01,"E"
 +180     ;;D^OCXO UP-ARROW PIECE NUMBER
 +181     ;;R^"863.3:","863.32:2",1,"E"
 +182     ;;D^3
 +183     ;;R^"863.3:","863.32:3",.01,"E"
 +184     ;;D^OCXO SEMI-COLON PIECE NUMBER
 +185     ;;R^"863.3:","863.32:3",1,"E"
 +186     ;;D^1
 +187     ;;EOR^
 +188     ;;KEY^863.3:^PATIENT.CLOZ_ANC_W/IN_7_RSLT
 +189     ;;R^"863.3:",.01,"E"
 +190     ;;D^PATIENT.CLOZ_ANC_W/IN_7_RSLT
 +191     ;;R^"863.3:",.02,"E"
 +192     ;;D^PATIENT
 +193     ;;R^"863.3:",.05,"E"
 +194     ;;D^CLOZAPINE ANC W/IN 7 RESULT
 +195     ;;R^"863.3:","863.32:1",.01,"E"
 +196     ;;D^OCXO EXTERNAL FUNCTION CALL
 +197     ;;R^"863.3:","863.32:1",1,"E"
 +198     ;;D^CLOZLABS^ORKLR(|PATIENT IEN|,7,|DISP DRUG IEN|)
 +199     ;;R^"863.3:","863.32:2",.01,"E"
 +200     ;;D^OCXO UP-ARROW PIECE NUMBER
 +201     ;;R^"863.3:","863.32:2",1,"E"
 +202     ;;D^3
 +203     ;;R^"863.3:","863.32:3",.01,"E"
 +204     ;;D^OCXO SEMI-COLON PIECE NUMBER
 +205     ;;R^"863.3:","863.32:3",1,"E"
 +206     ;;D^2
 +207     ;;EOR^
 +208     ;;KEY^863.3:^PATIENT.CLOZ_LAB_RESULTS
 +209     ;;R^"863.3:",.01,"E"
 +210     ;;D^PATIENT.CLOZ_LAB_RESULTS
 +211     ;;R^"863.3:",.02,"E"
 +212     ;;D^PATIENT
 +213     ;;R^"863.3:",.05,"E"
 +214     ;;D^CLOZAPINE LAB RESULTS
 +215     ;;R^"863.3:","863.32:1",.01,"E"
 +216     ;;D^OCXO EXTERNAL FUNCTION CALL
 +217     ;;R^"863.3:","863.32:1",1,"E"
 +218     ;;D^CLOZLABS^ORKLR(|PATIENT IEN|,"",|DISP DRUG IEN|)
 +219     ;;R^"863.3:","863.32:2",.01,"E"
 +220     ;;D^OCXO UP-ARROW PIECE NUMBER
 +221     ;;R^"863.3:","863.32:2",1,"E"
 +222     ;;D^4
 +223     ;;EOR^
 +224     ;;KEY^863.3:^PATIENT.HL7_FILLER
 +225     ;;R^"863.3:",.01,"E"
 +226     ;;D^PATIENT.HL7_FILLER
 +227     ;;R^"863.3:",.02,"E"
 +228     ;;D^PATIENT
 +229     ;;R^"863.3:",.04,"E"
 +230     ;;D^HL7
 +231     ;;R^"863.3:",.05,"E"
 +232     ;;D^HL7 FILLER
 +233     ;;R^"863.3:","863.32:1",.01,"E"
 +234     ;;D^OCXO VT-BAR PIECE NUMBER
 +235     ;;R^"863.3:","863.32:2",.01,"E"
 +236     ;;D^OCXO UP-ARROW PIECE NUMBER
 +237     ;;R^"863.3:","863.32:2",1,"E"
 +238     ;;D^2
 +239     ;;R^"863.3:","863.32:3",.01,"E"
 +240     ;;D^OCXO VARIABLE NAME
 +241     ;;R^"863.3:","863.32:3",1,"E"
 +242     ;;D^OCXODATA("ORC",3)
 +243     ;;R^"863.3:","863.32:4",.01,"E"
 +244     ;;D^OCXO HL7 SEGMENT ID
 +245     ;;R^"863.3:","863.32:5",.01,"E"
 +246     ;;D^OCXO DATA DRIVE SOURCE
 +247     ;;R^"863.3:","863.32:5",1,"E"
 +248     ;;D^HL7
 +249     ;;R^"863.3:","863.32:6",.01,"E"
 +250     ;;D^OCXO FILE POINTER
 +251     ;;EOR^
 +252     ;;KEY^863.3:^PATIENT.HL7_PATIENT_ID
 +253     ;;R^"863.3:",.01,"E"
 +254     ;;D^PATIENT.HL7_PATIENT_ID
 +255     ;;R^"863.3:",.02,"E"
 +256     ;;D^PATIENT
 +257     ;;R^"863.3:",.04,"E"
 +258     ;;D^HL7
 +259     ;;R^"863.3:",.05,"E"
 +260     ;;D^IEN
 +261     ;;R^"863.3:",.06,"E"
 +262     ;;D^99
 +263     ;;R^"863.3:","863.32:1",.01,"E"
 +264     ;;D^OCXO HL7 SEGMENT ID
 +265     ;;R^"863.3:","863.32:2",.01,"E"
 +266     ;;D^OCXO VT-BAR PIECE NUMBER
 +267     ;;R^"863.3:","863.32:3",.01,"E"
 +268     ;;D^OCXO VARIABLE NAME
 +269     ;;R^"863.3:","863.32:3",1,"E"
 +270     ;;D^OCXODATA("PID",3)
 +271     ;;EOR^
 +272     ;;KEY^863.3:^PATIENT.IEN
 +273     ;;R^"863.3:",.01,"E"
 +274     ;;D^PATIENT.IEN
 +275     ;;R^"863.3:",.02,"E"
 +276     ;;D^PATIENT
 +277     ;;R^"863.3:",.05,"E"
 +278     ;;D^IEN
 +279     ;;R^"863.3:",.06,"E"
 +280     ;;D^99
 +281     ;;R^"863.3:","863.32:1",.01,"E"
 +282     ;;D^OCXO VARIABLE NAME
 +283     ;;R^"863.3:","863.32:1",1,"E"
 +284     ;;D^DFN
 +285     ;;EOR^
 +286     ;;KEY^863.3:^PATIENT.OERR_ORDER_PATIENT
 +287     ;;R^"863.3:",.01,"E"
 +288     ;;D^PATIENT.OERR_ORDER_PATIENT
 +289     ;;R^"863.3:",.02,"E"
 +290     ;;D^PATIENT
 +291     ;;R^"863.3:",.05,"E"
 +292     ;;D^ORDER PATIENT
 +293     ;;R^"863.3:",.06,"E"
 +294     ;;D^5567
 +295     ;;R^"863.3:","863.32:1",.01,"E"
 +296     ;;D^OCXO VARIABLE NAME
 +297     ;;R^"863.3:","863.32:1",1,"E"
 +298     ;;D^OCXORD
 +299     ;;R^"863.3:","863.32:2",.01,"E"
 +300     ;;D^OCXO UP-ARROW PIECE NUMBER
 +301     ;;R^"863.3:","863.32:2",1,"E"
 +302     ;;D^1
 +303     ;;EOR^
 +304     ;;KEY^863.3:^PATIENT.OPS_DRUG_ID
 +305     ;;R^"863.3:",.01,"E"
 +306     ;;D^PATIENT.OPS_DRUG_ID
 +307     ;;R^"863.3:",.02,"E"
 +308     ;;D^PATIENT
 +309     ;;R^"863.3:",.05,"E"
 +310     ;;D^DISPENSE DRUG
 +311     ;1;
 +312     ;


ORY42703 * *  330 Lines,  8061 Bytes, Checksum: B78683867
                                                  Jun 28, 2016@13:15:59 page 11
              120 bytes in comments
ORY42703 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install
           of OR*3*427) ;MAY 10,2016 at 13:31
         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
         ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
         ;
S        ;
         ;
         D DOT^ORY427ES
         ;
         ;
         K REMOTE,LOCAL,OPCODE,REF
         F LINE=1:1:500 S TEXT=$P($T(DATA+LINE),";",2,999) Q:TEXT  I $L(TEXT) D 
           Q:QUIT
         .S ^TMP("OCXRULE",$J,$O(^TMP("OCXRULE",$J,"A"),-1)+1)=TEXT
         ;
         G ^ORY42704
         ;
         Q
         ;
DATA     ;
         ;
         ;;D^IS LESS THAN
         ;;R^"863.9:","863.91:3",.01,"E"
         ;;D^OCXO GENERATE CODE FUNCTION
         ;;R^"863.9:","863.91:3",1,"E"
         ;;D^GCC NUMERIC LESS THAN
         ;;EOR^
         ;;KEY^863.9:^LOGICAL FALSE
         ;;R^"863.9:",.01,"E"
         ;;D^LOGICAL FALSE
         ;;R^"863.9:",.02,"E"
         ;;D^BOOLEAN
         ;;R^"863.9:",.03,"E"
         ;;D^GCC BOOLEAN LOGICAL FALSE
         ;;R^"863.9:",.04,"E"
         ;;D^IS FALSE
         ;;R^"863.9:","863.91:1",.01,"E"
         ;;D^OCXO GENERATE CODE FUNCTION
         ;;R^"863.9:","863.91:1",1,"E"
         ;;D^GCC BOOLEAN LOGICAL FALSE
         ;;R^"863.9:","863.92:1",.01,"E"
         ;;D^FALSE
         ;;EOR^
         ;;KEY^863.9:^LOGICAL TRUE
         ;;R^"863.9:",.01,"E"
         ;;D^LOGICAL TRUE
         ;;R^"863.9:",.02,"E"
         ;;D^BOOLEAN
         ;;R^"863.9:",.03,"E"
         ;;D^GCC BOOLEAN LOGICAL TRUE
         ;;R^"863.9:",.04,"E"
         ;;D^IS TRUE
         ;;R^"863.9:","863.91:1",.01,"E"
         ;;D^OCXO GENERATE CODE FUNCTION
         ;;R^"863.9:","863.91:1",1,"E"
         ;;D^GCC BOOLEAN LOGICAL TRUE
         ;;R^"863.9:","863.92:1",.01,"E"
         ;;D^TRUE
         ;;EOR^
         ;;KEY^863.9:^STARTS WITH
         ;;R^"863.9:",.01,"E"
         ;;D^STARTS WITH
         ;;R^"863.9:",.02,"E"
         ;;D^FREE TEXT
         ;;R^"863.9:",.04,"E"
         ;;D^STARTS WITH
         ;;R^"863.9:","863.91:3",.01,"E"
         ;;D^OCXO GENERATE CODE FUNCTION
         ;;R^"863.9:","863.91:3",1,"E"
         ;;D^GCC FREE TEXT STARTS WITH
         ;;R^"863.9:","863.92:1",.01,"E"
         ;;D^BEGINS WITH
         ;;EOR^
         ;;EOF^OCXS(863.9)^1
         ;;SOF^863.4  OCX MDD ATTRIBUTE
         ;;KEY^863.4:^CLOZAPINE ANC W/IN 7 FLAG
         ;;R^"863.4:",.01,"E"
         ;;D^CLOZAPINE ANC W/IN 7 FLAG
         ;;R^"863.4:","863.41:1",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.4:","863.41:1",1,"E"
         ;;D^BOOLEAN
         ;;EOR^
         ;;KEY^863.4:^CLOZAPINE ANC W/IN 7 RESULT
         ;;R^"863.4:",.01,"E"
         ;;D^CLOZAPINE ANC W/IN 7 RESULT
         ;;R^"863.4:","863.41:1",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.4:","863.41:1",1,"E"
         ;;D^NUMERIC
         ;;EOR^
         ;;KEY^863.4:^CLOZAPINE LAB RESULTS
         ;;R^"863.4:",.01,"E"
         ;;D^CLOZAPINE LAB RESULTS
         ;;R^"863.4:","863.41:1",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.4:","863.41:1",1,"E"
         ;;D^FREE TEXT
         ;;EOR^
         ;;KEY^863.4:^CLOZAPINE MED
         ;;R^"863.4:",.01,"E"
         ;;D^CLOZAPINE MED
         ;;R^"863.4:","863.41:1",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.4:","863.41:1",1,"E"
         ;;D^BOOLEAN
         ;;EOR^
         ;;KEY^863.4:^DISPENSE DRUG
         ;;R^"863.4:",.01,"E"
         ;;D^DISPENSE DRUG
         ;;R^"863.4:","863.41:1",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.4:","863.41:1",1,"E"
         ;;D^FREE TEXT
         ;;EOR^
         ;;KEY^863.4:^FILLER
         ;;R^"863.4:",.01,"E"
         ;;D^FILLER
         ;;R^"863.4:","863.41:1",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.4:","863.41:1",1,"E"
         ;;D^FREE TEXT
         ;;EOR^
         ;;KEY^863.4:^HL7 FILLER
         ;;R^"863.4:",.01,"E"
         ;;D^HL7 FILLER
         ;;R^"863.4:",.02,"E"
         ;;D^HL7FILLR
         ;;R^"863.4:","863.41:1",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.4:","863.41:1",1,"E"
         ;;D^FREE TEXT
         ;;EOR^
         ;;KEY^863.4:^IEN
         ;;R^"863.4:",.01,"E"
         ;;D^IEN
         ;;R^"863.4:","863.41:1",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.4:","863.41:1",1,"E"
         ;;D^NUMERIC
         ;;EOR^
         ;;KEY^863.4:^ORDER MODE
         ;;R^"863.4:",.01,"E"
         ;;D^ORDER MODE
         ;;R^"863.4:","863.41:1",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.4:","863.41:1",1,"E"
         ;;D^FREE TEXT
         ;;EOR^
         ;;KEY^863.4:^ORDER PATIENT
         ;;R^"863.4:",.01,"E"
         ;;D^ORDER PATIENT
         ;;R^"863.4:","863.41:1",.01,"E"
         ;;D^DATA TYPE
         ;;R^"863.4:","863.41:1",1,"E"
         ;;D^NUMERIC
         ;;EOR^
         ;;EOF^OCXS(863.4)^1
         ;;SOF^863.2  OCX MDD SUBJECT
         ;;KEY^863.2:^PATIENT
         ;;R^"863.2:",.01,"E"
         ;;D^PATIENT
         ;;R^"863.2:","863.21:1",.01,"E"
         ;;D^FILE
         ;;R^"863.2:","863.21:1",1,"E"
         ;;D^2
         ;;EOR^
         ;;EOF^OCXS(863.2)^1
         ;;SOF^863.3  OCX MDD LINK
         ;;KEY^863.3:^PATIENT.CLOZAPINE MED
         ;;R^"863.3:",.01,"E"
         ;;D^PATIENT.CLOZAPINE MED
         ;;R^"863.3:",.02,"E"
         ;;D^PATIENT
         ;;R^"863.3:",.05,"E"
         ;;D^CLOZAPINE MED
         ;;R^"863.3:",.06,"E"
         ;;D^3555
         ;;R^"863.3:","863.32:1",.01,"E"
         ;;D^OCXO EXTERNAL FUNCTION CALL
         ;;R^"863.3:","863.32:1",1,"E"
         ;;D^CLOZLABS^ORKLR(|PATIENT IEN|,7,|DISP DRUG IEN|)
         ;;R^"863.3:","863.32:2",.01,"E"
         ;;D^OCXO UP-ARROW PIECE NUMBER
         ;;R^"863.3:","863.32:2",1,"E"
         ;;D^1
         ;;EOR^
         ;;KEY^863.3:^PATIENT.CLOZ_ANC_W/IN_7_FLAG
         ;;R^"863.3:",.01,"E"
         ;;D^PATIENT.CLOZ_ANC_W/IN_7_FLAG
         ;;R^"863.3:",.02,"E"
         ;;D^PATIENT
         ;;R^"863.3:",.05,"E"
         ;;D^CLOZAPINE ANC W/IN 7 FLAG
         ;;R^"863.3:","863.32:1",.01,"E"
         ;;D^OCXO EXTERNAL FUNCTION CALL
         ;;R^"863.3:","863.32:1",1,"E"
         ;;D^CLOZLABS^ORKLR(|PATIENT IEN|,7,|DISP DRUG IEN|)
         ;;R^"863.3:","863.32:2",.01,"E"
         ;;D^OCXO UP-ARROW PIECE NUMBER
         ;;R^"863.3:","863.32:2",1,"E"
         ;;D^3
         ;;R^"863.3:","863.32:3",.01,"E"
         ;;D^OCXO SEMI-COLON PIECE NUMBER
         ;;R^"863.3:","863.32:3",1,"E"
         ;;D^1
         ;;EOR^
         ;;KEY^863.3:^PATIENT.CLOZ_ANC_W/IN_7_RSLT
         ;;R^"863.3:",.01,"E"
         ;;D^PATIENT.CLOZ_ANC_W/IN_7_RSLT
         ;;R^"863.3:",.02,"E"
         ;;D^PATIENT
         ;;R^"863.3:",.05,"E"
         ;;D^CLOZAPINE ANC W/IN 7 RESULT
         ;;R^"863.3:","863.32:1",.01,"E"
         ;;D^OCXO EXTERNAL FUNCTION CALL
         ;;R^"863.3:","863.32:1",1,"E"
         ;;D^CLOZLABS^ORKLR(|PATIENT IEN|,7,|DISP DRUG IEN|)
         ;;R^"863.3:","863.32:2",.01,"E"
         ;;D^OCXO UP-ARROW PIECE NUMBER
         ;;R^"863.3:","863.32:2",1,"E"
         ;;D^3
         ;;R^"863.3:","863.32:3",.01,"E"
         ;;D^OCXO SEMI-COLON PIECE NUMBER
         ;;R^"863.3:","863.32:3",1,"E"
         ;;D^2
         ;;EOR^
         ;;KEY^863.3:^PATIENT.CLOZ_LAB_RESULTS
         ;;R^"863.3:",.01,"E"
         ;;D^PATIENT.CLOZ_LAB_RESULTS
         ;;R^"863.3:",.02,"E"
         ;;D^PATIENT
         ;;R^"863.3:",.05,"E"
         ;;D^CLOZAPINE LAB RESULTS
         ;;R^"863.3:","863.32:1",.01,"E"
         ;;D^OCXO EXTERNAL FUNCTION CALL
         ;;R^"863.3:","863.32:1",1,"E"
         ;;D^CLOZLABS^ORKLR(|PATIENT IEN|,"",|DISP DRUG IEN|)
         ;;R^"863.3:","863.32:2",.01,"E"
         ;;D^OCXO UP-ARROW PIECE NUMBER
         ;;R^"863.3:","863.32:2",1,"E"
         ;;D^4
         ;;EOR^
         ;;KEY^863.3:^PATIENT.HL7_FILLER
         ;;R^"863.3:",.01,"E"
         ;;D^PATIENT.HL7_FILLER
         ;;R^"863.3:",.02,"E"
         ;;D^PATIENT
         ;;R^"863.3:",.04,"E"
         ;;D^HL7
         ;;R^"863.3:",.05,"E"
         ;;D^HL7 FILLER
         ;;R^"863.3:","863.32:1",.01,"E"
         ;;D^OCXO VT-BAR PIECE NUMBER
         ;;R^"863.3:","863.32:2",.01,"E"
         ;;D^OCXO UP-ARROW PIECE NUMBER
         ;;R^"863.3:","863.32:2",1,"E"
         ;;D^2
         ;;R^"863.3:","863.32:3",.01,"E"
         ;;D^OCXO VARIABLE NAME
         ;;R^"863.3:","863.32:3",1,"E"
         ;;D^OCXODATA("ORC",3)
         ;;R^"863.3:","863.32:4",.01,"E"
         ;;D^OCXO HL7 SEGMENT ID
         ;;R^"863.3:","863.32:5",.01,"E"
         ;;D^OCXO DATA DRIVE SOURCE
         ;;R^"863.3:","863.32:5",1,"E"
         ;;D^HL7
         ;;R^"863.3:","863.32:6",.01,"E"
         ;;D^OCXO FILE POINTER
         ;;EOR^
         ;;KEY^863.3:^PATIENT.HL7_PATIENT_ID
         ;;R^"863.3:",.01,"E"
         ;;D^PATIENT.HL7_PATIENT_ID
         ;;R^"863.3:",.02,"E"
         ;;D^PATIENT
         ;;R^"863.3:",.04,"E"
         ;;D^HL7
         ;;R^"863.3:",.05,"E"
         ;;D^IEN
         ;;R^"863.3:",.06,"E"
         ;;D^99
         ;;R^"863.3:","863.32:1",.01,"E"
         ;;D^OCXO HL7 SEGMENT ID
         ;;R^"863.3:","863.32:2",.01,"E"
         ;;D^OCXO VT-BAR PIECE NUMBER
         ;;R^"863.3:","863.32:3",.01,"E"
         ;;D^OCXO VARIABLE NAME
         ;;R^"863.3:","863.32:3",1,"E"
         ;;D^OCXODATA("PID",3)
         ;;EOR^
         ;;KEY^863.3:^PATIENT.IEN
         ;;R^"863.3:",.01,"E"
         ;;D^PATIENT.IEN
         ;;R^"863.3:",.02,"E"
         ;;D^PATIENT
         ;;R^"863.3:",.05,"E"
         ;;D^IEN
         ;;R^"863.3:",.06,"E"
         ;;D^99
         ;;R^"863.3:","863.32:1",.01,"E"
         ;;D^OCXO VARIABLE NAME
         ;;R^"863.3:","863.32:1",1,"E"
         ;;D^DFN
         ;;EOR^
         ;;KEY^863.3:^PATIENT.OERR_ORDER_PATIENT
         ;;R^"863.3:",.01,"E"
         ;;D^PATIENT.OERR_ORDER_PATIENT
         ;;R^"863.3:",.02,"E"
         ;;D^PATIENT
         ;;R^"863.3:",.05,"E"
         ;;D^ORDER PATIENT
         ;;R^"863.3:",.06,"E"
         ;;D^5567
         ;;R^"863.3:","863.32:1",.01,"E"
         ;;D^OCXO VARIABLE NAME
         ;;R^"863.3:","863.32:1",1,"E"
         ;;D^OCXORD
         ;;R^"863.3:","863.32:2",.01,"E"
         ;;D^OCXO UP-ARROW PIECE NUMBER
         ;;R^"863.3:","863.32:2",1,"E"
         ;;D^1
         ;;EOR^
         ;;KEY^863.3:^PATIENT.OPS_DRUG_ID
         ;;R^"863.3:",.01,"E"
         ;;D^PATIENT.OPS_DRUG_ID
         ;;R^"863.3:",.02,"E"
         ;;D^PATIENT
         ;;R^"863.3:",.05,"E"
         ;;D^DISPENSE DRUG
         ;1;
         ;

*****   INDEX OF ORY42703   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
>> LINE         S+6*
   LOCAL        S+5!
   OPCODE       S+5!
>> QUIT         S+6
   REF          S+5!
   REMOTE       S+5!
>> TEXT         S+6*,S+7

Global Variables  ( * Changed  ! Killed)
   ^TMP("OCXRULE"      S+7*

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   $T(DATA+LINE S+6

Label References
   NONE

External References
   ^ORY42704           S+9
   DOT^ORY427ES        S+2

*****   END   *****
ORY42704   7775     printed  Jun 28, 2016@13:15:59                     Page 12

ORY42704  ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Instal
l of OR*3*427) ;MAY 10,2016 at 13:31
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 +3       ;
S         ;
 +1       ;
 +2        DO DOT^ORY427ES
 +3       ;
 +4       ;
 +5        KILL REMOTE,LOCAL,OPCODE,REF
 +6        FOR LINE=1:1:500
               SET TEXT=$PIECE($TEXT(DATA+LINE),";",2,999)
               IF TEXT
                   QUIT 
               IF $LENGTH(TEXT)
                   Begin DoDot:1
 +7                    SET ^TMP("OCXRULE",$JOB,$ORDER(^TMP("OCXRULE",$JOB,"A"),-
1)+1)=TEXT
                   End DoDot:1
                   IF QUIT
                       QUIT 
 +8       ;
 +9        GOTO ^ORY42705
 +10      ;
 +11       QUIT 
 +12      ;
DATA      ;
 +1       ;
 +2       ;;R^"863.3:",.06,"E"
 +3       ;;D^33
 +4       ;;R^"863.3:","863.32:1",.01,"E"
 +5       ;;D^OCXO VARIABLE NAME
 +6       ;;R^"863.3:","863.32:1",1,"E"
 +7       ;;D^OCXPSD
 +8       ;;R^"863.3:","863.32:2",.01,"E"
 +9       ;;D^OCXO VT-BAR PIECE NUMBER
 +10      ;;R^"863.3:","863.32:2",1,"E"
 +11      ;;D^2
 +12      ;;R^"863.3:","863.32:3",.01,"E"
 +13      ;;D^OCXO UP-ARROW PIECE NUMBER
 +14      ;;R^"863.3:","863.32:3",1,"E"
 +15      ;;D^4
 +16      ;;EOR^
 +17      ;;KEY^863.3:^PATIENT.OPS_FILLER
 +18      ;;R^"863.3:",.01,"E"
 +19      ;;D^PATIENT.OPS_FILLER
 +20      ;;R^"863.3:",.02,"E"
 +21      ;;D^PATIENT
 +22      ;;R^"863.3:",.04,"E"
 +23      ;;D^OPS
 +24      ;;R^"863.3:",.05,"E"
 +25      ;;D^FILLER
 +26      ;;R^"863.3:",.06,"E"
 +27      ;;D^99
 +28      ;;R^"863.3:","863.32:1",.01,"E"
 +29      ;;D^OCXO VARIABLE NAME
 +30      ;;R^"863.3:","863.32:1",1,"E"
 +31      ;;D^OCXPSD
 +32      ;;R^"863.3:","863.32:2",.01,"E"
 +33      ;;D^OCXO VT-BAR PIECE NUMBER
 +34      ;;R^"863.3:","863.32:2",1,"E"
 +35      ;;D^1
 +36      ;;EOR^
 +37      ;;KEY^863.3:^PATIENT.OPS_ORD_MODE
 +38      ;;R^"863.3:",.01,"E"
 +39      ;;D^PATIENT.OPS_ORD_MODE
 +40      ;;R^"863.3:",.02,"E"
 +41      ;;D^PATIENT
 +42      ;;R^"863.3:",.04,"E"
 +43      ;;D^OPS
 +44      ;;R^"863.3:",.05,"E"
 +45      ;;D^ORDER MODE
 +46      ;;R^"863.3:",.06,"E"
 +47      ;;D^99
 +48      ;;R^"863.3:","863.32:1",.01,"E"
 +49      ;;D^OCXO VARIABLE NAME
 +50      ;;R^"863.3:","863.32:1",1,"E"
 +51      ;;D^OCXPSM
 +52      ;;EOR^
 +53      ;;EOF^OCXS(863.3)^1
 +54      ;;SOF^860.9  ORDER CHECK NATIONAL TERM
 +55      ;;KEY^860.9:^ANGIOGRAM (PERIPHERAL)
 +56      ;;R^"860.9:",.01,"E"
 +57      ;;D^ANGIOGRAM (PERIPHERAL)
 +58      ;;R^"860.9:",.02,"E"
 +59      ;;D^101.43
 +60      ;;EOR^
 +61      ;;KEY^860.9:^BLOOD SPECIMEN
 +62      ;;R^"860.9:",.01,"E"
 +63      ;;D^BLOOD SPECIMEN
 +64      ;;R^"860.9:",.02,"E"
 +65      ;;D^61
 +66      ;;EOR^
 +67      ;;KEY^860.9:^DANGEROUS MEDS FOR PTS > 64
 +68      ;;R^"860.9:",.01,"E"
 +69      ;;D^DANGEROUS MEDS FOR PTS > 64
 +70      ;;R^"860.9:",.02,"E"
 +71      ;;D^101.43
 +72      ;;R^"860.9:",2,"E"
 +73      ;;D^I $P($G(^ORD(100.98,$P($G(^ORD(101.43,+Y,0)),U,5),0)),U)="PHARMACY
"
 +74      ;;EOR^
 +75      ;;KEY^860.9:^DNR
 +76      ;;R^"860.9:",.01,"E"
 +77      ;;D^DNR
 +78      ;;R^"860.9:",.02,"E"
 +79      ;;D^101.43
 +80      ;;EOR^
 +81      ;;KEY^860.9:^EGFR
 +82      ;;R^"860.9:",.01,"E"
 +83      ;;D^EGFR
 +84      ;;R^"860.9:",.02,"E"
 +85      ;;D^60
 +86      ;;EOR^
 +87      ;;KEY^860.9:^FOOD-DRUG INTERACTION MED
 +88      ;;R^"860.9:",.01,"E"
 +89      ;;D^FOOD-DRUG INTERACTION MED
 +90      ;;R^"860.9:",.02,"E"
 +91      ;;D^101.43
 +92      ;;R^"860.9:",2,"E"
 +93      ;;D^I $P($G(^ORD(100.98,$P($G(^ORD(101.43,+Y,0)),U,5),0)),U)="PHARMACY
"
 +94      ;;EOR^
 +95      ;;KEY^860.9:^NPO
 +96      ;;R^"860.9:",.01,"E"
 +97      ;;D^NPO
 +98      ;;R^"860.9:",.02,"E"
 +99      ;;D^101.43
 +100     ;;EOR^
 +101     ;;KEY^860.9:^ONE TIME MED
 +102     ;;R^"860.9:",.01,"E"
 +103     ;;D^ONE TIME MED
 +104     ;;R^"860.9:",.02,"E"
 +105     ;;D^51.1
 +106     ;;R^"860.9:",2,"E"
 +107     ;;D^I $E($P(^(0),U,4),1,2)="PS"
 +108     ;;EOR^
 +109     ;;KEY^860.9:^PARTIAL THROMBOPLASTIN TIME
 +110     ;;R^"860.9:",.01,"E"
 +111     ;;D^PARTIAL THROMBOPLASTIN TIME
 +112     ;;R^"860.9:",.02,"E"
 +113     ;;D^101.43
 +114     ;;EOR^
 +115     ;;KEY^860.9:^PROTHROMBIN TIME
 +116     ;;R^"860.9:",.01,"E"
 +117     ;;D^PROTHROMBIN TIME
 +118     ;;R^"860.9:",.02,"E"
 +119     ;;D^101.43
 +120     ;;EOR^
 +121     ;;KEY^860.9:^SERUM CREATININE
 +122     ;;R^"860.9:",.01,"E"
 +123     ;;D^SERUM CREATININE
 +124     ;;R^"860.9:",.02,"E"
 +125     ;;D^60
 +126     ;;EOR^
 +127     ;;KEY^860.9:^SERUM SPECIMEN
 +128     ;;R^"860.9:",.01,"E"
 +129     ;;D^SERUM SPECIMEN
 +130     ;;R^"860.9:",.02,"E"
 +131     ;;D^61
 +132     ;;EOR^
 +133     ;;KEY^860.9:^SERUM UREA NITROGEN
 +134     ;;R^"860.9:",.01,"E"
 +135     ;;D^SERUM UREA NITROGEN
 +136     ;;R^"860.9:",.02,"E"
 +137     ;;D^60
 +138     ;;EOR^
 +139     ;;KEY^860.9:^THROMBOPLASTIN TIME PARTIAL
 +140     ;;R^"860.9:",.01,"E"
 +141     ;;D^THROMBOPLASTIN TIME PARTIAL
 +142     ;;R^"860.9:",.02,"E"
 +143     ;;D^60
 +144     ;;EOR^
 +145     ;;KEY^860.9:^WBC
 +146     ;;R^"860.9:",.01,"E"
 +147     ;;D^WBC
 +148     ;;R^"860.9:",.02,"E"
 +149     ;;D^60
 +150     ;;EOR^
 +151     ;;EOF^OCXS(860.9)^1
 +152     ;;SOF^860.8  ORDER CHECK COMPILER FUNCTIONS
 +153     ;;KEY^860.8:^CONVERT DATE FROM FILEMAN FORMAT TO OCX FORMAT
 +154     ;;R^"860.8:",.01,"E"
 +155     ;;D^CONVERT DATE FROM FILEMAN FORMAT TO OCX FORMAT
 +156     ;;R^"860.8:",.02,"E"
 +157     ;;D^DT2INT
 +158     ;;R^"860.8:",1,1
 +159     ;;D^  ;DT2INT(OCXDT) ;      This Local Extrinsic Function converts a d
ate into an integer
 +160     ;;R^"860.8:",1,2
 +161     ;;D^  ; ; By taking the Years, Months, Days, Hours and Minutes convert
ing
 +162     ;;R^"860.8:",1,3
 +163     ;;D^  ; ; Them into Seconds and then adding them all together into one
 big integer
 +164     ;;R^"860.8:",100,1
 +165     ;;D^  ;DT2INT(OCXDT) ;      This Local Extrinsic Function converts a d
ate into an integer
 +166     ;;R^"860.8:",100,2
 +167     ;;D^  ; ; By taking the Years, Months, Days, Hours and Minutes convert
ing
 +168     ;;R^"860.8:",100,3
 +169     ;;D^  ; ; Them into Seconds and then adding them all together into one
 big integer
 +170     ;;R^"860.8:",100,4
 +171     ;;D^  ; ;
 +172     ;;R^"860.8:",100,5
 +173     ;;D^  ; Q:'$L($G(OCXDT)) ""
 +174     ;;R^"860.8:",100,6
 +175     ;;D^  ; N OCXDIFF,OCXVAL S (OCXDIFF,OCXVAL)=0
 +176     ;;R^"860.8:",100,7
 +177     ;;D^  ; ;
 +178     ;;R^"860.8:",100,8
 +179     ;;D^  ; I $L(OCXDT),'OCXDT,(OCXDT[" at ") D  ; EXTERNAL EXPERT SYSTEM 
FORMAT 1 TO EXTERNAL FORMAT
 +180     ;;R^"860.8:",100,9
 +181     ;;D^  ; .N OCXHR,OCXMIN,OCXTIME
 +182     ;;R^"860.8:",100,10
 +183     ;;D^  ; .S OCXTIME=$P($P(OCXDT," at ",2),".",1),OCXHR=$P(OCXTIME,":",1
),OCXMIN=$P(OCXTIME,":",2)
 +184     ;;R^"860.8:",100,11
 +185     ;;D^  ; .S:(OCXDT["Midnight") OCXHR=00
 +186     ;;R^"860.8:",100,12
 +187     ;;D^  ; .S:(OCXDT["PM") OCXHR=OCXHR+12
 +188     ;;R^"860.8:",100,13
 +189     ;;D^  ; .S OCXDT=$P(OCXDT," at ")_"@"_$E(OCXHR+100,2,3)_$E(OCXMIN+100,
2,3)
 +190     ;;R^"860.8:",100,14
 +191     ;;D^  ; ;
 +192     ;;R^"860.8:",100,15
 +193     ;;D^  ; I $L(OCXDT),(OCXDT?1.2N1"/"1.2N.1" ".2N.1":".2N) D  ; EXTERNAL
 EXPERT SYSTEM FORMAT 2 TO EXTERNAL FORMAT
 +194     ;;R^"860.8:",100,16
 +195     ;;D^  ; .N OCXMON
 +196     ;;R^"860.8:",100,17
 +197     ;;D^  ; .S OCXMON=$P("January^February^March^April^May^June^July^Augus
t^September^October^November^December",U,$P(OCXDT,"/",1))
 +198     ;;R^"860.8:",100,18
 +199     ;;D^  ; .I $L($P(OCXDT," ",2)) S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"
/",2)_"@"_$TR($P(OCXDT," ",2),":","")
 +200     ;;R^"860.8:",100,19
 +201     ;;D^  ; .E  S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)
 +202     ;;R^"860.8:",100,20
 +203     ;;D^  ; ;
 +204     ;;R^"860.8:",100,21
 +205     ;;D^  ; I $L(OCXDT),(OCXDT?1.2N1"/"1.2N1"/"1.2N.1" ".2N.1":".2N) D  ; 
EXTERNAL EXPERT SYSTEM FORMAT 3 TO EXTERNAL FORMAT
 +206     ;;R^"860.8:",100,22
 +207     ;;D^  ; .N OCXMON
 +208     ;;R^"860.8:",100,23
 +209     ;;D^  ; .S OCXMON=$P("January^February^March^April^May^June^July^Augus
t^September^October^November^December",U,$P(OCXDT,"/",1))
 +210     ;;R^"860.8:",100,24
 +211     ;;D^  ; .I $L($P(OCXDT," ",2)) S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"
/",2)_","_$P($P(OCXDT," ",1),"/",3)_"@"_$TR($P(OCXDT," ",2),":","")
 +212     ;;R^"860.8:",100,25
 +213     ;;D^  ; .E  S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)_", "_$P($P(OC
XDT," ",1),"/",3)
 +214     ;;R^"860.8:",100,26
 +215     ;;D^  ; ;
 +216     ;;R^"860.8:",100,27
 +217     ;;D^  ; I $L(OCXDT),'OCXDT D  ; EXTERNAL FORMAT TO INTERNAL FILEMAN FO
RMAT
 +218     ;;R^"860.8:",100,28
 +219     ;;D^  ; .I (OCXDT["@0000") S OCXDT=$P(OCXDT,"@",1),OCXDIFF=1
 +220     ;;R^"860.8:",100,29
 +221     ;;D^  ; .N %DT,X,Y S X=OCXDT,%DT="" S:(OCXDT["@")!(OCXDT="N") %DT="T" 
D ^%DT S OCXDT=+Y
 +222     ;;R^"860.8:",100,30
 +223     ;;D^  ; ;
 +224     ;;R^"860.8:",100,31
 +225     ;;D^  ; I ($L(OCXDT\1)>7) S OCXDT=$$HL7TFM^XLFDT(OCXDT)  ; HL7 FORMAT 
TO INTERNAL FILEMAN FORMAT
 +226     ;;R^"860.8:",100,32
 +227     ;;D^  ; ;
 +228     ;;R^"860.8:",100,33
 +229     ;;D^  ; I ($L(OCXDT\1)=7) S OCXDT=$$FMTH^XLFDT(+OCXDT)   ; INTERNAL FI
LEMAN FORMAT TO $H FORMAT
 +230     ;;R^"860.8:",100,34
 +231     ;;D^  ; ;
 +232     ;;R^"860.8:",100,35
 +233     ;;D^  ; I (OCXDT?5N1","1.5N) S OCXVAL=(OCXDT*86400)+$P(OCXDT,",",2)   
  ;  $H FORMAT TO EXPERT SYSTEM INTERNAL FORMAT
 +234     ;;R^"860.8:",100,36
 +235     ;;D^  ; ;
 +236     ;;R^"860.8:",100,37
 +237     ;;D^  ; Q OCXVAL
 +238     ;;R^"860.8:",100,38
 +239     ;;D^  ; ;
 +240     ;;EOR^
 +241     ;;KEY^860.8:^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
 +242     ;;R^"860.8:",.01,"E"
 +243     ;;D^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
 +244     ;;R^"860.8:",.02,"E"
 +245     ;;D^INT2DT
 +246     ;;R^"860.8:",1,1
 +247     ;;D^  ;INT2DT(OCXDT,OCXF) ;      This Local Extrinsic Function convert
s an OCX internal format
 +248     ;1;
 +249     ;


ORY42704 * *  267 Lines,  7775 Bytes, Checksum: B81471478
                                                  Jun 28, 2016@13:15:59 page 13
              120 bytes in comments
ORY42704 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install
           of OR*3*427) ;MAY 10,2016 at 13:31
         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
         ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
         ;
S        ;
         ;
         D DOT^ORY427ES
         ;
         ;
         K REMOTE,LOCAL,OPCODE,REF
         F LINE=1:1:500 S TEXT=$P($T(DATA+LINE),";",2,999) Q:TEXT  I $L(TEXT) D 
           Q:QUIT
         .S ^TMP("OCXRULE",$J,$O(^TMP("OCXRULE",$J,"A"),-1)+1)=TEXT
         ;
         G ^ORY42705
         ;
         Q
         ;
DATA     ;
         ;
         ;;R^"863.3:",.06,"E"
         ;;D^33
         ;;R^"863.3:","863.32:1",.01,"E"
         ;;D^OCXO VARIABLE NAME
         ;;R^"863.3:","863.32:1",1,"E"
         ;;D^OCXPSD
         ;;R^"863.3:","863.32:2",.01,"E"
         ;;D^OCXO VT-BAR PIECE NUMBER
         ;;R^"863.3:","863.32:2",1,"E"
         ;;D^2
         ;;R^"863.3:","863.32:3",.01,"E"
         ;;D^OCXO UP-ARROW PIECE NUMBER
         ;;R^"863.3:","863.32:3",1,"E"
         ;;D^4
         ;;EOR^
         ;;KEY^863.3:^PATIENT.OPS_FILLER
         ;;R^"863.3:",.01,"E"
         ;;D^PATIENT.OPS_FILLER
         ;;R^"863.3:",.02,"E"
         ;;D^PATIENT
         ;;R^"863.3:",.04,"E"
         ;;D^OPS
         ;;R^"863.3:",.05,"E"
         ;;D^FILLER
         ;;R^"863.3:",.06,"E"
         ;;D^99
         ;;R^"863.3:","863.32:1",.01,"E"
         ;;D^OCXO VARIABLE NAME
         ;;R^"863.3:","863.32:1",1,"E"
         ;;D^OCXPSD
         ;;R^"863.3:","863.32:2",.01,"E"
         ;;D^OCXO VT-BAR PIECE NUMBER
         ;;R^"863.3:","863.32:2",1,"E"
         ;;D^1
         ;;EOR^
         ;;KEY^863.3:^PATIENT.OPS_ORD_MODE
         ;;R^"863.3:",.01,"E"
         ;;D^PATIENT.OPS_ORD_MODE
         ;;R^"863.3:",.02,"E"
         ;;D^PATIENT
         ;;R^"863.3:",.04,"E"
         ;;D^OPS
         ;;R^"863.3:",.05,"E"
         ;;D^ORDER MODE
         ;;R^"863.3:",.06,"E"
         ;;D^99
         ;;R^"863.3:","863.32:1",.01,"E"
         ;;D^OCXO VARIABLE NAME
         ;;R^"863.3:","863.32:1",1,"E"
         ;;D^OCXPSM
         ;;EOR^
         ;;EOF^OCXS(863.3)^1
         ;;SOF^860.9  ORDER CHECK NATIONAL TERM
         ;;KEY^860.9:^ANGIOGRAM (PERIPHERAL)
         ;;R^"860.9:",.01,"E"
         ;;D^ANGIOGRAM (PERIPHERAL)
         ;;R^"860.9:",.02,"E"
         ;;D^101.43
         ;;EOR^
         ;;KEY^860.9:^BLOOD SPECIMEN
         ;;R^"860.9:",.01,"E"
         ;;D^BLOOD SPECIMEN
         ;;R^"860.9:",.02,"E"
         ;;D^61
         ;;EOR^
         ;;KEY^860.9:^DANGEROUS MEDS FOR PTS > 64
         ;;R^"860.9:",.01,"E"
         ;;D^DANGEROUS MEDS FOR PTS > 64
         ;;R^"860.9:",.02,"E"
         ;;D^101.43
         ;;R^"860.9:",2,"E"
         ;;D^I $P($G(^ORD(100.98,$P($G(^ORD(101.43,+Y,0)),U,5),0)),U)="PHARMACY"
         ;;EOR^
         ;;KEY^860.9:^DNR
         ;;R^"860.9:",.01,"E"
         ;;D^DNR
         ;;R^"860.9:",.02,"E"
         ;;D^101.43
         ;;EOR^
         ;;KEY^860.9:^EGFR
         ;;R^"860.9:",.01,"E"
         ;;D^EGFR
         ;;R^"860.9:",.02,"E"
         ;;D^60
         ;;EOR^
         ;;KEY^860.9:^FOOD-DRUG INTERACTION MED
         ;;R^"860.9:",.01,"E"
         ;;D^FOOD-DRUG INTERACTION MED
         ;;R^"860.9:",.02,"E"
         ;;D^101.43
         ;;R^"860.9:",2,"E"
         ;;D^I $P($G(^ORD(100.98,$P($G(^ORD(101.43,+Y,0)),U,5),0)),U)="PHARMACY"
         ;;EOR^
         ;;KEY^860.9:^NPO
         ;;R^"860.9:",.01,"E"
         ;;D^NPO
         ;;R^"860.9:",.02,"E"
         ;;D^101.43
         ;;EOR^
         ;;KEY^860.9:^ONE TIME MED
         ;;R^"860.9:",.01,"E"
         ;;D^ONE TIME MED
         ;;R^"860.9:",.02,"E"
         ;;D^51.1
         ;;R^"860.9:",2,"E"
         ;;D^I $E($P(^(0),U,4),1,2)="PS"
         ;;EOR^
         ;;KEY^860.9:^PARTIAL THROMBOPLASTIN TIME
         ;;R^"860.9:",.01,"E"
         ;;D^PARTIAL THROMBOPLASTIN TIME
         ;;R^"860.9:",.02,"E"
         ;;D^101.43
         ;;EOR^
         ;;KEY^860.9:^PROTHROMBIN TIME
         ;;R^"860.9:",.01,"E"
         ;;D^PROTHROMBIN TIME
         ;;R^"860.9:",.02,"E"
         ;;D^101.43
         ;;EOR^
         ;;KEY^860.9:^SERUM CREATININE
         ;;R^"860.9:",.01,"E"
         ;;D^SERUM CREATININE
         ;;R^"860.9:",.02,"E"
         ;;D^60
         ;;EOR^
         ;;KEY^860.9:^SERUM SPECIMEN
         ;;R^"860.9:",.01,"E"
         ;;D^SERUM SPECIMEN
         ;;R^"860.9:",.02,"E"
         ;;D^61
         ;;EOR^
         ;;KEY^860.9:^SERUM UREA NITROGEN
         ;;R^"860.9:",.01,"E"
         ;;D^SERUM UREA NITROGEN
         ;;R^"860.9:",.02,"E"
         ;;D^60
         ;;EOR^
         ;;KEY^860.9:^THROMBOPLASTIN TIME PARTIAL
         ;;R^"860.9:",.01,"E"
         ;;D^THROMBOPLASTIN TIME PARTIAL
         ;;R^"860.9:",.02,"E"
         ;;D^60
         ;;EOR^
         ;;KEY^860.9:^WBC
         ;;R^"860.9:",.01,"E"
         ;;D^WBC
         ;;R^"860.9:",.02,"E"
         ;;D^60
         ;;EOR^
         ;;EOF^OCXS(860.9)^1
         ;;SOF^860.8  ORDER CHECK COMPILER FUNCTIONS
         ;;KEY^860.8:^CONVERT DATE FROM FILEMAN FORMAT TO OCX FORMAT
         ;;R^"860.8:",.01,"E"
         ;;D^CONVERT DATE FROM FILEMAN FORMAT TO OCX FORMAT
         ;;R^"860.8:",.02,"E"
         ;;D^DT2INT
         ;;R^"860.8:",1,1
         ;;D^  ;DT2INT(OCXDT) ;      This Local Extrinsic Function converts a da
          te into an integer
         ;;R^"860.8:",1,2
         ;;D^  ; ; By taking the Years, Months, Days, Hours and Minutes converti
          ng
         ;;R^"860.8:",1,3
         ;;D^  ; ; Them into Seconds and then adding them all together into one 
          big integer
         ;;R^"860.8:",100,1
         ;;D^  ;DT2INT(OCXDT) ;      This Local Extrinsic Function converts a da
          te into an integer
         ;;R^"860.8:",100,2
         ;;D^  ; ; By taking the Years, Months, Days, Hours and Minutes converti
          ng
         ;;R^"860.8:",100,3
         ;;D^  ; ; Them into Seconds and then adding them all together into one 
          big integer
         ;;R^"860.8:",100,4
         ;;D^  ; ;
         ;;R^"860.8:",100,5
         ;;D^  ; Q:'$L($G(OCXDT)) ""
         ;;R^"860.8:",100,6
         ;;D^  ; N OCXDIFF,OCXVAL S (OCXDIFF,OCXVAL)=0
         ;;R^"860.8:",100,7
         ;;D^  ; ;
         ;;R^"860.8:",100,8
         ;;D^  ; I $L(OCXDT),'OCXDT,(OCXDT[" at ") D  ; EXTERNAL EXPERT SYSTEM F
          ORMAT 1 TO EXTERNAL FORMAT
         ;;R^"860.8:",100,9
         ;;D^  ; .N OCXHR,OCXMIN,OCXTIME
         ;;R^"860.8:",100,10
         ;;D^  ; .S OCXTIME=$P($P(OCXDT," at ",2),".",1),OCXHR=$P(OCXTIME,":",1)
          ,OCXMIN=$P(OCXTIME,":",2)
         ;;R^"860.8:",100,11
         ;;D^  ; .S:(OCXDT["Midnight") OCXHR=00
         ;;R^"860.8:",100,12
         ;;D^  ; .S:(OCXDT["PM") OCXHR=OCXHR+12
         ;;R^"860.8:",100,13
         ;;D^  ; .S OCXDT=$P(OCXDT," at ")_"@"_$E(OCXHR+100,2,3)_$E(OCXMIN+100,2
          ,3)
         ;;R^"860.8:",100,14
         ;;D^  ; ;
         ;;R^"860.8:",100,15
         ;;D^  ; I $L(OCXDT),(OCXDT?1.2N1"/"1.2N.1" ".2N.1":".2N) D  ; EXTERNAL 
          EXPERT SYSTEM FORMAT 2 TO EXTERNAL FORMAT
         ;;R^"860.8:",100,16
         ;;D^  ; .N OCXMON
         ;;R^"860.8:",100,17
         ;;D^  ; .S OCXMON=$P("January^February^March^April^May^June^July^August
          ^September^October^November^December",U,$P(OCXDT,"/",1))
         ;;R^"860.8:",100,18
         ;;D^  ; .I $L($P(OCXDT," ",2)) S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/
          ",2)_"@"_$TR($P(OCXDT," ",2),":","")
         ;;R^"860.8:",100,19
         ;;D^  ; .E  S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)
         ;;R^"860.8:",100,20
         ;;D^  ; ;
         ;;R^"860.8:",100,21
         ;;D^  ; I $L(OCXDT),(OCXDT?1.2N1"/"1.2N1"/"1.2N.1" ".2N.1":".2N) D  ; E
          XTERNAL EXPERT SYSTEM FORMAT 3 TO EXTERNAL FORMAT
         ;;R^"860.8:",100,22
         ;;D^  ; .N OCXMON
         ;;R^"860.8:",100,23
         ;;D^  ; .S OCXMON=$P("January^February^March^April^May^June^July^August
          ^September^October^November^December",U,$P(OCXDT,"/",1))
         ;;R^"860.8:",100,24
         ;;D^  ; .I $L($P(OCXDT," ",2)) S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/
          ",2)_","_$P($P(OCXDT," ",1),"/",3)_"@"_$TR($P(OCXDT," ",2),":","")
         ;;R^"860.8:",100,25
         ;;D^  ; .E  S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)_", "_$P($P(OCX
          DT," ",1),"/",3)
         ;;R^"860.8:",100,26
         ;;D^  ; ;
         ;;R^"860.8:",100,27
         ;;D^  ; I $L(OCXDT),'OCXDT D  ; EXTERNAL FORMAT TO INTERNAL FILEMAN FOR
          MAT
         ;;R^"860.8:",100,28
         ;;D^  ; .I (OCXDT["@0000") S OCXDT=$P(OCXDT,"@",1),OCXDIFF=1
         ;;R^"860.8:",100,29
         ;;D^  ; .N %DT,X,Y S X=OCXDT,%DT="" S:(OCXDT["@")!(OCXDT="N") %DT="T" D
           ^%DT S OCXDT=+Y
         ;;R^"860.8:",100,30
         ;;D^  ; ;
         ;;R^"860.8:",100,31
         ;;D^  ; I ($L(OCXDT\1)>7) S OCXDT=$$HL7TFM^XLFDT(OCXDT)  ; HL7 FORMAT T
          O INTERNAL FILEMAN FORMAT
         ;;R^"860.8:",100,32
         ;;D^  ; ;
         ;;R^"860.8:",100,33
         ;;D^  ; I ($L(OCXDT\1)=7) S OCXDT=$$FMTH^XLFDT(+OCXDT)   ; INTERNAL FIL
          EMAN FORMAT TO $H FORMAT
         ;;R^"860.8:",100,34
         ;;D^  ; ;
         ;;R^"860.8:",100,35
         ;;D^  ; I (OCXDT?5N1","1.5N) S OCXVAL=(OCXDT*86400)+$P(OCXDT,",",2)    
           ;  $H FORMAT TO EXPERT SYSTEM INTERNAL FORMAT
         ;;R^"860.8:",100,36
         ;;D^  ; ;
         ;;R^"860.8:",100,37
         ;;D^  ; Q OCXVAL
         ;;R^"860.8:",100,38
         ;;D^  ; ;
         ;;EOR^
         ;;KEY^860.8:^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
         ;;R^"860.8:",.01,"E"
         ;;D^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
         ;;R^"860.8:",.02,"E"
         ;;D^INT2DT
         ;;R^"860.8:",1,1
         ;;D^  ;INT2DT(OCXDT,OCXF) ;      This Local Extrinsic Function converts
           an OCX internal format
         ;1;
         ;

*****   INDEX OF ORY42704   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
>> LINE         S+6*
   LOCAL        S+5!
   OPCODE       S+5!
>> QUIT         S+6
   REF          S+5!
   REMOTE       S+5!
>> TEXT         S+6*,S+7

Global Variables  ( * Changed  ! Killed)
   ^TMP("OCXRULE"      S+7*

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   $T(DATA+LINE S+6

Label References
   NONE

External References
   ^ORY42705           S+9
   DOT^ORY427ES        S+2

*****   END   *****
ORY42705   7557     printed  Jun 28, 2016@13:15:59                     Page 14

ORY42705  ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Instal
l of OR*3*427) ;MAY 10,2016 at 13:31
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 +3       ;
S         ;
 +1       ;
 +2        DO DOT^ORY427ES
 +3       ;
 +4       ;
 +5        KILL REMOTE,LOCAL,OPCODE,REF
 +6        FOR LINE=1:1:500
               SET TEXT=$PIECE($TEXT(DATA+LINE),";",2,999)
               IF TEXT
                   QUIT 
               IF $LENGTH(TEXT)
                   Begin DoDot:1
 +7                    SET ^TMP("OCXRULE",$JOB,$ORDER(^TMP("OCXRULE",$JOB,"A"),-
1)+1)=TEXT
                   End DoDot:1
                   IF QUIT
                       QUIT 
 +8       ;
 +9        GOTO ^ORY42706
 +10      ;
 +11       QUIT 
 +12      ;
DATA      ;
 +1       ;
 +2       ;;R^"860.8:",1,2
 +3       ;;D^  ; ; date into an Externl Format (Human Readable) date.   'OCXF=S
HORT FORMAT OCXF=LONG FORMAT
 +4       ;;R^"860.8:",1,3
 +5       ;;D^  ; ;
 +6       ;;R^"860.8:",100,1
 +7       ;;D^  ;INT2DT(OCXDT,OCXF) ;      This Local Extrinsic Function convert
s an OCX internal format
 +8       ;;R^"860.8:",100,2
 +9       ;;D^  ; ; date into an Externl Format (Human Readable) date.   'OCXF=S
HORT FORMAT OCXF=LONG FORMAT
 +10      ;;R^"860.8:",100,3
 +11      ;;D^  ; ;
 +12      ;;R^"860.8:",100,4
 +13      ;;D^  ; Q:'$L($G(OCXDT)) "" S OCXF=+$G(OCXF)
 +14      ;;R^"860.8:",100,5
 +15      ;;D^  ; N OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXCYR
 +16      ;;R^"860.8:",100,6
 +17      ;;D^  ; S (OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXAP)=""
 +18      ;;R^"860.8:",100,7
 +19      ;;D^  ; S OCXSEC=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
 +20      ;;R^"860.8:",100,8
 +21      ;;D^  ; S OCXMIN=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
 +22      ;;R^"860.8:",100,9
 +23      ;;D^  ; S OCXHR=$E(OCXDT#24+100,2,3),OCXDT=OCXDT\24
 +24      ;;R^"860.8:",100,10
 +25      ;;D^  ; S OCXCYR=($H\1461)*4+1841+(($H#1461)\365)
 +26      ;;R^"860.8:",100,11
 +27      ;;D^  ; S OCXYR=(OCXDT\1461)*4+1841,OCXDT=OCXDT#1461
 +28      ;;R^"860.8:",100,12
 +29      ;;D^  ; S OCXLPYR=(OCXDT\365),OCXDT=OCXDT-(OCXLPYR*365),OCXYR=OCXYR+OC
XLPYR
 +30      ;;R^"860.8:",100,13
 +31      ;;D^  ; S OCXCNT="031^059^090^120^151^181^212^243^273^304^334^365"
 +32      ;;R^"860.8:",100,14
 +33      ;;D^  ; S:(OCXLPYR=3) OCXCNT="031^060^091^121^152^182^213^244^274^305^
335^366"
 +34      ;;R^"860.8:",100,15
 +35      ;;D^  ; F OCXMON=1:1:12 Q:(OCXDT<$P(OCXCNT,U,OCXMON))
 +36      ;;R^"860.8:",100,16
 +37      ;;D^  ; S OCXDAY=OCXDT-$P(OCXCNT,U,OCXMON-1)+1
 +38      ;;R^"860.8:",100,17
 +39      ;;D^  ; I OCXF S OCXMON=$P("January^February^March^April^May^June^July
^August^September^October^November^December",U,OCXMON)
 +40      ;;R^"860.8:",100,18
 +41      ;;D^  ; E  S OCXMON=$E(OCXMON+100,2,3)
 +42      ;;R^"860.8:",100,19
 +43      ;;D^  ; S OCXAP=$S('OCXHR:"Midnight",(OCXHR=12):"Noon",(OCXHR<12):"AM"
,1:"PM")
 +44      ;;R^"860.8:",100,20
 +45      ;;D^  ; I OCXF S OCXHR=OCXHR#12 S:'OCXHR OCXHR=12
 +46      ;;R^"860.8:",100,21
 +47      ;;D^  ; Q:'OCXF $E(OCXMON+100,2,3)_"/"_$E(OCXDAY+100,2,3)_$S((OCXCYR=O
CXYR):" "_OCXHR_":"_OCXMIN,1:"/"_$E(OCXYR,3,4))
 +48      ;;R^"860.8:",100,22
 +49      ;;D^  ; Q:(OCXHR+OCXMIN+OCXSEC) OCXMON_" "_OCXDAY_","_OCXYR_" at "_OCX
HR_":"_OCXMIN_"."_OCXSEC_" "_OCXAP
 +50      ;;R^"860.8:",100,23
 +51      ;;D^  ; Q OCXMON_" "_OCXDAY_","_OCXYR
 +52      ;;R^"860.8:",100,24
 +53      ;;D^  ; ;
 +54      ;;EOR^
 +55      ;;KEY^860.8:^ELAPSED ORDER CHECK TIME LOGGER
 +56      ;;R^"860.8:",.01,"E"
 +57      ;;D^ELAPSED ORDER CHECK TIME LOGGER
 +58      ;;R^"860.8:",.02,"E"
 +59      ;;D^TIMELOG
 +60      ;;R^"860.8:",100,1
 +61      ;;D^  ;TIMELOG(OCXMODE,OCXCALL) ; Log an entry in the Elapsed time log
.
 +62      ;;R^"860.8:",100,2
 +63      ;;D^  ; ;
 +64      ;;R^"860.8:",100,3
 +65      ;;D^  ; ;
 +66      ;;R^"860.8:",100,4
 +67      ;;D^  ; Q 0
 +68      ;;R^"860.8:",100,5
 +69      ;;D^  ; ;
 +70      ;;EOR^
 +71      ;;KEY^860.8:^EQUALS TERM OPERATOR
 +72      ;;R^"860.8:",.01,"E"
 +73      ;;D^EQUALS TERM OPERATOR
 +74      ;;R^"860.8:",.02,"E"
 +75      ;;D^EQTERM
 +76      ;;R^"860.8:",100,1
 +77      ;;D^  ;EQTERM(DATA,TERM) ;
 +78      ;;R^"860.8:",100,2
 +79      ;;D^  ; ;
 +80      ;;R^"860.8:",100,3
 +81      ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," Execution trace  DATA: ",$G(DA
TA),"   TERM: ",$G(TERM)
 +82      ;;R^"860.8:",100,4
 +83      ;;D^  ; N OCXF,OCXL
 +84      ;;R^"860.8:",100,5
 +85      ;;D^  ; ;
 +86      ;;R^"860.8:",100,6
 +87      ;;D^  ; S OCXL="",OCXF=$$TERMLKUP(TERM,.OCXL)
 +88      ;;R^"860.8:",100,7
 +89      ;;D^T-; Q:'OCXF 0
 +90      ;;R^"860.8:",100,8
 +91      ;;D^T+; I 'OCXF W:$G(OCXTRACE) !,"%%%%",?20," Term '",TERM,"' not in O
rder Check National Term File" Q 0
 +92      ;;R^"860.8:",100,9
 +93      ;;D^T+; I '$O(OCXL(0)) W:$G(OCXTRACE) !,"%%%%",?20," There are no loca
l terms listed for the National Term '",TERM,"'." Q 0
 +94      ;;R^"860.8:",100,10
 +95      ;;D^T+; I ($D(OCXL(DATA))!$D(OCXL("B",DATA))) W:$G(OCXTRACE) !,"%%%%",
?20," Data equals Term" Q 1
 +96      ;;R^"860.8:",100,11
 +97      ;;D^T-; I ($D(OCXL(DATA))!$D(OCXL("B",DATA))) Q 1
 +98      ;;R^"860.8:",100,12
 +99      ;;D^T-; Q 0
 +100     ;;R^"860.8:",100,13
 +101     ;;D^T+; W:$G(OCXTRACE) !,"%%%%",?20," Data does not equal Term" Q 0
 +102     ;;R^"860.8:",100,14
 +103     ;;D^  ; ;
 +104     ;;EOR^
 +105     ;;KEY^860.8:^FILE DATA IN PATIENT ACTIVE DATA FILE
 +106     ;;R^"860.8:",.01,"E"
 +107     ;;D^FILE DATA IN PATIENT ACTIVE DATA FILE
 +108     ;;R^"860.8:",.02,"E"
 +109     ;;D^FILE
 +110     ;;R^"860.8:",1,1
 +111     ;;D^  ;FILE(DFN,OCXELE,OCXDFL) ;     This Local Extrinsic Function fil
es data
 +112     ;;R^"860.8:",1,2
 +113     ;;D^  ; ;     in the Order Check Patient Data File
 +114     ;;R^"860.8:",1,3
 +115     ;;D^  ; ;
 +116     ;;R^"860.8:",100,1
 +117     ;;D^  ;FILE(DFN,OCXELE,OCXDFL) ;     This Local Extrinsic Function log
s a validated event/element.
 +118     ;;R^"860.8:",100,2
 +119     ;;D^  ; ;
 +120     ;;R^"860.8:",100,3
 +121     ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," Execution trace  DFN: ",DFN," 
  OCXELE: ",+$G(OCXELE),"   OCXDFL: ",$G(OCXDFL)
 +122     ;;R^"860.8:",100,4
 +123     ;;D^  ; N OCXTIMN,OCXTIML,OCXTIMT1,OCXTIMT2,OCXDATA,OCXPC,OCXPC,OCXVAL
,OCXSUB,OCXDFI
 +124     ;;R^"860.8:",100,5
 +125     ;;D^  ; S DFN=+$G(DFN),OCXELE=+$G(OCXELE)
 +126     ;;R^"860.8:",100,6
 +127     ;;D^  ; ;
 +128     ;;R^"860.8:",100,7
 +129     ;;D^  ; Q:'DFN 1 Q:'OCXELE 1 K OCXDATA
 +130     ;;R^"860.8:",100,8
 +131     ;;D^  ; ;
 +132     ;;R^"860.8:",100,9
 +133     ;;D^  ; S OCXDATA(DFN,OCXELE)=1
 +134     ;;R^"860.8:",100,10
 +135     ;;D^  ; F OCXPC=1:1:$L(OCXDFL,",") S OCXDFI=$P(OCXDFL,",",OCXPC) I OCX
DFI D
 +136     ;;R^"860.8:",100,11
 +137     ;;D^  ; .S OCXVAL=$G(OCXDF(+OCXDFI)),OCXDATA(DFN,OCXELE,+OCXDFI)=OCXVA
L
 +138     ;;R^"860.8:",100,12
 +139     ;;D^T+; .I $G(OCXTRACE) W !,"%%%%",?20,"   ",$P($G(^OCXS(860.4,+OCXDFI
,0)),U,1)," = """,OCXVAL,""""
 +140     ;;R^"860.8:",100,13
 +141     ;;D^  ; ;
 +142     ;;R^"860.8:",100,14
 +143     ;;D^  ; M ^TMP("OCXCHK",$J,DFN)=OCXDATA(DFN)
 +144     ;;R^"860.8:",100,15
 +145     ;;D^  ; ;
 +146     ;;R^"860.8:",100,16
 +147     ;;D^  ; Q 0
 +148     ;;R^"860.8:",100,17
 +149     ;;D^  ; ;
 +150     ;;EOR^
 +151     ;;KEY^860.8:^GENERATE STRING CHECKSUM
 +152     ;;R^"860.8:",.01,"E"
 +153     ;;D^GENERATE STRING CHECKSUM
 +154     ;;R^"860.8:",.02,"E"
 +155     ;;D^CKSUM
 +156     ;;R^"860.8:",100,1
 +157     ;;D^  ;CKSUM(STR) ;
 +158     ;;R^"860.8:",100,2
 +159     ;;D^  ; ;
 +160     ;;R^"860.8:",100,3
 +161     ;;D^  ; N CKSUM,PTR,ASC S CKSUM=0
 +162     ;;R^"860.8:",100,4
 +163     ;;D^  ; S STR=$TR(STR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQR
STUVWXYZ")
 +164     ;;R^"860.8:",100,5
 +165     ;;D^  ; F PTR=$L(STR):-1:1 S ASC=$A(STR,PTR)-42 I (ASC>0),(ASC<51) S C
KSUM=CKSUM*2+ASC
 +166     ;;R^"860.8:",100,6
 +167     ;;D^  ; Q +CKSUM
 +168     ;;R^"860.8:",100,7
 +169     ;;D^  ; ;
 +170     ;;EOR^
 +171     ;;KEY^860.8:^GET DATA FROM THE ACTIVE DATA FILE
 +172     ;;R^"860.8:",.01,"E"
 +173     ;;D^GET DATA FROM THE ACTIVE DATA FILE
 +174     ;;R^"860.8:",.02,"E"
 +175     ;;D^GETDATA
 +176     ;;R^"860.8:",100,1
 +177     ;;D^  ;GETDATA(DFN,OCXL,OCXDFI) ;     This Local Extrinsic Function re
turns runtime data
 +178     ;;R^"860.8:",100,2
 +179     ;;D^  ; ;
 +180     ;;R^"860.8:",100,3
 +181     ;;D^  ; N OCXE,VAL,PC S VAL=""
 +182     ;;R^"860.8:",100,4
 +183     ;;D^  ; F PC=1:1:$L(OCXL,U) S OCXE=$P(OCXL,U,PC) I OCXE S VAL=$G(^TMP(
"OCXCHK",$J,DFN,OCXE,OCXDFI)) Q:$L(VAL)
 +184     ;;R^"860.8:",100,5
 +185     ;;D^  ; Q VAL
 +186     ;;R^"860.8:",100,6
 +187     ;;D^  ; ;
 +188     ;;EOR^
 +189     ;;KEY^860.8:^IN LIST OPERATOR
 +190     ;;R^"860.8:",.01,"E"
 +191     ;;D^IN LIST OPERATOR
 +192     ;;R^"860.8:",.02,"E"
 +193     ;;D^LIST
 +194     ;;R^"860.8:",100,1
 +195     ;;D^  ;LIST(DATA,LIST) ;   IS THE DATA FIELD IN THE LIST
 +196     ;;R^"860.8:",100,2
 +197     ;;D^  ; ;
 +198     ;;R^"860.8:",100,3
 +199     ;;D^T+; W:$G(OCXTRACE) !,"%%%%",?20,"     $$LIST(""",DATA,""",""",LIST
,""")"
 +200     ;;R^"860.8:",100,4
 +201     ;;D^  ; S:'($E(LIST,1)=",") LIST=","_LIST S:'($E(LIST,$L(LIST))=",") L
IST=LIST_"," S DATA=","_DATA_","
 +202     ;;R^"860.8:",100,5
 +203     ;;D^  ; Q (LIST[DATA)
 +204     ;;R^"860.8:",100,6
 +205     ;;D^  ; ;
 +206     ;;EOR^
 +207     ;;KEY^860.8:^LOCAL TERM LOOKUP
 +208     ;;R^"860.8:",.01,"E"
 +209     ;1;
 +210     ;


ORY42705 * *  228 Lines,  7557 Bytes, Checksum: B60288831
                                                  Jun 28, 2016@13:15:59 page 15
              120 bytes in comments
ORY42705 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install
           of OR*3*427) ;MAY 10,2016 at 13:31
         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
         ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
         ;
S        ;
         ;
         D DOT^ORY427ES
         ;
         ;
         K REMOTE,LOCAL,OPCODE,REF
         F LINE=1:1:500 S TEXT=$P($T(DATA+LINE),";",2,999) Q:TEXT  I $L(TEXT) D 
           Q:QUIT
         .S ^TMP("OCXRULE",$J,$O(^TMP("OCXRULE",$J,"A"),-1)+1)=TEXT
         ;
         G ^ORY42706
         ;
         Q
         ;
DATA     ;
         ;
         ;;R^"860.8:",1,2
         ;;D^  ; ; date into an Externl Format (Human Readable) date.   'OCXF=SH
          ORT FORMAT OCXF=LONG FORMAT
         ;;R^"860.8:",1,3
         ;;D^  ; ;
         ;;R^"860.8:",100,1
         ;;D^  ;INT2DT(OCXDT,OCXF) ;      This Local Extrinsic Function converts
           an OCX internal format
         ;;R^"860.8:",100,2
         ;;D^  ; ; date into an Externl Format (Human Readable) date.   'OCXF=SH
          ORT FORMAT OCXF=LONG FORMAT
         ;;R^"860.8:",100,3
         ;;D^  ; ;
         ;;R^"860.8:",100,4
         ;;D^  ; Q:'$L($G(OCXDT)) "" S OCXF=+$G(OCXF)
         ;;R^"860.8:",100,5
         ;;D^  ; N OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXCYR
         ;;R^"860.8:",100,6
         ;;D^  ; S (OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXAP)=""
         ;;R^"860.8:",100,7
         ;;D^  ; S OCXSEC=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
         ;;R^"860.8:",100,8
         ;;D^  ; S OCXMIN=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
         ;;R^"860.8:",100,9
         ;;D^  ; S OCXHR=$E(OCXDT#24+100,2,3),OCXDT=OCXDT\24
         ;;R^"860.8:",100,10
         ;;D^  ; S OCXCYR=($H\1461)*4+1841+(($H#1461)\365)
         ;;R^"860.8:",100,11
         ;;D^  ; S OCXYR=(OCXDT\1461)*4+1841,OCXDT=OCXDT#1461
         ;;R^"860.8:",100,12
         ;;D^  ; S OCXLPYR=(OCXDT\365),OCXDT=OCXDT-(OCXLPYR*365),OCXYR=OCXYR+OCX
          LPYR
         ;;R^"860.8:",100,13
         ;;D^  ; S OCXCNT="031^059^090^120^151^181^212^243^273^304^334^365"
         ;;R^"860.8:",100,14
         ;;D^  ; S:(OCXLPYR=3) OCXCNT="031^060^091^121^152^182^213^244^274^305^3
          35^366"
         ;;R^"860.8:",100,15
         ;;D^  ; F OCXMON=1:1:12 Q:(OCXDT<$P(OCXCNT,U,OCXMON))
         ;;R^"860.8:",100,16
         ;;D^  ; S OCXDAY=OCXDT-$P(OCXCNT,U,OCXMON-1)+1
         ;;R^"860.8:",100,17
         ;;D^  ; I OCXF S OCXMON=$P("January^February^March^April^May^June^July^
          August^September^October^November^December",U,OCXMON)
         ;;R^"860.8:",100,18
         ;;D^  ; E  S OCXMON=$E(OCXMON+100,2,3)
         ;;R^"860.8:",100,19
         ;;D^  ; S OCXAP=$S('OCXHR:"Midnight",(OCXHR=12):"Noon",(OCXHR<12):"AM",
          1:"PM")
         ;;R^"860.8:",100,20
         ;;D^  ; I OCXF S OCXHR=OCXHR#12 S:'OCXHR OCXHR=12
         ;;R^"860.8:",100,21
         ;;D^  ; Q:'OCXF $E(OCXMON+100,2,3)_"/"_$E(OCXDAY+100,2,3)_$S((OCXCYR=OC
          XYR):" "_OCXHR_":"_OCXMIN,1:"/"_$E(OCXYR,3,4))
         ;;R^"860.8:",100,22
         ;;D^  ; Q:(OCXHR+OCXMIN+OCXSEC) OCXMON_" "_OCXDAY_","_OCXYR_" at "_OCXH
          R_":"_OCXMIN_"."_OCXSEC_" "_OCXAP
         ;;R^"860.8:",100,23
         ;;D^  ; Q OCXMON_" "_OCXDAY_","_OCXYR
         ;;R^"860.8:",100,24
         ;;D^  ; ;
         ;;EOR^
         ;;KEY^860.8:^ELAPSED ORDER CHECK TIME LOGGER
         ;;R^"860.8:",.01,"E"
         ;;D^ELAPSED ORDER CHECK TIME LOGGER
         ;;R^"860.8:",.02,"E"
         ;;D^TIMELOG
         ;;R^"860.8:",100,1
         ;;D^  ;TIMELOG(OCXMODE,OCXCALL) ; Log an entry in the Elapsed time log.
         ;;R^"860.8:",100,2
         ;;D^  ; ;
         ;;R^"860.8:",100,3
         ;;D^  ; ;
         ;;R^"860.8:",100,4
         ;;D^  ; Q 0
         ;;R^"860.8:",100,5
         ;;D^  ; ;
         ;;EOR^
         ;;KEY^860.8:^EQUALS TERM OPERATOR
         ;;R^"860.8:",.01,"E"
         ;;D^EQUALS TERM OPERATOR
         ;;R^"860.8:",.02,"E"
         ;;D^EQTERM
         ;;R^"860.8:",100,1
         ;;D^  ;EQTERM(DATA,TERM) ;
         ;;R^"860.8:",100,2
         ;;D^  ; ;
         ;;R^"860.8:",100,3
         ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," Execution trace  DATA: ",$G(DAT
          A),"   TERM: ",$G(TERM)
         ;;R^"860.8:",100,4
         ;;D^  ; N OCXF,OCXL
         ;;R^"860.8:",100,5
         ;;D^  ; ;
         ;;R^"860.8:",100,6
         ;;D^  ; S OCXL="",OCXF=$$TERMLKUP(TERM,.OCXL)
         ;;R^"860.8:",100,7
         ;;D^T-; Q:'OCXF 0
         ;;R^"860.8:",100,8
         ;;D^T+; I 'OCXF W:$G(OCXTRACE) !,"%%%%",?20," Term '",TERM,"' not in Or
          der Check National Term File" Q 0
         ;;R^"860.8:",100,9
         ;;D^T+; I '$O(OCXL(0)) W:$G(OCXTRACE) !,"%%%%",?20," There are no local
           terms listed for the National Term '",TERM,"'." Q 0
         ;;R^"860.8:",100,10
         ;;D^T+; I ($D(OCXL(DATA))!$D(OCXL("B",DATA))) W:$G(OCXTRACE) !,"%%%%",?
          20," Data equals Term" Q 1
         ;;R^"860.8:",100,11
         ;;D^T-; I ($D(OCXL(DATA))!$D(OCXL("B",DATA))) Q 1
         ;;R^"860.8:",100,12
         ;;D^T-; Q 0
         ;;R^"860.8:",100,13
         ;;D^T+; W:$G(OCXTRACE) !,"%%%%",?20," Data does not equal Term" Q 0
         ;;R^"860.8:",100,14
         ;;D^  ; ;
         ;;EOR^
         ;;KEY^860.8:^FILE DATA IN PATIENT ACTIVE DATA FILE
         ;;R^"860.8:",.01,"E"
         ;;D^FILE DATA IN PATIENT ACTIVE DATA FILE
         ;;R^"860.8:",.02,"E"
         ;;D^FILE
         ;;R^"860.8:",1,1
         ;;D^  ;FILE(DFN,OCXELE,OCXDFL) ;     This Local Extrinsic Function file
          s data
         ;;R^"860.8:",1,2
         ;;D^  ; ;     in the Order Check Patient Data File
         ;;R^"860.8:",1,3
         ;;D^  ; ;
         ;;R^"860.8:",100,1
         ;;D^  ;FILE(DFN,OCXELE,OCXDFL) ;     This Local Extrinsic Function logs
           a validated event/element.
         ;;R^"860.8:",100,2
         ;;D^  ; ;
         ;;R^"860.8:",100,3
         ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," Execution trace  DFN: ",DFN,"  
           OCXELE: ",+$G(OCXELE),"   OCXDFL: ",$G(OCXDFL)
         ;;R^"860.8:",100,4
         ;;D^  ; N OCXTIMN,OCXTIML,OCXTIMT1,OCXTIMT2,OCXDATA,OCXPC,OCXPC,OCXVAL,
          OCXSUB,OCXDFI
         ;;R^"860.8:",100,5
         ;;D^  ; S DFN=+$G(DFN),OCXELE=+$G(OCXELE)
         ;;R^"860.8:",100,6
         ;;D^  ; ;
         ;;R^"860.8:",100,7
         ;;D^  ; Q:'DFN 1 Q:'OCXELE 1 K OCXDATA
         ;;R^"860.8:",100,8
         ;;D^  ; ;
         ;;R^"860.8:",100,9
         ;;D^  ; S OCXDATA(DFN,OCXELE)=1
         ;;R^"860.8:",100,10
         ;;D^  ; F OCXPC=1:1:$L(OCXDFL,",") S OCXDFI=$P(OCXDFL,",",OCXPC) I OCXD
          FI D
         ;;R^"860.8:",100,11
         ;;D^  ; .S OCXVAL=$G(OCXDF(+OCXDFI)),OCXDATA(DFN,OCXELE,+OCXDFI)=OCXVAL
         ;;R^"860.8:",100,12
         ;;D^T+; .I $G(OCXTRACE) W !,"%%%%",?20,"   ",$P($G(^OCXS(860.4,+OCXDFI,
          0)),U,1)," = """,OCXVAL,""""
         ;;R^"860.8:",100,13
         ;;D^  ; ;
         ;;R^"860.8:",100,14
         ;;D^  ; M ^TMP("OCXCHK",$J,DFN)=OCXDATA(DFN)
         ;;R^"860.8:",100,15
         ;;D^  ; ;
         ;;R^"860.8:",100,16
         ;;D^  ; Q 0
         ;;R^"860.8:",100,17
         ;;D^  ; ;
         ;;EOR^
         ;;KEY^860.8:^GENERATE STRING CHECKSUM
         ;;R^"860.8:",.01,"E"
         ;;D^GENERATE STRING CHECKSUM
         ;;R^"860.8:",.02,"E"
         ;;D^CKSUM
         ;;R^"860.8:",100,1
         ;;D^  ;CKSUM(STR) ;
         ;;R^"860.8:",100,2
         ;;D^  ; ;
         ;;R^"860.8:",100,3
         ;;D^  ; N CKSUM,PTR,ASC S CKSUM=0
         ;;R^"860.8:",100,4
         ;;D^  ; S STR=$TR(STR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRS
          TUVWXYZ")
         ;;R^"860.8:",100,5
         ;;D^  ; F PTR=$L(STR):-1:1 S ASC=$A(STR,PTR)-42 I (ASC>0),(ASC<51) S CK
          SUM=CKSUM*2+ASC
         ;;R^"860.8:",100,6
         ;;D^  ; Q +CKSUM
         ;;R^"860.8:",100,7
         ;;D^  ; ;
         ;;EOR^
         ;;KEY^860.8:^GET DATA FROM THE ACTIVE DATA FILE
         ;;R^"860.8:",.01,"E"
         ;;D^GET DATA FROM THE ACTIVE DATA FILE
         ;;R^"860.8:",.02,"E"
         ;;D^GETDATA
         ;;R^"860.8:",100,1
         ;;D^  ;GETDATA(DFN,OCXL,OCXDFI) ;     This Local Extrinsic Function ret
          urns runtime data
         ;;R^"860.8:",100,2
         ;;D^  ; ;
         ;;R^"860.8:",100,3
         ;;D^  ; N OCXE,VAL,PC S VAL=""
         ;;R^"860.8:",100,4
         ;;D^  ; F PC=1:1:$L(OCXL,U) S OCXE=$P(OCXL,U,PC) I OCXE S VAL=$G(^TMP("
          OCXCHK",$J,DFN,OCXE,OCXDFI)) Q:$L(VAL)
         ;;R^"860.8:",100,5
         ;;D^  ; Q VAL
         ;;R^"860.8:",100,6
         ;;D^  ; ;
         ;;EOR^
         ;;KEY^860.8:^IN LIST OPERATOR
         ;;R^"860.8:",.01,"E"
         ;;D^IN LIST OPERATOR
         ;;R^"860.8:",.02,"E"
         ;;D^LIST
         ;;R^"860.8:",100,1
         ;;D^  ;LIST(DATA,LIST) ;   IS THE DATA FIELD IN THE LIST
         ;;R^"860.8:",100,2
         ;;D^  ; ;
         ;;R^"860.8:",100,3
         ;;D^T+; W:$G(OCXTRACE) !,"%%%%",?20,"     $$LIST(""",DATA,""",""",LIST,
          """)"
         ;;R^"860.8:",100,4
         ;;D^  ; S:'($E(LIST,1)=",") LIST=","_LIST S:'($E(LIST,$L(LIST))=",") LI
          ST=LIST_"," S DATA=","_DATA_","
         ;;R^"860.8:",100,5
         ;;D^  ; Q (LIST[DATA)
         ;;R^"860.8:",100,6
         ;;D^  ; ;
         ;;EOR^
         ;;KEY^860.8:^LOCAL TERM LOOKUP
         ;;R^"860.8:",.01,"E"
         ;1;
         ;

*****   INDEX OF ORY42705   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
>> LINE         S+6*
   LOCAL        S+5!
   OPCODE       S+5!
>> QUIT         S+6
   REF          S+5!
   REMOTE       S+5!
>> TEXT         S+6*,S+7

Global Variables  ( * Changed  ! Killed)
   ^TMP("OCXRULE"      S+7*

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   $T(DATA+LINE S+6

Label References
   NONE

External References
   ^ORY42706           S+9
   DOT^ORY427ES        S+2

*****   END   *****
ORY42706   7632     printed  Jun 28, 2016@13:15:59                     Page 16

ORY42706  ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Instal
l of OR*3*427) ;MAY 10,2016 at 13:31
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 +3       ;
S         ;
 +1       ;
 +2        DO DOT^ORY427ES
 +3       ;
 +4       ;
 +5        KILL REMOTE,LOCAL,OPCODE,REF
 +6        FOR LINE=1:1:500
               SET TEXT=$PIECE($TEXT(DATA+LINE),";",2,999)
               IF TEXT
                   QUIT 
               IF $LENGTH(TEXT)
                   Begin DoDot:1
 +7                    SET ^TMP("OCXRULE",$JOB,$ORDER(^TMP("OCXRULE",$JOB,"A"),-
1)+1)=TEXT
                   End DoDot:1
                   IF QUIT
                       QUIT 
 +8       ;
 +9        GOTO ^ORY42707
 +10      ;
 +11       QUIT 
 +12      ;
DATA      ;
 +1       ;
 +2       ;;D^LOCAL TERM LOOKUP
 +3       ;;R^"860.8:",.02,"E"
 +4       ;;D^TERMLKUP
 +5       ;;R^"860.8:",1,1
 +6       ;;D^ 
 +7       ;;R^"860.8:",1,2
 +8       ;;D^  This function allows a local site to define to Order Checking
 +9       ;;R^"860.8:",1,3
 +10      ;;D^ a term specific to that site. (ie. Lab Test Name, Radiology
 +11      ;;R^"860.8:",1,4
 +12      ;;D^ procedure name, etc.)
 +13      ;;R^"860.8:",1,5
 +14      ;;D^ 
 +15      ;;R^"860.8:",100,1
 +16      ;;D^  ;TERMLKUP(OCXTERM,OCXFILE) ;
 +17      ;;R^"860.8:",100,2
 +18      ;;D^  ; ;
 +19      ;;R^"860.8:",100,3
 +20      ;;D^  ; Q
 +21      ;;R^"860.8:",100,4
 +22      ;;D^  ; ;
 +23      ;;EOR^
 +24      ;;KEY^860.8:^NEW RULE MESSAGE
 +25      ;;R^"860.8:",.01,"E"
 +26      ;;D^NEW RULE MESSAGE
 +27      ;;R^"860.8:",.02,"E"
 +28      ;;D^NEWRULE
 +29      ;;R^"860.8:",100,1
 +30      ;;D^  ;NEWRULE(OCXDFN,OCXORD,OCXRUL,OCXREL,OCXNOTF,OCXMESS) ; Has this
 rule already been triggered for this order number
 +31      ;;R^"860.8:",100,2
 +32      ;;D^  ; ;
 +33      ;;R^"860.8:",100,3
 +34      ;;D^L+; S OCXERR=$$TIMELOG("M","NEWRULE("_(+$G(OCXDFN))_","_(+$G(OCXOR
D))_","_(+$G(OCXRUL))_","_(+$G(OCXREL))_","_(+$G(OCXNOTF))_","_$G(OCXMESS)_")")
 +35      ;;R^"860.8:",100,4
 +36      ;;D^  ; ;
 +37      ;;R^"860.8:",100,5
 +38      ;;D^  ; Q:'$G(OCXDFN) 0 Q:'$G(OCXRUL) 0
 +39      ;;R^"860.8:",100,6
 +40      ;;D^  ; Q:'$G(OCXREL) 0  Q:'$G(OCXNOTF) 0  Q:'$L($G(OCXMESS)) 0
 +41      ;;R^"860.8:",100,7
 +42      ;;D^  ; S OCXORD=+$G(OCXORD),OCXDFN=+OCXDFN
 +43      ;;R^"860.8:",100,8
 +44      ;;D^  ; ;
 +45      ;;R^"860.8:",100,9
 +46      ;;D^  ; N OCXNDX,OCXDATA,OCXDFI,OCXELE,OCXGR,OCXTIME,OCXCKSUM,OCXTSP,O
CXTSPL
 +47      ;;R^"860.8:",100,10
 +48      ;;D^  ; ;
 +49      ;;R^"860.8:",100,11
 +50      ;;D^  ; S OCXTIME=(+$H)
 +51      ;;R^"860.8:",100,12
 +52      ;;D^  ; S OCXCKSUM=$$CKSUM(OCXMESS)
 +53      ;;R^"860.8:",100,13
 +54      ;;D^  ; ;
 +55      ;;R^"860.8:",100,14
 +56      ;;D^  ; S OCXTSP=($H*86400)+$P($H,",",2)
 +57      ;;R^"860.8:",100,15
 +58      ;;D^  ; S OCXTSPL=($G(^OCXD(860.7,"AT",OCXTIME,OCXDFN,OCXRUL,+OCXORD,O
CXCKSUM))+$G(OCXTSPI,300))
 +59      ;;R^"860.8:",100,16
 +60      ;;D^  ; ;
 +61      ;;R^"860.8:",100,17
 +62      ;;D^  ; Q:(OCXTSPL>OCXTSP) 0
 +63      ;;R^"860.8:",100,18
 +64      ;;D^  ; ;
 +65      ;;R^"860.8:",100,19
 +66      ;;D^  ; K OCXDATA
 +67      ;;R^"860.8:",100,20
 +68      ;;D^  ; S OCXDATA(OCXDFN,0)=OCXDFN
 +69      ;;R^"860.8:",100,21
 +70      ;;D^  ; S OCXDATA("B",OCXDFN,OCXDFN)=""
 +71      ;;R^"860.8:",100,22
 +72      ;;D^  ; S OCXDATA("AT",OCXTIME,OCXDFN,OCXRUL,+OCXORD,OCXCKSUM)=OCXTSP
 +73      ;;R^"860.8:",100,23
 +74      ;;D^  ; ;
 +75      ;;R^"860.8:",100,24
 +76      ;;D^  ; S OCXGR="^OCXD(860.7"
 +77      ;;R^"860.8:",100,25
 +78      ;;D^T+; D SETAP(OCXGR_")",0,"Patient",$P($G(^DPT(OCXDFN,0)),U,1),.OCXD
ATA,OCXDFN)
 +79      ;;R^"860.8:",100,26
 +80      ;;D^T-; D SETAP(OCXGR_")",0,.OCXDATA,OCXDFN)
 +81      ;;R^"860.8:",100,27
 +82      ;;D^  ; ;
 +83      ;;R^"860.8:",100,28
 +84      ;;D^  ; K OCXDATA
 +85      ;;R^"860.8:",100,29
 +86      ;;D^  ; S OCXDATA(OCXRUL,0)=OCXRUL_U_(OCXTIME)_U_(+OCXORD)
 +87      ;;R^"860.8:",100,30
 +88      ;;D^  ; S OCXDATA(OCXRUL,"M")=OCXMESS
 +89      ;;R^"860.8:",100,31
 +90      ;;D^  ; S OCXDATA("B",OCXRUL,OCXRUL)=""
 +91      ;;R^"860.8:",100,32
 +92      ;;D^  ; S OCXGR=OCXGR_","_OCXDFN_",1"
 +93      ;;R^"860.8:",100,33
 +94      ;;D^T+; D SETAP(OCXGR_")","860.71P","Rule",$P($G(^OCXS(860.2,OCXRUL,0)
),U,1),.OCXDATA,OCXRUL)
 +95      ;;R^"860.8:",100,34
 +96      ;;D^T-; D SETAP(OCXGR_")","860.71P",.OCXDATA,OCXRUL)
 +97      ;;R^"860.8:",100,35
 +98      ;;D^  ; ;
 +99      ;;R^"860.8:",100,36
 +100     ;;D^  ; K OCXDATA
 +101     ;;R^"860.8:",100,37
 +102     ;;D^  ; S OCXDATA(OCXREL,0)=OCXREL
 +103     ;;R^"860.8:",100,38
 +104     ;;D^  ; S OCXDATA("B",OCXREL,OCXREL)=""
 +105     ;;R^"860.8:",100,39
 +106     ;;D^  ; S OCXGR=OCXGR_","_OCXRUL_",1"
 +107     ;;R^"860.8:",100,40
 +108     ;;D^T+; D SETAP(OCXGR_")","860.712","Relation",OCXREL,.OCXDATA,OCXREL)
 +109     ;;R^"860.8:",100,41
 +110     ;;D^T-; D SETAP(OCXGR_")","860.712",.OCXDATA,OCXREL)
 +111     ;;R^"860.8:",100,42
 +112     ;;D^  ; ;
 +113     ;;R^"860.8:",100,43
 +114     ;;D^  ; S OCXELE=0 F  S OCXELE=$O(^OCXS(860.2,OCXRUL,"C","C",OCXELE)) 
Q:'OCXELE  D
 +115     ;;R^"860.8:",100,44
 +116     ;;D^  ; .;
 +117     ;;R^"860.8:",100,45
 +118     ;;D^  ; .N OCXGR1
 +119     ;;R^"860.8:",100,46
 +120     ;;D^  ; .S OCXGR1=OCXGR_","_OCXREL_",1"
 +121     ;;R^"860.8:",100,47
 +122     ;;D^  ; .K OCXDATA
 +123     ;;R^"860.8:",100,48
 +124     ;;D^  ; .S OCXDATA(OCXELE,0)=OCXELE
 +125     ;;R^"860.8:",100,49
 +126     ;;D^  ; .S OCXDATA(OCXELE,"TIME")=OCXTIME
 +127     ;;R^"860.8:",100,50
 +128     ;;D^  ; .S OCXDATA(OCXELE,"LOG")=$G(OCXOLOG)
 +129     ;;R^"860.8:",100,51
 +130     ;;D^  ; .S OCXDATA("B",OCXELE,OCXELE)=""
 +131     ;;R^"860.8:",100,52
 +132     ;;D^  ; .K ^OCXD(860.7,OCXDFN,1,OCXRUL,1,OCXREL,1,OCXELE)
 +133     ;;R^"860.8:",100,53
 +134     ;;D^T+; .D SETAP(OCXGR1_")","860.7122P","Element",$P($G(^OCXS(860.3,OC
XELE,0)),U,1),.OCXDATA,OCXELE)
 +135     ;;R^"860.8:",100,54
 +136     ;;D^T-; .D SETAP(OCXGR1_")","860.7122P",.OCXDATA,OCXELE)
 +137     ;;R^"860.8:",100,55
 +138     ;;D^  ; .;
 +139     ;;R^"860.8:",100,56
 +140     ;;D^  ; .S OCXDFI=0 F  S OCXDFI=$O(^TMP("OCXCHK",$J,OCXDFN,OCXELE,OCXD
FI)) Q:'OCXDFI  D
 +141     ;;R^"860.8:",100,57
 +142     ;;D^  ; ..N OCXGR2
 +143     ;;R^"860.8:",100,58
 +144     ;;D^  ; ..S OCXGR2=OCXGR1_","_OCXELE_",1"
 +145     ;;R^"860.8:",100,59
 +146     ;;D^  ; ..K OCXDATA
 +147     ;;R^"860.8:",100,60
 +148     ;;D^  ; ..S OCXDATA(OCXDFI,0)=OCXDFI
 +149     ;;R^"860.8:",100,61
 +150     ;;D^  ; ..S OCXDATA(OCXDFI,"VAL")=^TMP("OCXCHK",$J,OCXDFN,OCXELE,OCXDF
I)
 +151     ;;R^"860.8:",100,62
 +152     ;;D^  ; ..S OCXDATA("B",OCXDFI,OCXDFI)=""
 +153     ;;R^"860.8:",100,63
 +154     ;;D^T+; ..D SETAP(OCXGR2_")","860.71223P","Data Field",$P($G(^OCXS(860
.4,OCXDFI,0)),U,1),.OCXDATA,OCXDFI)
 +155     ;;R^"860.8:",100,64
 +156     ;;D^T-; ..D SETAP(OCXGR2_")","860.71223P",.OCXDATA,OCXDFI)
 +157     ;;R^"860.8:",100,65
 +158     ;;D^  ; ;
 +159     ;;R^"860.8:",100,66
 +160     ;;D^  ; Q 1
 +161     ;;R^"860.8:",100,67
 +162     ;;D^  ; ;
 +163     ;;R^"860.8:",100,68
 +164     ;;D^T+;SETAP(ROOT,DD,ITEM,ITEMNAME,DATA,DA) ;  Set Rule Event data
 +165     ;;R^"860.8:",100,69
 +166     ;;D^T-;SETAP(ROOT,DD,DATA,DA) ;  Set Rule Event data
 +167     ;;R^"860.8:",100,70
 +168     ;;D^  ; M @ROOT=DATA
 +169     ;;R^"860.8:",100,71
 +170     ;;D^  ; I +$G(DD) S @ROOT@(0)="^"_($G(DD))_"^"_($P($G(@ROOT@(0)),U,3)+
1)_"^"_$G(DA)
 +171     ;;R^"860.8:",100,72
 +172     ;;D^  ; I '$G(DD) S $P(@ROOT@(0),U,3,4)=($P($G(@ROOT@(0)),U,3)+1)_"^"_
$G(DA)
 +173     ;;R^"860.8:",100,73
 +174     ;;D^T+; W:$G(OCXTRACE) !,"File Active Data ",$G(ITEM),": ",$G(ITEMNAME
)
 +175     ;;R^"860.8:",100,74
 +176     ;;D^  ; ;
 +177     ;;R^"860.8:",100,75
 +178     ;;D^  ; Q
 +179     ;;R^"860.8:",100,76
 +180     ;;D^  ; ;
 +181     ;;R^"860.8:",100,77
 +182     ;;D^  ; ;
 +183     ;;EOR^
 +184     ;;KEY^860.8:^RETURN POINTED TO VALUE
 +185     ;;R^"860.8:",.01,"E"
 +186     ;;D^RETURN POINTED TO VALUE
 +187     ;;R^"860.8:",.02,"E"
 +188     ;;D^POINTER
 +189     ;;R^"860.8:",1,1
 +190     ;;D^  ;POINTER(OCXFILE,D0) ;    This Local Extrinsic Function gets the
 value of the name field
 +191     ;;R^"860.8:",1,2
 +192     ;;D^  ; ;  of record D0 in file OCXFILE
 +193     ;;R^"860.8:",100,1
 +194     ;;D^  ;POINTER(OCXFILE,D0) ;    This Local Extrinsic Function gets the
 value of the name field
 +195     ;;R^"860.8:",100,2
 +196     ;;D^  ; ;  of record D0 in file OCXFILE
 +197     ;;R^"860.8:",100,3
 +198     ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20,"   FILE: ",$G(OCXFILE),"  D0: "
,$G(D0)
 +199     ;;R^"860.8:",100,4
 +200     ;;D^  ; Q:'$G(D0) "" Q:'$L($G(OCXFILE)) ""
 +201     ;;R^"860.8:",100,5
 +202     ;;D^  ; N GLREF
 +203     ;;R^"860.8:",100,6
 +204     ;;D^  ; I '(OCXFILE=(+OCXFILE)) S GLREF=U_OCXFILE
 +205     ;;R^"860.8:",100,7
 +206     ;;D^  ; E  S GLREF=$$FILE^OCXBDTD(+OCXFILE,"GLOBAL NAME") Q:'$L(GLREF)
 ""
 +207     ;;R^"860.8:",100,8
 +208     ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," GLREF: ",GLREF,"  RESOLVES TO:
 ",$P($G(@(GLREF_(+D0)_",0)")),U,1)
 +209     ;;R^"860.8:",100,9
 +210     ;;D^  ; Q $P($G(@(GLREF_(+D0)_",0)")),U,1)
 +211     ;;R^"860.8:",100,10
 +212     ;;D^  ; ;
 +213     ;;EOR^
 +214     ;;KEY^860.8:^STRING CONTAINS ONE OF A LIST OF VALUES
 +215     ;;R^"860.8:",.01,"E"
 +216     ;;D^STRING CONTAINS ONE OF A LIST OF VALUES
 +217     ;;R^"860.8:",.02,"E"
 +218     ;;D^CLIST
 +219     ;;R^"860.8:",100,1
 +220     ;;D^  ;CLIST(DATA,LIST) ;   DOES THE DATA FIELD CONTAIN AN ELEMENT IN 
THE LIST
 +221     ;;R^"860.8:",100,2
 +222     ;;D^  ; ;
 +223     ;;R^"860.8:",100,3
 +224     ;1;
 +225     ;


ORY42706 * *  243 Lines,  7632 Bytes, Checksum: B65663010
                                                  Jun 28, 2016@13:15:59 page 17
              120 bytes in comments
ORY42706 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install
           of OR*3*427) ;MAY 10,2016 at 13:31
         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
         ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
         ;
S        ;
         ;
         D DOT^ORY427ES
         ;
         ;
         K REMOTE,LOCAL,OPCODE,REF
         F LINE=1:1:500 S TEXT=$P($T(DATA+LINE),";",2,999) Q:TEXT  I $L(TEXT) D 
           Q:QUIT
         .S ^TMP("OCXRULE",$J,$O(^TMP("OCXRULE",$J,"A"),-1)+1)=TEXT
         ;
         G ^ORY42707
         ;
         Q
         ;
DATA     ;
         ;
         ;;D^LOCAL TERM LOOKUP
         ;;R^"860.8:",.02,"E"
         ;;D^TERMLKUP
         ;;R^"860.8:",1,1
         ;;D^ 
         ;;R^"860.8:",1,2
         ;;D^  This function allows a local site to define to Order Checking
         ;;R^"860.8:",1,3
         ;;D^ a term specific to that site. (ie. Lab Test Name, Radiology
         ;;R^"860.8:",1,4
         ;;D^ procedure name, etc.)
         ;;R^"860.8:",1,5
         ;;D^ 
         ;;R^"860.8:",100,1
         ;;D^  ;TERMLKUP(OCXTERM,OCXFILE) ;
         ;;R^"860.8:",100,2
         ;;D^  ; ;
         ;;R^"860.8:",100,3
         ;;D^  ; Q
         ;;R^"860.8:",100,4
         ;;D^  ; ;
         ;;EOR^
         ;;KEY^860.8:^NEW RULE MESSAGE
         ;;R^"860.8:",.01,"E"
         ;;D^NEW RULE MESSAGE
         ;;R^"860.8:",.02,"E"
         ;;D^NEWRULE
         ;;R^"860.8:",100,1
         ;;D^  ;NEWRULE(OCXDFN,OCXORD,OCXRUL,OCXREL,OCXNOTF,OCXMESS) ; Has this 
          rule already been triggered for this order number
         ;;R^"860.8:",100,2
         ;;D^  ; ;
         ;;R^"860.8:",100,3
         ;;D^L+; S OCXERR=$$TIMELOG("M","NEWRULE("_(+$G(OCXDFN))_","_(+$G(OCXORD
          ))_","_(+$G(OCXRUL))_","_(+$G(OCXREL))_","_(+$G(OCXNOTF))_","_$G(OCXME
          SS)_")")
         ;;R^"860.8:",100,4
         ;;D^  ; ;
         ;;R^"860.8:",100,5
         ;;D^  ; Q:'$G(OCXDFN) 0 Q:'$G(OCXRUL) 0
         ;;R^"860.8:",100,6
         ;;D^  ; Q:'$G(OCXREL) 0  Q:'$G(OCXNOTF) 0  Q:'$L($G(OCXMESS)) 0
         ;;R^"860.8:",100,7
         ;;D^  ; S OCXORD=+$G(OCXORD),OCXDFN=+OCXDFN
         ;;R^"860.8:",100,8
         ;;D^  ; ;
         ;;R^"860.8:",100,9
         ;;D^  ; N OCXNDX,OCXDATA,OCXDFI,OCXELE,OCXGR,OCXTIME,OCXCKSUM,OCXTSP,OC
          XTSPL
         ;;R^"860.8:",100,10
         ;;D^  ; ;
         ;;R^"860.8:",100,11
         ;;D^  ; S OCXTIME=(+$H)
         ;;R^"860.8:",100,12
         ;;D^  ; S OCXCKSUM=$$CKSUM(OCXMESS)
         ;;R^"860.8:",100,13
         ;;D^  ; ;
         ;;R^"860.8:",100,14
         ;;D^  ; S OCXTSP=($H*86400)+$P($H,",",2)
         ;;R^"860.8:",100,15
         ;;D^  ; S OCXTSPL=($G(^OCXD(860.7,"AT",OCXTIME,OCXDFN,OCXRUL,+OCXORD,OC
          XCKSUM))+$G(OCXTSPI,300))
         ;;R^"860.8:",100,16
         ;;D^  ; ;
         ;;R^"860.8:",100,17
         ;;D^  ; Q:(OCXTSPL>OCXTSP) 0
         ;;R^"860.8:",100,18
         ;;D^  ; ;
         ;;R^"860.8:",100,19
         ;;D^  ; K OCXDATA
         ;;R^"860.8:",100,20
         ;;D^  ; S OCXDATA(OCXDFN,0)=OCXDFN
         ;;R^"860.8:",100,21
         ;;D^  ; S OCXDATA("B",OCXDFN,OCXDFN)=""
         ;;R^"860.8:",100,22
         ;;D^  ; S OCXDATA("AT",OCXTIME,OCXDFN,OCXRUL,+OCXORD,OCXCKSUM)=OCXTSP
         ;;R^"860.8:",100,23
         ;;D^  ; ;
         ;;R^"860.8:",100,24
         ;;D^  ; S OCXGR="^OCXD(860.7"
         ;;R^"860.8:",100,25
         ;;D^T+; D SETAP(OCXGR_")",0,"Patient",$P($G(^DPT(OCXDFN,0)),U,1),.OCXDA
          TA,OCXDFN)
         ;;R^"860.8:",100,26
         ;;D^T-; D SETAP(OCXGR_")",0,.OCXDATA,OCXDFN)
         ;;R^"860.8:",100,27
         ;;D^  ; ;
         ;;R^"860.8:",100,28
         ;;D^  ; K OCXDATA
         ;;R^"860.8:",100,29
         ;;D^  ; S OCXDATA(OCXRUL,0)=OCXRUL_U_(OCXTIME)_U_(+OCXORD)
         ;;R^"860.8:",100,30
         ;;D^  ; S OCXDATA(OCXRUL,"M")=OCXMESS
         ;;R^"860.8:",100,31
         ;;D^  ; S OCXDATA("B",OCXRUL,OCXRUL)=""
         ;;R^"860.8:",100,32
         ;;D^  ; S OCXGR=OCXGR_","_OCXDFN_",1"
         ;;R^"860.8:",100,33
         ;;D^T+; D SETAP(OCXGR_")","860.71P","Rule",$P($G(^OCXS(860.2,OCXRUL,0))
          ,U,1),.OCXDATA,OCXRUL)
         ;;R^"860.8:",100,34
         ;;D^T-; D SETAP(OCXGR_")","860.71P",.OCXDATA,OCXRUL)
         ;;R^"860.8:",100,35
         ;;D^  ; ;
         ;;R^"860.8:",100,36
         ;;D^  ; K OCXDATA
         ;;R^"860.8:",100,37
         ;;D^  ; S OCXDATA(OCXREL,0)=OCXREL
         ;;R^"860.8:",100,38
         ;;D^  ; S OCXDATA("B",OCXREL,OCXREL)=""
         ;;R^"860.8:",100,39
         ;;D^  ; S OCXGR=OCXGR_","_OCXRUL_",1"
         ;;R^"860.8:",100,40
         ;;D^T+; D SETAP(OCXGR_")","860.712","Relation",OCXREL,.OCXDATA,OCXREL)
         ;;R^"860.8:",100,41
         ;;D^T-; D SETAP(OCXGR_")","860.712",.OCXDATA,OCXREL)
         ;;R^"860.8:",100,42
         ;;D^  ; ;
         ;;R^"860.8:",100,43
         ;;D^  ; S OCXELE=0 F  S OCXELE=$O(^OCXS(860.2,OCXRUL,"C","C",OCXELE)) Q
          :'OCXELE  D
         ;;R^"860.8:",100,44
         ;;D^  ; .;
         ;;R^"860.8:",100,45
         ;;D^  ; .N OCXGR1
         ;;R^"860.8:",100,46
         ;;D^  ; .S OCXGR1=OCXGR_","_OCXREL_",1"
         ;;R^"860.8:",100,47
         ;;D^  ; .K OCXDATA
         ;;R^"860.8:",100,48
         ;;D^  ; .S OCXDATA(OCXELE,0)=OCXELE
         ;;R^"860.8:",100,49
         ;;D^  ; .S OCXDATA(OCXELE,"TIME")=OCXTIME
         ;;R^"860.8:",100,50
         ;;D^  ; .S OCXDATA(OCXELE,"LOG")=$G(OCXOLOG)
         ;;R^"860.8:",100,51
         ;;D^  ; .S OCXDATA("B",OCXELE,OCXELE)=""
         ;;R^"860.8:",100,52
         ;;D^  ; .K ^OCXD(860.7,OCXDFN,1,OCXRUL,1,OCXREL,1,OCXELE)
         ;;R^"860.8:",100,53
         ;;D^T+; .D SETAP(OCXGR1_")","860.7122P","Element",$P($G(^OCXS(860.3,OCX
          ELE,0)),U,1),.OCXDATA,OCXELE)
         ;;R^"860.8:",100,54
         ;;D^T-; .D SETAP(OCXGR1_")","860.7122P",.OCXDATA,OCXELE)
         ;;R^"860.8:",100,55
         ;;D^  ; .;
         ;;R^"860.8:",100,56
         ;;D^  ; .S OCXDFI=0 F  S OCXDFI=$O(^TMP("OCXCHK",$J,OCXDFN,OCXELE,OCXDF
          I)) Q:'OCXDFI  D
         ;;R^"860.8:",100,57
         ;;D^  ; ..N OCXGR2
         ;;R^"860.8:",100,58
         ;;D^  ; ..S OCXGR2=OCXGR1_","_OCXELE_",1"
         ;;R^"860.8:",100,59
         ;;D^  ; ..K OCXDATA
         ;;R^"860.8:",100,60
         ;;D^  ; ..S OCXDATA(OCXDFI,0)=OCXDFI
         ;;R^"860.8:",100,61
         ;;D^  ; ..S OCXDATA(OCXDFI,"VAL")=^TMP("OCXCHK",$J,OCXDFN,OCXELE,OCXDFI
          )
         ;;R^"860.8:",100,62
         ;;D^  ; ..S OCXDATA("B",OCXDFI,OCXDFI)=""
         ;;R^"860.8:",100,63
         ;;D^T+; ..D SETAP(OCXGR2_")","860.71223P","Data Field",$P($G(^OCXS(860.
          4,OCXDFI,0)),U,1),.OCXDATA,OCXDFI)
         ;;R^"860.8:",100,64
         ;;D^T-; ..D SETAP(OCXGR2_")","860.71223P",.OCXDATA,OCXDFI)
         ;;R^"860.8:",100,65
         ;;D^  ; ;
         ;;R^"860.8:",100,66
         ;;D^  ; Q 1
         ;;R^"860.8:",100,67
         ;;D^  ; ;
         ;;R^"860.8:",100,68
         ;;D^T+;SETAP(ROOT,DD,ITEM,ITEMNAME,DATA,DA) ;  Set Rule Event data
         ;;R^"860.8:",100,69
         ;;D^T-;SETAP(ROOT,DD,DATA,DA) ;  Set Rule Event data
         ;;R^"860.8:",100,70
         ;;D^  ; M @ROOT=DATA
         ;;R^"860.8:",100,71
         ;;D^  ; I +$G(DD) S @ROOT@(0)="^"_($G(DD))_"^"_($P($G(@ROOT@(0)),U,3)+1
          )_"^"_$G(DA)
         ;;R^"860.8:",100,72
         ;;D^  ; I '$G(DD) S $P(@ROOT@(0),U,3,4)=($P($G(@ROOT@(0)),U,3)+1)_"^"_$
          G(DA)
         ;;R^"860.8:",100,73
         ;;D^T+; W:$G(OCXTRACE) !,"File Active Data ",$G(ITEM),": ",$G(ITEMNAME)
         ;;R^"860.8:",100,74
         ;;D^  ; ;
         ;;R^"860.8:",100,75
         ;;D^  ; Q
         ;;R^"860.8:",100,76
         ;;D^  ; ;
         ;;R^"860.8:",100,77
         ;;D^  ; ;
         ;;EOR^
         ;;KEY^860.8:^RETURN POINTED TO VALUE
         ;;R^"860.8:",.01,"E"
         ;;D^RETURN POINTED TO VALUE
         ;;R^"860.8:",.02,"E"
         ;;D^POINTER
         ;;R^"860.8:",1,1
         ;;D^  ;POINTER(OCXFILE,D0) ;    This Local Extrinsic Function gets the 
          value of the name field
         ;;R^"860.8:",1,2
         ;;D^  ; ;  of record D0 in file OCXFILE
         ;;R^"860.8:",100,1
         ;;D^  ;POINTER(OCXFILE,D0) ;    This Local Extrinsic Function gets the 
          value of the name field
         ;;R^"860.8:",100,2
         ;;D^  ; ;  of record D0 in file OCXFILE
         ;;R^"860.8:",100,3
         ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20,"   FILE: ",$G(OCXFILE),"  D0: ",
          $G(D0)
         ;;R^"860.8:",100,4
         ;;D^  ; Q:'$G(D0) "" Q:'$L($G(OCXFILE)) ""
         ;;R^"860.8:",100,5
         ;;D^  ; N GLREF
         ;;R^"860.8:",100,6
         ;;D^  ; I '(OCXFILE=(+OCXFILE)) S GLREF=U_OCXFILE
         ;;R^"860.8:",100,7
         ;;D^  ; E  S GLREF=$$FILE^OCXBDTD(+OCXFILE,"GLOBAL NAME") Q:'$L(GLREF) 
          ""
         ;;R^"860.8:",100,8
         ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," GLREF: ",GLREF,"  RESOLVES TO: 
          ",$P($G(@(GLREF_(+D0)_",0)")),U,1)
         ;;R^"860.8:",100,9
         ;;D^  ; Q $P($G(@(GLREF_(+D0)_",0)")),U,1)
         ;;R^"860.8:",100,10
         ;;D^  ; ;
         ;;EOR^
         ;;KEY^860.8:^STRING CONTAINS ONE OF A LIST OF VALUES
         ;;R^"860.8:",.01,"E"
         ;;D^STRING CONTAINS ONE OF A LIST OF VALUES
         ;;R^"860.8:",.02,"E"
         ;;D^CLIST
         ;;R^"860.8:",100,1
         ;;D^  ;CLIST(DATA,LIST) ;   DOES THE DATA FIELD CONTAIN AN ELEMENT IN T
          HE LIST
         ;;R^"860.8:",100,2
         ;;D^  ; ;
         ;;R^"860.8:",100,3
         ;1;
         ;

*****   INDEX OF ORY42706   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
>> LINE         S+6*
   LOCAL        S+5!
   OPCODE       S+5!
>> QUIT         S+6
   REF          S+5!
   REMOTE       S+5!
>> TEXT         S+6*,S+7

Global Variables  ( * Changed  ! Killed)
   ^TMP("OCXRULE"      S+7*

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   $T(DATA+LINE S+6

Label References
   NONE

External References
   ^ORY42707           S+9
   DOT^ORY427ES        S+2

*****   END   *****
ORY42707   7802     printed  Jun 28, 2016@13:15:59                     Page 18

ORY42707  ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Instal
l of OR*3*427) ;MAY 10,2016 at 13:31
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 +3       ;
S         ;
 +1       ;
 +2        DO DOT^ORY427ES
 +3       ;
 +4       ;
 +5        KILL REMOTE,LOCAL,OPCODE,REF
 +6        FOR LINE=1:1:500
               SET TEXT=$PIECE($TEXT(DATA+LINE),";",2,999)
               IF TEXT
                   QUIT 
               IF $LENGTH(TEXT)
                   Begin DoDot:1
 +7                    SET ^TMP("OCXRULE",$JOB,$ORDER(^TMP("OCXRULE",$JOB,"A"),-
1)+1)=TEXT
                   End DoDot:1
                   IF QUIT
                       QUIT 
 +8       ;
 +9        GOTO ^ORY42708
 +10      ;
 +11       QUIT 
 +12      ;
DATA      ;
 +1       ;
 +2       ;;D^T+; W:$G(OCXTRACE) !!,"$$CLIST(",DATA,",""",LIST,""")"
 +3       ;;R^"860.8:",100,4
 +4       ;;D^  ; N PC F PC=1:1:$L(LIST,","),0 I PC,$L($P(LIST,",",PC)),(DATA[$P
(LIST,",",PC)) Q
 +5       ;;R^"860.8:",100,5
 +6       ;;D^  ; Q ''PC
 +7       ;;EOR^
 +8       ;;EOF^OCXS(860.8)^1
 +9       ;;SOF^860.6  ORDER CHECK DATA CONTEXT
 +10      ;;KEY^860.6:^CPRS ORDER PRESCAN
 +11      ;;R^"860.6:",.01,"E"
 +12      ;;D^CPRS ORDER PRESCAN
 +13      ;;R^"860.6:",.02,"E"
 +14      ;;D^OEPS
 +15      ;;R^"860.6:",1,"E"
 +16      ;;D^DATA DRIVEN
 +17      ;;EOR^
 +18      ;;KEY^860.6:^CPRS ORDER PROTOCOL
 +19      ;;R^"860.6:",.01,"E"
 +20      ;;D^CPRS ORDER PROTOCOL
 +21      ;;R^"860.6:",.02,"E"
 +22      ;;D^OERR
 +23      ;;R^"860.6:",1,"E"
 +24      ;;D^DATA DRIVEN
 +25      ;;EOR^
 +26      ;;KEY^860.6:^DATABASE LOOKUP
 +27      ;;R^"860.6:",.01,"E"
 +28      ;;D^DATABASE LOOKUP
 +29      ;;R^"860.6:",.02,"E"
 +30      ;;D^DL
 +31      ;;R^"860.6:",1,"E"
 +32      ;;D^PACKAGE LOOKUP
 +33      ;;EOR^
 +34      ;;KEY^860.6:^GENERIC HL7 MESSAGE ARRAY
 +35      ;;R^"860.6:",.01,"E"
 +36      ;;D^GENERIC HL7 MESSAGE ARRAY
 +37      ;;R^"860.6:",.02,"E"
 +38      ;;D^HL7
 +39      ;;R^"860.6:",1,"E"
 +40      ;;D^DATA DRIVEN
 +41      ;;EOR^
 +42      ;;EOF^OCXS(860.6)^1
 +43      ;;SOF^860.5  ORDER CHECK DATA SOURCE
 +44      ;;KEY^860.5:^DATABASE LOOKUP
 +45      ;;R^"860.5:",.01,"E"
 +46      ;;D^DATABASE LOOKUP
 +47      ;;R^"860.5:",.02,"E"
 +48      ;;D^DATABASE LOOKUP
 +49      ;;EOR^
 +50      ;;KEY^860.5:^HL7 COMMON ORDER SEGMENT
 +51      ;;R^"860.5:",.01,"E"
 +52      ;;D^HL7 COMMON ORDER SEGMENT
 +53      ;;R^"860.5:",.02,"E"
 +54      ;;D^GENERIC HL7 MESSAGE ARRAY
 +55      ;;EOR^
 +56      ;;KEY^860.5:^HL7 PATIENT ID SEGMENT
 +57      ;;R^"860.5:",.01,"E"
 +58      ;;D^HL7 PATIENT ID SEGMENT
 +59      ;;R^"860.5:",.02,"E"
 +60      ;;D^GENERIC HL7 MESSAGE ARRAY
 +61      ;;EOR^
 +62      ;;KEY^860.5:^OERR ORDER EVENT FLAG PROTOCOL
 +63      ;;R^"860.5:",.01,"E"
 +64      ;;D^OERR ORDER EVENT FLAG PROTOCOL
 +65      ;;R^"860.5:",.02,"E"
 +66      ;;D^CPRS ORDER PROTOCOL
 +67      ;;EOR^
 +68      ;;KEY^860.5:^ORDER ENTRY ORDER PRESCAN
 +69      ;;R^"860.5:",.01,"E"
 +70      ;;D^ORDER ENTRY ORDER PRESCAN
 +71      ;;R^"860.5:",.02,"E"
 +72      ;;D^CPRS ORDER PRESCAN
 +73      ;;EOR^
 +74      ;;EOF^OCXS(860.5)^1
 +75      ;;SOF^860.4  ORDER CHECK DATA FIELD
 +76      ;;KEY^860.4:^CLOZAPINE ANC W/IN 7 FLAG
 +77      ;;R^"860.4:",.01,"E"
 +78      ;;D^CLOZAPINE ANC W/IN 7 FLAG
 +79      ;;R^"860.4:",1,"E"
 +80      ;;D^CLOZ ANC FLAG
 +81      ;;R^"860.4:",101,"E"
 +82      ;;D^BOOLEAN
 +83      ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.01,"E"
 +84      ;;D^DATABASE LOOKUP
 +85      ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.02,"E"
 +86      ;;D^DATABASE LOOKUP
 +87      ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",1,"E"
 +88      ;;D^PATIENT.CLOZ_ANC_W/IN_7_FLAG
 +89      ;;EOR^
 +90      ;;KEY^860.4:^CLOZAPINE ANC W/IN 7 RESULT
 +91      ;;R^"860.4:",.01,"E"
 +92      ;;D^CLOZAPINE ANC W/IN 7 RESULT
 +93      ;;R^"860.4:",1,"E"
 +94      ;;D^CLOZ ANC RSLT
 +95      ;;R^"860.4:",101,"E"
 +96      ;;D^NUMERIC
 +97      ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.01,"E"
 +98      ;;D^DATABASE LOOKUP
 +99      ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.02,"E"
 +100     ;;D^DATABASE LOOKUP
 +101     ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",1,"E"
 +102     ;;D^PATIENT.CLOZ_ANC_W/IN_7_RSLT
 +103     ;;EOR^
 +104     ;;KEY^860.4:^CLOZAPINE LAB RESULTS
 +105     ;;R^"860.4:",.01,"E"
 +106     ;;D^CLOZAPINE LAB RESULTS
 +107     ;;R^"860.4:",1,"E"
 +108     ;;D^CLOZ LAB RSLTS
 +109     ;;R^"860.4:",101,"E"
 +110     ;;D^FREE TEXT
 +111     ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.01,"E"
 +112     ;;D^DATABASE LOOKUP
 +113     ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.02,"E"
 +114     ;;D^DATABASE LOOKUP
 +115     ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",1,"E"
 +116     ;;D^PATIENT.CLOZ_LAB_RESULTS
 +117     ;;EOR^
 +118     ;;KEY^860.4:^CLOZAPINE MED
 +119     ;;R^"860.4:",.01,"E"
 +120     ;;D^CLOZAPINE MED
 +121     ;;R^"860.4:",1,"E"
 +122     ;;D^CLOZAPINE
 +123     ;;R^"860.4:",101,"E"
 +124     ;;D^BOOLEAN
 +125     ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.01,"E"
 +126     ;;D^DATABASE LOOKUP
 +127     ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.02,"E"
 +128     ;;D^DATABASE LOOKUP
 +129     ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",1,"E"
 +130     ;;D^PATIENT.CLOZAPINE MED
 +131     ;;EOR^
 +132     ;;KEY^860.4:^FILLER
 +133     ;;R^"860.4:",.01,"E"
 +134     ;;D^FILLER
 +135     ;;R^"860.4:",1,"E"
 +136     ;;D^FILL
 +137     ;;R^"860.4:",101,"E"
 +138     ;;D^FREE TEXT
 +139     ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",.01,"E"
 +140     ;;D^CPRS ORDER PRESCAN
 +141     ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",.02,"E"
 +142     ;;D^ORDER ENTRY ORDER PRESCAN
 +143     ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",1,"E"
 +144     ;;D^PATIENT.OPS_FILLER
 +145     ;;R^"860.4:","860.41:GENERIC HL7 MESSAGE ARRAY^860.6",.01,"E"
 +146     ;;D^GENERIC HL7 MESSAGE ARRAY
 +147     ;;R^"860.4:","860.41:GENERIC HL7 MESSAGE ARRAY^860.6",.02,"E"
 +148     ;;D^HL7 COMMON ORDER SEGMENT
 +149     ;;R^"860.4:","860.41:GENERIC HL7 MESSAGE ARRAY^860.6",1,"E"
 +150     ;;D^PATIENT.HL7_FILLER
 +151     ;;EOR^
 +152     ;;KEY^860.4:^ORDER MODE
 +153     ;;R^"860.4:",.01,"E"
 +154     ;;D^ORDER MODE
 +155     ;;R^"860.4:",101,"E"
 +156     ;;D^FREE TEXT
 +157     ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",.01,"E"
 +158     ;;D^CPRS ORDER PRESCAN
 +159     ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",.02,"E"
 +160     ;;D^ORDER ENTRY ORDER PRESCAN
 +161     ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",1,"E"
 +162     ;;D^PATIENT.OPS_ORD_MODE
 +163     ;;EOR^
 +164     ;;KEY^860.4:^PATIENT IEN
 +165     ;;R^"860.4:",.01,"E"
 +166     ;;D^PATIENT IEN
 +167     ;;R^"860.4:",101,"E"
 +168     ;;D^NUMERIC
 +169     ;;R^"860.4:","860.41:CPRS ORDER PROTOCOL^860.6",.01,"E"
 +170     ;;D^CPRS ORDER PROTOCOL
 +171     ;;R^"860.4:","860.41:CPRS ORDER PROTOCOL^860.6",.02,"E"
 +172     ;;D^OERR ORDER EVENT FLAG PROTOCOL
 +173     ;;R^"860.4:","860.41:CPRS ORDER PROTOCOL^860.6",1,"E"
 +174     ;;D^PATIENT.OERR_ORDER_PATIENT
 +175     ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.01,"E"
 +176     ;;D^DATABASE LOOKUP
 +177     ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.02,"E"
 +178     ;;D^DATABASE LOOKUP
 +179     ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",1,"E"
 +180     ;;D^PATIENT.IEN
 +181     ;;R^"860.4:","860.41:GENERIC HL7 MESSAGE ARRAY^860.6",.01,"E"
 +182     ;;D^GENERIC HL7 MESSAGE ARRAY
 +183     ;;R^"860.4:","860.41:GENERIC HL7 MESSAGE ARRAY^860.6",.02,"E"
 +184     ;;D^HL7 PATIENT ID SEGMENT
 +185     ;;R^"860.4:","860.41:GENERIC HL7 MESSAGE ARRAY^860.6",1,"E"
 +186     ;;D^PATIENT.HL7_PATIENT_ID
 +187     ;;EOR^
 +188     ;;KEY^860.4:^PHARMACY LOCAL ID
 +189     ;;R^"860.4:",.01,"E"
 +190     ;;D^PHARMACY LOCAL ID
 +191     ;;R^"860.4:",1,"E"
 +192     ;;D^DISP DRUG IEN
 +193     ;;R^"860.4:",101,"E"
 +194     ;;D^FREE TEXT
 +195     ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",.01,"E"
 +196     ;;D^CPRS ORDER PRESCAN
 +197     ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",.02,"E"
 +198     ;;D^ORDER ENTRY ORDER PRESCAN
 +199     ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",1,"E"
 +200     ;;D^PATIENT.OPS_DRUG_ID
 +201     ;;EOR^
 +202     ;;EOF^OCXS(860.4)^1
 +203     ;;SOF^860.3  ORDER CHECK ELEMENT
 +204     ;;KEY^860.3:^CLOZAPINE ANC < 1.0
 +205     ;;R^"860.3:",.01,"E"
 +206     ;;D^CLOZAPINE ANC < 1.0
 +207     ;;R^"860.3:",.02,"E"
 +208     ;;D^CPRS ORDER PRESCAN
 +209     ;;R^"860.3:","860.31:1",.01,"E"
 +210     ;;D^4
 +211     ;;R^"860.3:","860.31:1",1,"E"
 +212     ;;D^CLOZAPINE ANC W/IN 7 RESULT
 +213     ;;R^"860.3:","860.31:1",2,"E"
 +214     ;;D^LESS THAN
 +215     ;;R^"860.3:","860.31:1",3,"E"
 +216     ;;D^1.0
 +217     ;;R^"860.3:","860.31:2",.01,"E"
 +218     ;;D^5
 +219     ;;R^"860.3:","860.31:2",1,"E"
 +220     ;;D^CLOZAPINE ANC W/IN 7 FLAG
 +221     ;;R^"860.3:","860.31:2",2,"E"
 +222     ;;D^LOGICAL TRUE
 +223     ;;EOR^
 +224     ;;KEY^860.3:^CLOZAPINE ANC >= 1.0 & < 1.5
 +225     ;;R^"860.3:",.01,"E"
 +226     ;;D^CLOZAPINE ANC >= 1.0 & < 1.5
 +227     ;;R^"860.3:",.02,"E"
 +228     ;;D^CPRS ORDER PRESCAN
 +229     ;;R^"860.3:","860.31:1",.01,"E"
 +230     ;;D^1
 +231     ;;R^"860.3:","860.31:1",1,"E"
 +232     ;;D^CLOZAPINE ANC W/IN 7 RESULT
 +233     ;;R^"860.3:","860.31:1",2,"E"
 +234     ;;D^GREATER THAN
 +235     ;;R^"860.3:","860.31:1",3,"E"
 +236     ;;D^.999
 +237     ;;R^"860.3:","860.31:2",.01,"E"
 +238     ;;D^2
 +239     ;;R^"860.3:","860.31:2",1,"E"
 +240     ;;D^CLOZAPINE ANC W/IN 7 RESULT
 +241     ;;R^"860.3:","860.31:2",2,"E"
 +242     ;;D^LESS THAN
 +243     ;;R^"860.3:","860.31:2",3,"E"
 +244     ;;D^1.5
 +245     ;;R^"860.3:","860.31:3",.01,"E"
 +246     ;;D^3
 +247     ;;R^"860.3:","860.31:3",1,"E"
 +248     ;;D^CLOZAPINE ANC W/IN 7 FLAG
 +249     ;;R^"860.3:","860.31:3",2,"E"
 +250     ;;D^LOGICAL TRUE
 +251     ;;EOR^
 +252     ;;KEY^860.3:^CLOZAPINE DRUG SELECTED
 +253     ;;R^"860.3:",.01,"E"
 +254     ;;D^CLOZAPINE DRUG SELECTED
 +255     ;;R^"860.3:",.02,"E"
 +256     ;;D^CPRS ORDER PRESCAN
 +257     ;;R^"860.3:","860.31:1",.01,"E"
 +258     ;;D^1
 +259     ;;R^"860.3:","860.31:1",1,"E"
 +260     ;1;
 +261     ;


ORY42707 * *  279 Lines,  7802 Bytes, Checksum: B69514019
                                                  Jun 28, 2016@13:15:59 page 19
              120 bytes in comments
ORY42707 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install
           of OR*3*427) ;MAY 10,2016 at 13:31
         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
         ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
         ;
S        ;
         ;
         D DOT^ORY427ES
         ;
         ;
         K REMOTE,LOCAL,OPCODE,REF
         F LINE=1:1:500 S TEXT=$P($T(DATA+LINE),";",2,999) Q:TEXT  I $L(TEXT) D 
           Q:QUIT
         .S ^TMP("OCXRULE",$J,$O(^TMP("OCXRULE",$J,"A"),-1)+1)=TEXT
         ;
         G ^ORY42708
         ;
         Q
         ;
DATA     ;
         ;
         ;;D^T+; W:$G(OCXTRACE) !!,"$$CLIST(",DATA,",""",LIST,""")"
         ;;R^"860.8:",100,4
         ;;D^  ; N PC F PC=1:1:$L(LIST,","),0 I PC,$L($P(LIST,",",PC)),(DATA[$P(
          LIST,",",PC)) Q
         ;;R^"860.8:",100,5
         ;;D^  ; Q ''PC
         ;;EOR^
         ;;EOF^OCXS(860.8)^1
         ;;SOF^860.6  ORDER CHECK DATA CONTEXT
         ;;KEY^860.6:^CPRS ORDER PRESCAN
         ;;R^"860.6:",.01,"E"
         ;;D^CPRS ORDER PRESCAN
         ;;R^"860.6:",.02,"E"
         ;;D^OEPS
         ;;R^"860.6:",1,"E"
         ;;D^DATA DRIVEN
         ;;EOR^
         ;;KEY^860.6:^CPRS ORDER PROTOCOL
         ;;R^"860.6:",.01,"E"
         ;;D^CPRS ORDER PROTOCOL
         ;;R^"860.6:",.02,"E"
         ;;D^OERR
         ;;R^"860.6:",1,"E"
         ;;D^DATA DRIVEN
         ;;EOR^
         ;;KEY^860.6:^DATABASE LOOKUP
         ;;R^"860.6:",.01,"E"
         ;;D^DATABASE LOOKUP
         ;;R^"860.6:",.02,"E"
         ;;D^DL
         ;;R^"860.6:",1,"E"
         ;;D^PACKAGE LOOKUP
         ;;EOR^
         ;;KEY^860.6:^GENERIC HL7 MESSAGE ARRAY
         ;;R^"860.6:",.01,"E"
         ;;D^GENERIC HL7 MESSAGE ARRAY
         ;;R^"860.6:",.02,"E"
         ;;D^HL7
         ;;R^"860.6:",1,"E"
         ;;D^DATA DRIVEN
         ;;EOR^
         ;;EOF^OCXS(860.6)^1
         ;;SOF^860.5  ORDER CHECK DATA SOURCE
         ;;KEY^860.5:^DATABASE LOOKUP
         ;;R^"860.5:",.01,"E"
         ;;D^DATABASE LOOKUP
         ;;R^"860.5:",.02,"E"
         ;;D^DATABASE LOOKUP
         ;;EOR^
         ;;KEY^860.5:^HL7 COMMON ORDER SEGMENT
         ;;R^"860.5:",.01,"E"
         ;;D^HL7 COMMON ORDER SEGMENT
         ;;R^"860.5:",.02,"E"
         ;;D^GENERIC HL7 MESSAGE ARRAY
         ;;EOR^
         ;;KEY^860.5:^HL7 PATIENT ID SEGMENT
         ;;R^"860.5:",.01,"E"
         ;;D^HL7 PATIENT ID SEGMENT
         ;;R^"860.5:",.02,"E"
         ;;D^GENERIC HL7 MESSAGE ARRAY
         ;;EOR^
         ;;KEY^860.5:^OERR ORDER EVENT FLAG PROTOCOL
         ;;R^"860.5:",.01,"E"
         ;;D^OERR ORDER EVENT FLAG PROTOCOL
         ;;R^"860.5:",.02,"E"
         ;;D^CPRS ORDER PROTOCOL
         ;;EOR^
         ;;KEY^860.5:^ORDER ENTRY ORDER PRESCAN
         ;;R^"860.5:",.01,"E"
         ;;D^ORDER ENTRY ORDER PRESCAN
         ;;R^"860.5:",.02,"E"
         ;;D^CPRS ORDER PRESCAN
         ;;EOR^
         ;;EOF^OCXS(860.5)^1
         ;;SOF^860.4  ORDER CHECK DATA FIELD
         ;;KEY^860.4:^CLOZAPINE ANC W/IN 7 FLAG
         ;;R^"860.4:",.01,"E"
         ;;D^CLOZAPINE ANC W/IN 7 FLAG
         ;;R^"860.4:",1,"E"
         ;;D^CLOZ ANC FLAG
         ;;R^"860.4:",101,"E"
         ;;D^BOOLEAN
         ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.01,"E"
         ;;D^DATABASE LOOKUP
         ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.02,"E"
         ;;D^DATABASE LOOKUP
         ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",1,"E"
         ;;D^PATIENT.CLOZ_ANC_W/IN_7_FLAG
         ;;EOR^
         ;;KEY^860.4:^CLOZAPINE ANC W/IN 7 RESULT
         ;;R^"860.4:",.01,"E"
         ;;D^CLOZAPINE ANC W/IN 7 RESULT
         ;;R^"860.4:",1,"E"
         ;;D^CLOZ ANC RSLT
         ;;R^"860.4:",101,"E"
         ;;D^NUMERIC
         ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.01,"E"
         ;;D^DATABASE LOOKUP
         ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.02,"E"
         ;;D^DATABASE LOOKUP
         ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",1,"E"
         ;;D^PATIENT.CLOZ_ANC_W/IN_7_RSLT
         ;;EOR^
         ;;KEY^860.4:^CLOZAPINE LAB RESULTS
         ;;R^"860.4:",.01,"E"
         ;;D^CLOZAPINE LAB RESULTS
         ;;R^"860.4:",1,"E"
         ;;D^CLOZ LAB RSLTS
         ;;R^"860.4:",101,"E"
         ;;D^FREE TEXT
         ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.01,"E"
         ;;D^DATABASE LOOKUP
         ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.02,"E"
         ;;D^DATABASE LOOKUP
         ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",1,"E"
         ;;D^PATIENT.CLOZ_LAB_RESULTS
         ;;EOR^
         ;;KEY^860.4:^CLOZAPINE MED
         ;;R^"860.4:",.01,"E"
         ;;D^CLOZAPINE MED
         ;;R^"860.4:",1,"E"
         ;;D^CLOZAPINE
         ;;R^"860.4:",101,"E"
         ;;D^BOOLEAN
         ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.01,"E"
         ;;D^DATABASE LOOKUP
         ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.02,"E"
         ;;D^DATABASE LOOKUP
         ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",1,"E"
         ;;D^PATIENT.CLOZAPINE MED
         ;;EOR^
         ;;KEY^860.4:^FILLER
         ;;R^"860.4:",.01,"E"
         ;;D^FILLER
         ;;R^"860.4:",1,"E"
         ;;D^FILL
         ;;R^"860.4:",101,"E"
         ;;D^FREE TEXT
         ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",.01,"E"
         ;;D^CPRS ORDER PRESCAN
         ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",.02,"E"
         ;;D^ORDER ENTRY ORDER PRESCAN
         ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",1,"E"
         ;;D^PATIENT.OPS_FILLER
         ;;R^"860.4:","860.41:GENERIC HL7 MESSAGE ARRAY^860.6",.01,"E"
         ;;D^GENERIC HL7 MESSAGE ARRAY
         ;;R^"860.4:","860.41:GENERIC HL7 MESSAGE ARRAY^860.6",.02,"E"
         ;;D^HL7 COMMON ORDER SEGMENT
         ;;R^"860.4:","860.41:GENERIC HL7 MESSAGE ARRAY^860.6",1,"E"
         ;;D^PATIENT.HL7_FILLER
         ;;EOR^
         ;;KEY^860.4:^ORDER MODE
         ;;R^"860.4:",.01,"E"
         ;;D^ORDER MODE
         ;;R^"860.4:",101,"E"
         ;;D^FREE TEXT
         ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",.01,"E"
         ;;D^CPRS ORDER PRESCAN
         ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",.02,"E"
         ;;D^ORDER ENTRY ORDER PRESCAN
         ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",1,"E"
         ;;D^PATIENT.OPS_ORD_MODE
         ;;EOR^
         ;;KEY^860.4:^PATIENT IEN
         ;;R^"860.4:",.01,"E"
         ;;D^PATIENT IEN
         ;;R^"860.4:",101,"E"
         ;;D^NUMERIC
         ;;R^"860.4:","860.41:CPRS ORDER PROTOCOL^860.6",.01,"E"
         ;;D^CPRS ORDER PROTOCOL
         ;;R^"860.4:","860.41:CPRS ORDER PROTOCOL^860.6",.02,"E"
         ;;D^OERR ORDER EVENT FLAG PROTOCOL
         ;;R^"860.4:","860.41:CPRS ORDER PROTOCOL^860.6",1,"E"
         ;;D^PATIENT.OERR_ORDER_PATIENT
         ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.01,"E"
         ;;D^DATABASE LOOKUP
         ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",.02,"E"
         ;;D^DATABASE LOOKUP
         ;;R^"860.4:","860.41:DATABASE LOOKUP^860.6",1,"E"
         ;;D^PATIENT.IEN
         ;;R^"860.4:","860.41:GENERIC HL7 MESSAGE ARRAY^860.6",.01,"E"
         ;;D^GENERIC HL7 MESSAGE ARRAY
         ;;R^"860.4:","860.41:GENERIC HL7 MESSAGE ARRAY^860.6",.02,"E"
         ;;D^HL7 PATIENT ID SEGMENT
         ;;R^"860.4:","860.41:GENERIC HL7 MESSAGE ARRAY^860.6",1,"E"
         ;;D^PATIENT.HL7_PATIENT_ID
         ;;EOR^
         ;;KEY^860.4:^PHARMACY LOCAL ID
         ;;R^"860.4:",.01,"E"
         ;;D^PHARMACY LOCAL ID
         ;;R^"860.4:",1,"E"
         ;;D^DISP DRUG IEN
         ;;R^"860.4:",101,"E"
         ;;D^FREE TEXT
         ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",.01,"E"
         ;;D^CPRS ORDER PRESCAN
         ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",.02,"E"
         ;;D^ORDER ENTRY ORDER PRESCAN
         ;;R^"860.4:","860.41:CPRS ORDER PRESCAN^860.6",1,"E"
         ;;D^PATIENT.OPS_DRUG_ID
         ;;EOR^
         ;;EOF^OCXS(860.4)^1
         ;;SOF^860.3  ORDER CHECK ELEMENT
         ;;KEY^860.3:^CLOZAPINE ANC < 1.0
         ;;R^"860.3:",.01,"E"
         ;;D^CLOZAPINE ANC < 1.0
         ;;R^"860.3:",.02,"E"
         ;;D^CPRS ORDER PRESCAN
         ;;R^"860.3:","860.31:1",.01,"E"
         ;;D^4
         ;;R^"860.3:","860.31:1",1,"E"
         ;;D^CLOZAPINE ANC W/IN 7 RESULT
         ;;R^"860.3:","860.31:1",2,"E"
         ;;D^LESS THAN
         ;;R^"860.3:","860.31:1",3,"E"
         ;;D^1.0
         ;;R^"860.3:","860.31:2",.01,"E"
         ;;D^5
         ;;R^"860.3:","860.31:2",1,"E"
         ;;D^CLOZAPINE ANC W/IN 7 FLAG
         ;;R^"860.3:","860.31:2",2,"E"
         ;;D^LOGICAL TRUE
         ;;EOR^
         ;;KEY^860.3:^CLOZAPINE ANC >= 1.0 & < 1.5
         ;;R^"860.3:",.01,"E"
         ;;D^CLOZAPINE ANC >= 1.0 & < 1.5
         ;;R^"860.3:",.02,"E"
         ;;D^CPRS ORDER PRESCAN
         ;;R^"860.3:","860.31:1",.01,"E"
         ;;D^1
         ;;R^"860.3:","860.31:1",1,"E"
         ;;D^CLOZAPINE ANC W/IN 7 RESULT
         ;;R^"860.3:","860.31:1",2,"E"
         ;;D^GREATER THAN
         ;;R^"860.3:","860.31:1",3,"E"
         ;;D^.999
         ;;R^"860.3:","860.31:2",.01,"E"
         ;;D^2
         ;;R^"860.3:","860.31:2",1,"E"
         ;;D^CLOZAPINE ANC W/IN 7 RESULT
         ;;R^"860.3:","860.31:2",2,"E"
         ;;D^LESS THAN
         ;;R^"860.3:","860.31:2",3,"E"
         ;;D^1.5
         ;;R^"860.3:","860.31:3",.01,"E"
         ;;D^3
         ;;R^"860.3:","860.31:3",1,"E"
         ;;D^CLOZAPINE ANC W/IN 7 FLAG
         ;;R^"860.3:","860.31:3",2,"E"
         ;;D^LOGICAL TRUE
         ;;EOR^
         ;;KEY^860.3:^CLOZAPINE DRUG SELECTED
         ;;R^"860.3:",.01,"E"
         ;;D^CLOZAPINE DRUG SELECTED
         ;;R^"860.3:",.02,"E"
         ;;D^CPRS ORDER PRESCAN
         ;;R^"860.3:","860.31:1",.01,"E"
         ;;D^1
         ;;R^"860.3:","860.31:1",1,"E"
         ;1;
         ;

*****   INDEX OF ORY42707   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
>> LINE         S+6*
   LOCAL        S+5!
   OPCODE       S+5!
>> QUIT         S+6
   REF          S+5!
   REMOTE       S+5!
>> TEXT         S+6*,S+7

Global Variables  ( * Changed  ! Killed)
   ^TMP("OCXRULE"      S+7*

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   $T(DATA+LINE S+6

Label References
   NONE

External References
   ^ORY42708           S+9
   DOT^ORY427ES        S+2

*****   END   *****
ORY42708   3287     printed  Jun 28, 2016@13:15:59                     Page 20

ORY42708  ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Instal
l of OR*3*427) ;MAY 10,2016 at 13:31
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 +3       ;
S         ;
 +1       ;
 +2        DO DOT^ORY427ES
 +3       ;
 +4       ;
 +5        KILL REMOTE,LOCAL,OPCODE,REF
 +6        FOR LINE=1:1:500
               SET TEXT=$PIECE($TEXT(DATA+LINE),";",2,999)
               IF TEXT
                   QUIT 
               IF $LENGTH(TEXT)
                   Begin DoDot:1
 +7                    SET ^TMP("OCXRULE",$JOB,$ORDER(^TMP("OCXRULE",$JOB,"A"),-
1)+1)=TEXT
                   End DoDot:1
                   IF QUIT
                       QUIT 
 +8       ;
 +9       ;
 +10      ;
 +11       QUIT 
 +12      ;
DATA      ;
 +1       ;
 +2       ;;D^ORDER MODE
 +3       ;;R^"860.3:","860.31:1",2,"E"
 +4       ;;D^EQ FREE TEXT
 +5       ;;R^"860.3:","860.31:1",3,"E"
 +6       ;;D^SELECT
 +7       ;;R^"860.3:","860.31:2",.01,"E"
 +8       ;;D^2
 +9       ;;R^"860.3:","860.31:2",1,"E"
 +10      ;;D^FILLER
 +11      ;;R^"860.3:","860.31:2",2,"E"
 +12      ;;D^STARTS WITH
 +13      ;;R^"860.3:","860.31:2",3,"E"
 +14      ;;D^PS
 +15      ;;R^"860.3:","860.31:5",.01,"E"
 +16      ;;D^5
 +17      ;;R^"860.3:","860.31:5",1,"E"
 +18      ;;D^CLOZAPINE MED
 +19      ;;R^"860.3:","860.31:5",2,"E"
 +20      ;;D^LOGICAL TRUE
 +21      ;;EOR^
 +22      ;;KEY^860.3:^CLOZAPINE NO ANC W/IN 7 DAYS
 +23      ;;R^"860.3:",.01,"E"
 +24      ;;D^CLOZAPINE NO ANC W/IN 7 DAYS
 +25      ;;R^"860.3:",.02,"E"
 +26      ;;D^CPRS ORDER PRESCAN
 +27      ;;R^"860.3:","860.31:6",.01,"E"
 +28      ;;D^6
 +29      ;;R^"860.3:","860.31:6",1,"E"
 +30      ;;D^CLOZAPINE ANC W/IN 7 FLAG
 +31      ;;R^"860.3:","860.31:6",2,"E"
 +32      ;;D^LOGICAL FALSE
 +33      ;;EOR^
 +34      ;;EOF^OCXS(860.3)^1
 +35      ;;SOF^860.2  ORDER CHECK RULE
 +36      ;;KEY^860.2:^CLOZAPINE
 +37      ;;R^"860.2:",.01,"E"
 +38      ;;D^CLOZAPINE
 +39      ;;R^"860.2:","860.21:10",.01,"E"
 +40      ;;D^1.0 >= ANC < 1.5
 +41      ;;R^"860.2:","860.21:10",.02,"E"
 +42      ;;D^SIMPLE DEFINITION
 +43      ;;R^"860.2:","860.21:10",1,"E"
 +44      ;;D^CLOZAPINE ANC >= 1.0 & < 1.5
 +45      ;;R^"860.2:","860.21:4",.01,"E"
 +46      ;;D^ANC < 1.0
 +47      ;;R^"860.2:","860.21:4",.02,"E"
 +48      ;;D^SIMPLE DEFINITION
 +49      ;;R^"860.2:","860.21:4",1,"E"
 +50      ;;D^CLOZAPINE ANC < 1.0
 +51      ;;R^"860.2:","860.21:6",.01,"E"
 +52      ;;D^NO ANC W/IN 7 DAYS
 +53      ;;R^"860.2:","860.21:6",.02,"E"
 +54      ;;D^SIMPLE DEFINITION
 +55      ;;R^"860.2:","860.21:6",1,"E"
 +56      ;;D^CLOZAPINE NO ANC W/IN 7 DAYS
 +57      ;;R^"860.2:","860.21:7",.01,"E"
 +58      ;;D^CLOZAPINE
 +59      ;;R^"860.2:","860.21:7",.02,"E"
 +60      ;;D^SIMPLE DEFINITION
 +61      ;;R^"860.2:","860.21:7",1,"E"
 +62      ;;D^CLOZAPINE DRUG SELECTED
 +63      ;;R^"860.2:","860.22:1",.01,"E"
 +64      ;;D^1
 +65      ;;R^"860.2:","860.22:1",1,"E"
 +66      ;;D^CLOZAPINE AND (NO ANC W/IN 7 DAYS)
 +67      ;;R^"860.2:","860.22:1",2,"E"
 +68      ;;D^CLOZAPINE APPROPRIATENESS
 +69      ;;R^"860.2:","860.22:1",6,"E"
 +70      ;;D^Clozapine orders require a CBC/Diff within past 7 days.  Please or
der CBC/Diff with WBC and ANC immediately.  Most recent results - |CLOZ LAB RSLT
S|
 +71      ;;R^"860.2:","860.22:2",.01,"E"
 +72      ;;D^2
 +73      ;;R^"860.2:","860.22:2",1,"E"
 +74      ;;D^CLOZAPINE AND ANC < 1.0
 +75      ;;R^"860.2:","860.22:2",2,"E"
 +76      ;;D^CLOZAPINE APPROPRIATENESS
 +77      ;;R^"860.2:","860.22:2",6,"E"
 +78      ;;D^Moderate/Severe Neutropenia - please repeat CBC/Diff including WBC
 and ANC tests immediately and Daily until ANC stabilizes to greater than or equ
al to 1000. Most recent results - |CLOZ LAB RSLTS|
 +79      ;;R^"860.2:","860.22:3",.01,"E"
 +80      ;;D^3
 +81      ;;R^"860.2:","860.22:3",1,"E"
 +82      ;;D^CLOZAPINE AND (1.0 >= ANC < 1.5)
 +83      ;;R^"860.2:","860.22:3",2,"E"
 +84      ;;D^CLOZAPINE APPROPRIATENESS
 +85      ;;R^"860.2:","860.22:3",6,"E"
 +86      ;;D^ Mild Neutropenia - please repeat CBC/Diff including WBC and ANC t
ests immediately and 3X weekly until ANC stabilizes to greater than or equal to 
1500. Most recent results - |CLOZ LAB RSLTS|
 +87      ;;EOR^
 +88      ;;EOF^OCXS(860.2)^1
 +89      ;1;
 +90      ;


ORY42708 * *  108 Lines,  3287 Bytes, Checksum: B18751543
                                                  Jun 28, 2016@13:15:59 page 21
              121 bytes in comments
ORY42708 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install
           of OR*3*427) ;MAY 10,2016 at 13:31
         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
         ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
         ;
S        ;
         ;
         D DOT^ORY427ES
         ;
         ;
         K REMOTE,LOCAL,OPCODE,REF
         F LINE=1:1:500 S TEXT=$P($T(DATA+LINE),";",2,999) Q:TEXT  I $L(TEXT) D 
           Q:QUIT
         .S ^TMP("OCXRULE",$J,$O(^TMP("OCXRULE",$J,"A"),-1)+1)=TEXT
         ;
         ;
         ;
         Q
         ;
DATA     ;
         ;
         ;;D^ORDER MODE
         ;;R^"860.3:","860.31:1",2,"E"
         ;;D^EQ FREE TEXT
         ;;R^"860.3:","860.31:1",3,"E"
         ;;D^SELECT
         ;;R^"860.3:","860.31:2",.01,"E"
         ;;D^2
         ;;R^"860.3:","860.31:2",1,"E"
         ;;D^FILLER
         ;;R^"860.3:","860.31:2",2,"E"
         ;;D^STARTS WITH
         ;;R^"860.3:","860.31:2",3,"E"
         ;;D^PS
         ;;R^"860.3:","860.31:5",.01,"E"
         ;;D^5
         ;;R^"860.3:","860.31:5",1,"E"
         ;;D^CLOZAPINE MED
         ;;R^"860.3:","860.31:5",2,"E"
         ;;D^LOGICAL TRUE
         ;;EOR^
         ;;KEY^860.3:^CLOZAPINE NO ANC W/IN 7 DAYS
         ;;R^"860.3:",.01,"E"
         ;;D^CLOZAPINE NO ANC W/IN 7 DAYS
         ;;R^"860.3:",.02,"E"
         ;;D^CPRS ORDER PRESCAN
         ;;R^"860.3:","860.31:6",.01,"E"
         ;;D^6
         ;;R^"860.3:","860.31:6",1,"E"
         ;;D^CLOZAPINE ANC W/IN 7 FLAG
         ;;R^"860.3:","860.31:6",2,"E"
         ;;D^LOGICAL FALSE
         ;;EOR^
         ;;EOF^OCXS(860.3)^1
         ;;SOF^860.2  ORDER CHECK RULE
         ;;KEY^860.2:^CLOZAPINE
         ;;R^"860.2:",.01,"E"
         ;;D^CLOZAPINE
         ;;R^"860.2:","860.21:10",.01,"E"
         ;;D^1.0 >= ANC < 1.5
         ;;R^"860.2:","860.21:10",.02,"E"
         ;;D^SIMPLE DEFINITION
         ;;R^"860.2:","860.21:10",1,"E"
         ;;D^CLOZAPINE ANC >= 1.0 & < 1.5
         ;;R^"860.2:","860.21:4",.01,"E"
         ;;D^ANC < 1.0
         ;;R^"860.2:","860.21:4",.02,"E"
         ;;D^SIMPLE DEFINITION
         ;;R^"860.2:","860.21:4",1,"E"
         ;;D^CLOZAPINE ANC < 1.0
         ;;R^"860.2:","860.21:6",.01,"E"
         ;;D^NO ANC W/IN 7 DAYS
         ;;R^"860.2:","860.21:6",.02,"E"
         ;;D^SIMPLE DEFINITION
         ;;R^"860.2:","860.21:6",1,"E"
         ;;D^CLOZAPINE NO ANC W/IN 7 DAYS
         ;;R^"860.2:","860.21:7",.01,"E"
         ;;D^CLOZAPINE
         ;;R^"860.2:","860.21:7",.02,"E"
         ;;D^SIMPLE DEFINITION
         ;;R^"860.2:","860.21:7",1,"E"
         ;;D^CLOZAPINE DRUG SELECTED
         ;;R^"860.2:","860.22:1",.01,"E"
         ;;D^1
         ;;R^"860.2:","860.22:1",1,"E"
         ;;D^CLOZAPINE AND (NO ANC W/IN 7 DAYS)
         ;;R^"860.2:","860.22:1",2,"E"
         ;;D^CLOZAPINE APPROPRIATENESS
         ;;R^"860.2:","860.22:1",6,"E"
         ;;D^Clozapine orders require a CBC/Diff within past 7 days.  Please ord
          er CBC/Diff with WBC and ANC immediately.  Most recent results - |CLOZ
           LAB RSLTS|
         ;;R^"860.2:","860.22:2",.01,"E"
         ;;D^2
         ;;R^"860.2:","860.22:2",1,"E"
         ;;D^CLOZAPINE AND ANC < 1.0
         ;;R^"860.2:","860.22:2",2,"E"
         ;;D^CLOZAPINE APPROPRIATENESS
         ;;R^"860.2:","860.22:2",6,"E"
         ;;D^Moderate/Severe Neutropenia - please repeat CBC/Diff including WBC 
          and ANC tests immediately and Daily until ANC stabilizes to greater th
          an or equal to 1000. Most recent results - |CLOZ LAB RSLTS|
         ;;R^"860.2:","860.22:3",.01,"E"
         ;;D^3
         ;;R^"860.2:","860.22:3",1,"E"
         ;;D^CLOZAPINE AND (1.0 >= ANC < 1.5)
         ;;R^"860.2:","860.22:3",2,"E"
         ;;D^CLOZAPINE APPROPRIATENESS
         ;;R^"860.2:","860.22:3",6,"E"
         ;;D^ Mild Neutropenia - please repeat CBC/Diff including WBC and ANC te
          sts immediately and 3X weekly until ANC stabilizes to greater than or 
          equal to 1500. Most recent results - |CLOZ LAB RSLTS|
         ;;EOR^
         ;;EOF^OCXS(860.2)^1
         ;1;
         ;

*****   INDEX OF ORY42708   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
>> LINE         S+6*
   LOCAL        S+5!
   OPCODE       S+5!
>> QUIT         S+6
   REF          S+5!
   REMOTE       S+5!
>> TEXT         S+6*,S+7

Global Variables  ( * Changed  ! Killed)
   ^TMP("OCXRULE"      S+7*

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   $T(DATA+LINE S+6

Label References
   NONE

External References
   DOT^ORY427ES        S+2

*****   END   *****
ORY4271   6010     printed  Jun 28, 2016@13:15:59                      Page 22

ORY4271   ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Instal
l of OR*3*427) ;MAY 10,2016 at 13:31
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 +3       ;
S         ;
 +1       ;
 +2        QUIT 
 +3       ;
 +4       ;
COMPARE(L,R) ;
 +1       ;
 +2        IF $$RES("R")
               QUIT 1
 +3       ;
 +4        IF '$LENGTH($ORDER(L("")))
               QUIT $$ADDREC^ORY4272("R")
 +5       ;
 +6        NEW C,OCXDD
           MERGE C=L,C=R
           SET OCXDD=$ORDER(C(""))
           QUIT $$MULT("C",OCXDD)
 +7       ;
 +8        QUIT 0
 +9       ;
RES(REF)  ;
 +1       ;
 +2        NEW QUIT,SUB
 +3        SET QUIT=0
 +4        SET SUB=""
           FOR 
               SET SUB=$ORDER(@REF@(SUB))
               IF '$LENGTH(SUB)
                   QUIT 
               IF (SUB[":")
                   Begin DoDot:1
 +5                    NEW DD,DA
 +6                    SET DD=$PIECE(SUB,":",1)
                       SET DA=$PIECE(SUB,":",2)
 +7                    IF $LENGTH(DA)
                           IF '(DA=+DA)
                               Begin DoDot:2
 +8                                NEW DANEW,SUBNEW
 +9                                SET DANEW=$ORDER(^OCXS($PIECE(DA,U,2),"B",$PI
ECE(DA,U,1),0))
 +10                               IF 'DANEW
                                       WRITE !!,$PIECE($GET(^OCXS(+$PIECE(DA,U,2
),0)),U,1),": ",$PIECE(DA,U,1),"  could not resolve name.",!!,"    End Transport
."
                                       SET QUIT=1
                                       QUIT 
 +11                               SET SUBNEW=DD_":"_DANEW
 +12                               IF $DATA(@REF@(SUBNEW))
                                       WRITE !!," multiple #",DANEW," already ex
isted."
                                       SET QUIT=1
                                       QUIT 
 +13                               MERGE @REF@(SUBNEW)=@REF@(SUB)
 +14                               KILL @REF@(SUB)
 +15                               SET SUB=""
                               End DoDot:2
                               IF QUIT
                                   QUIT 
 +16                   IF $LENGTH(SUB)
                           IF ($DATA(@REF@(SUB))>9)
                               SET QUIT=$$RES($NAME(@REF@(SUB)))
                   End DoDot:1
                   IF QUIT
                       QUIT 
 +17      ;
 +18       QUIT QUIT
 +19      ;
MULT(CREF,OCXDD) ;
 +1       ;
 +2        NEW OCXSUB,LREF,RREF,QUIT,OCXFLD
 +3        SET LREF="L"_$EXTRACT(CREF,2,$LENGTH(CREF))
           SET RREF="R"_$EXTRACT(CREF,2,$LENGTH(CREF))
 +4       ;
 +5        SET QUIT=0
           SET OCXFLD=""
           FOR 
               SET OCXFLD=$ORDER(@CREF@(OCXDD,OCXFLD))
               IF '$LENGTH(OCXFLD)
                   QUIT 
               Begin DoDot:1
 +6                IF (OCXFLD[":")
                       Begin DoDot:2
 +7                        IF $$EXFLD(+OCXFLD,0)
                               QUIT 
 +8                        IF '$DATA(@LREF@(OCXDD,OCXFLD,.01,"E"))
                               Begin DoDot:3
 +9                                DO WARN("Missing multiple:",CREF,OCXDD,OCXFLD
)
 +10                               SET QUIT=$$ADDMULT^ORY4273(CREF,OCXDD,OCXFLD)
                               End DoDot:3
                               MERGE @LREF@(OCXDD,OCXFLD)=@RREF@(OCXDD,OCXFLD)
 +11                       IF '$DATA(@RREF@(OCXDD,OCXFLD,.01,"E"))
                               Begin DoDot:3
 +12                               DO WARN("Extra multiple:",CREF,OCXDD,OCXFLD)
 +13                               SET QUIT=$$DELMULT^ORY4273($$APPEND(CREF,OCXD
D),OCXFLD)
                               End DoDot:3
                               MERGE @RREF@(OCXDD,OCXFLD)=@LREF@(OCXDD,OCXFLD)
                       End DoDot:2
                       IF QUIT
                           QUIT 
 +14      ;
 +15               IF (OCXFLD=+OCXFLD)
                       IF '$$EXFLD(+OCXDD,OCXFLD)
                           Begin DoDot:2
 +16                           IF ($ORDER(@CREF@(OCXDD,OCXFLD,""))="E")
                                   Begin DoDot:3
 +17                                   IF $LENGTH($GET(@RREF@(OCXDD,OCXFLD,"E"))
)
                                           IF '$LENGTH($GET(@LREF@(OCXDD,OCXFLD,
"E")))
                                               Begin DoDot:4
 +18                                               DO WARN("Data Value Missing i
n "_$$NETNAME^OCXSEND,CREF,OCXDD,OCXFLD,"E")
 +19                                               SET QUIT=$$EDITFLD^ORY4274(CR
EF,OCXDD,OCXFLD,"E")
                                               End DoDot:4
                                               QUIT 
 +20                                   IF $LENGTH($GET(@LREF@(OCXDD,OCXFLD,"E"))
)
                                           IF '$LENGTH($GET(@RREF@(OCXDD,OCXFLD,
"E")))
                                               Begin DoDot:4
 +21                                               DO WARN("Extra Data Value in 
"_$$NETNAME^OCXSEND,CREF,OCXDD,OCXFLD,"E")
 +22                                               SET QUIT=$$DELFLD^ORY4274(CRE
F,OCXDD,OCXFLD,"E")
                                               End DoDot:4
                                               QUIT 
 +23                                   IF '(@LREF@(OCXDD,OCXFLD,"E")=@RREF@(OCXD
D,OCXFLD,"E"))
                                           Begin DoDot:4
 +24                                           DO WARN("Inconsistent Data",CREF,
OCXDD,OCXFLD,"E")
 +25                                           SET QUIT=$$EDITFLD^ORY4274(CREF,O
CXDD,OCXFLD,"E")
                                           End DoDot:4
                                   End DoDot:3
                                   QUIT 
 +26                           SET OCXSUB=0
                               FOR 
                                   IF QUIT
                                       QUIT 
                                   SET OCXSUB=$ORDER(@CREF@(OCXDD,OCXFLD,OCXSUB)
)
                                   IF 'OCXSUB
                                       QUIT 
                                   IF '($GET(@RREF@(OCXDD,OCXFLD,OCXSUB))=$GET(@
LREF@(OCXDD,OCXFLD,OCXSUB)))
                                       Begin DoDot:3
 +27                                       DO WARN("Inconsistent word Data",CREF
,OCXDD,OCXFLD,OCXSUB)
 +28                                       SET QUIT=$$LOADWORD^ORY4272(RREF,OCXD
D,OCXFLD,OCXSUB)
                                       End DoDot:3
                                       QUIT 
                           End DoDot:2
 +29      ;
 +30               IF 'QUIT
                       IF (OCXFLD[":")
                           SET QUIT=$$MULT($$APPEND(CREF,OCXDD),OCXFLD)
               End DoDot:1
               IF QUIT
                   QUIT 
 +31       QUIT QUIT
 +32      ;
APPEND(ARRAY,OCXSUB) ;
 +1        IF '(OCXSUB=+OCXSUB)
               SET OCXSUB=""""_OCXSUB_""""
 +2        IF '(ARRAY["(")
               QUIT ARRAY_"("_OCXSUB_")"
 +3        QUIT $EXTRACT(ARRAY,1,$LENGTH(ARRAY)-1)_","_OCXSUB_")"
 +4       ;
EXFLD(FILE,OCXFLD) ;
 +1        NEW OCXFNAM
 +2        SET OCXFNAM=$$FIELD^OCXSENDD(FILE,OCXFLD,"LABEL")
 +3        IF (OCXFNAM["UNIQUE OBJECT IDENTIFIER")
               QUIT 1
 +4        IF (FILE=860.2)
               IF (OCXFLD=.02)
                   QUIT 1
 +5        IF (FILE=860.22)
               IF (OCXFLD=4)
                   QUIT 1
 +6        IF (FILE=860.3)
               IF (OCXFLD=3)
                   QUIT 1
 +7        IF (FILE=860.9)
               IF (OCXFLD=1)
                   QUIT 1
 +8        IF (FILE=860.91)
               QUIT 1
 +9        IF (FILE=860.801)
               QUIT 1
 +10       IF (FILE=860.81)
               QUIT 1
 +11       IF (FILE=861.01)
               QUIT 1
 +12       IF (FILE=863.02)
               QUIT 1
 +13       IF (FILE=863.54)
               QUIT 1
 +14       IF (FILE=863.61)
               QUIT 1
 +15       IF (FILE=863.72)
               QUIT 1
 +16       IF (FILE=863.81)
               QUIT 1
 +17       IF ($EXTRACT(OCXFNAM,1)="*")
               QUIT 1
 +18       QUIT 0
 +19      ;
WARN(MSG,CREF,OCXDD,OCXFLD,OCXSUB) ;
 +1       ;
 +2        IF $GET(OCXAUTO)
               QUIT 
 +3       ;
 +4        NEW D0,DASH,OCXDDPTH,OCXDPTR,FILE,FILEID,LREF,OCXPTR,RREF
 +5       ;
 +6        SET DASH=""
           SET $PIECE(DASH,"-",(55-$LENGTH(MSG)))="-"
 +7        WRITE !!,"------------",MSG,DASH
 +8        DO DSPHDR(CREF,OCXDD,OCXFLD)
 +9        IF $DATA(OCXSUB)
               DO DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB)
 +10       IF '$DATA(OCXSUB)
               DO DSPREC(CREF,OCXDD,OCXFLD)
 +11      ;
 +12       WRITE !
           QUIT 
 +13      ;
DSPREC(CREF,OCXDD,OCXFLD) ;
 +1       ;
 +2        NEW OCXDPTR,OCXDDPTH,LEVL,OCXCREF,OCXSUB
 +3        SET OCXCREF=$$APPEND($$APPEND(CREF,OCXDD),OCXFLD)
 +4        SET OCXDDPTH=$PIECE($PIECE(OCXCREF,"(",2),")",1)
           SET LEVL=$LENGTH(OCXDDPTH,",")
 +5        SET OCXSUB=""
           FOR 
               SET OCXSUB=$ORDER(@OCXCREF@(OCXSUB))
               IF '$LENGTH(OCXSUB)
                   QUIT 
               Begin DoDot:1
 +6       ;
 +7                IF '(OCXSUB[":")
                       IF '((OCXSUB=.01)&$ORDER(@OCXCREF@(OCXSUB)))
                           Begin DoDot:2
 +8                            NEW LINE
 +9                            IF $$EXFLD(+OCXFLD,OCXSUB)
                                   QUIT 
 +10                           IF OCXFLD
                                   WRITE !,?(5+((LEVL)*4)),$$FIELD^OCXSENDD(+OCX
FLD,OCXSUB,"LABEL"),": ",$GET(@OCXCREF@(OCXSUB,"E"))
 +11                           SET LINE=0
                               FOR 
                                   SET LINE=$ORDER(@OCXCREF@(OCXSUB,LINE))
                                   IF 'LINE
                                       QUIT 
                                   Begin DoDot:3
 +12                                   WRITE !,?(5+(LEVL*4)),$JUSTIFY(LINE,3),">
",@OCXCREF@(OCXSUB,LINE)
                                   End DoDot:3
                           End DoDot:2
 +13      ;
 +14               IF (OCXSUB[":")
                       Begin DoDot:2
 +15                       NEW D0,OCXDD,FILENAME
 +16                       SET D0=+$PIECE(OCXSUB,":",2)
                           SET OCXDD=+OCXSUB
 +17                       SET FILENAME=$$FILENAME^OCXSENDD(OCXDD)
 +18                       IF $LENGTH(FILENAME)
                               WRITE !,?(5+($LENGTH(LEVL)*4)),FILENAME
 +19                      IF '$TEST
                               WRITE !!,?(5+(LEVL*4)),FILENAME
 +20                       WRITE " ",D0,": ",$GET(@OCXCREF@(OCXSUB,.01,"E"))
 +21                       DO DSPREC($$APPEND(CREF,OCXDD),OCXFLD,OCXSUB)
                       End DoDot:2
               End DoDot:1
 +22      ;
 +23       QUIT 
 +24      ;
DSPHDR(CREF,OCXDD,OCXFLD) ;
 +1       ;
 +2        NEW D0,FILE,FILEID,OCXPTR,OCXDDPTH
 +3        SET OCXDDPTH=$PIECE($PIECE($$APPEND($$APPEND(CREF,OCXDD),OCXFLD),"(",
2),")",1)
 +4        SET FILE=""
           FOR OCXPTR=1:1:$LENGTH(OCXDDPTH,",")
               Begin DoDot:1
 +5                NEW OCXDD,D0,FILEID
 +6                SET FILEID=$PIECE(OCXDDPTH,",",OCXPTR)
 +7                IF (FILEID[":")
                       Begin DoDot:2
 +8                        SET D0=+$PIECE(FILEID,":",2)
                           SET OCXDD=+$EXTRACT(FILEID,2,$LENGTH(FILEID))
 +9                        WRITE !,?(5+(OCXPTR*4)),$$FILENAME^OCXSENDD(OCXDD)
 +10                       IF $LENGTH(FILE)
                               SET FILE=FILE_","
                           SET FILE=FILE_FILEID
 +11                       IF $DATA(@("L("_FILE_",.01,""E"")"))
                               WRITE ": ",@("L("_FILE_",.01,""E"")")
                               IF D0
                                   WRITE " [",D0,"]"
 +12                      IF '$TEST
                               IF $DATA(@("R("_FILE_",.01,""E"")"))
                                   WRITE ": ",@("R("_FILE_",.01,""E"")")
                                   IF D0
                                       WRITE " [",D0,"]"
                       End DoDot:2
               End DoDot:1
 +13      ;
 +14       QUIT 
 +15      ;
DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB) ;
 +1       ;
 +2        NEW OCXDPTR,LREF,RREF,OCXDDPTH
 +3       ;
 +4        SET OCXDDPTH=$PIECE($PIECE($$APPEND(CREF,OCXDD),"(",2),")",1)
 +5        SET LREF="L("_OCXDDPTH_")"
           SET RREF="R("_OCXDDPTH_")"
 +6        WRITE !,?(5+(($LENGTH(OCXDDPTH,",")+1)*4)),$$FIELD^OCXSENDD(OCXDD,OCX
FLD,"LABEL")," field [",OCXFLD,"]"
 +7        IF OCXSUB
               WRITE " Line #",OCXSUB
 +8       ;
 +9        IF ($DATA(@RREF@(OCXFLD,OCXSUB)))
               WRITE !,?(5+(($LENGTH(OCXDDPTH,",")+2)*4)),"(R) NCCLAB1.AAC.VA.GO
V: ",@RREF@(OCXFLD,OCXSUB)
 +10       IF ($DATA(@LREF@(OCXFLD,OCXSUB)))
               WRITE !,?(5+(($LENGTH(OCXDDPTH,",")+2)*4)),"(L) ",$$NETNAME^OCXSE
ND,": ",@LREF@(OCXFLD,OCXSUB)
 +11      ;
 +12       QUIT 
 +13      ;
 +14       WRITE !,?10
           QUIT 0
           QUIT $$PAUSE
 +15      ;
PAUSE()    WRITE "  Press Enter "
           READ X:DTIME
           WRITE !
           QUIT (X[U)
 +1       ;
NOW()      NEW X,Y,%DT
           SET X="N"
           SET %DT="T"
           DO ^%DT
           SET Y=$$DATE^OCXSENDD(Y)
           IF (Y["@")
               SET Y=$PIECE(Y,"@",1)_" at "_$PIECE(Y,"@",2)
           QUIT Y
 +1       ;


ORY4271  * *  172 Lines,  6010 Bytes, Checksum: B40435115
                                                  Jun 28, 2016@13:15:59 page 23
              156 bytes in comments
ORY4271  ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install
           of OR*3*427) ;MAY 10,2016 at 13:31
         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
         ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
         ;
S        ;
         ;
         Q
         ;
         ;
COMPARE(L,R) --
          ;
         ;
         Q:$$RES("R") 1
         ;
         Q:'$L($O(L(""))) $$ADDREC^ORY4272("R")
         ;
         N C,OCXDD M C=L,C=R S OCXDD=$O(C("")) Q $$MULT("C",OCXDD)
         ;
         Q 0
         ;
RES(REF) ;
         ;
         N QUIT,SUB
         S QUIT=0
         S SUB="" F  S SUB=$O(@REF@(SUB)) Q:'$L(SUB)  I (SUB[":") D  Q:QUIT
         .N DD,DA
         .S DD=$P(SUB,":",1),DA=$P(SUB,":",2)
         .I $L(DA),'(DA=+DA) D  Q:QUIT
         ..N DANEW,SUBNEW
         ..S DANEW=$O(^OCXS($P(DA,U,2),"B",$P(DA,U,1),0))
         ..I 'DANEW W !!,$P($G(^OCXS(+$P(DA,U,2),0)),U,1),": ",$P(DA,U,1),"  cou
          ld not resolve name.",!!,"    End Transport." S QUIT=1 Q
         ..S SUBNEW=DD_":"_DANEW
         ..I $D(@REF@(SUBNEW)) W !!," multiple #",DANEW," already existed." S QU
          IT=1 Q
         ..M @REF@(SUBNEW)=@REF@(SUB)
         ..K @REF@(SUB)
         ..S SUB=""
         .I $L(SUB),($D(@REF@(SUB))>9) S QUIT=$$RES($NA(@REF@(SUB)))
         ;
         Q QUIT
         ;
MULT(CREF,OCXDD) --
          ;
         ;
         N OCXSUB,LREF,RREF,QUIT,OCXFLD
         S LREF="L"_$E(CREF,2,$L(CREF)),RREF="R"_$E(CREF,2,$L(CREF))
         ;
         S QUIT=0,OCXFLD="" F  S OCXFLD=$O(@CREF@(OCXDD,OCXFLD)) Q:'$L(OCXFLD)  
          D  Q:QUIT
         .I (OCXFLD[":") D  Q:QUIT
         ..Q:$$EXFLD(+OCXFLD,0)
         ..I '$D(@LREF@(OCXDD,OCXFLD,.01,"E")) D  M @LREF@(OCXDD,OCXFLD)=@RREF@(
          OCXDD,OCXFLD)
         ...D WARN("Missing multiple:",CREF,OCXDD,OCXFLD)
         ...S QUIT=$$ADDMULT^ORY4273(CREF,OCXDD,OCXFLD)
         ..I '$D(@RREF@(OCXDD,OCXFLD,.01,"E")) D  M @RREF@(OCXDD,OCXFLD)=@LREF@(
          OCXDD,OCXFLD)
         ...D WARN("Extra multiple:",CREF,OCXDD,OCXFLD)
         ...S QUIT=$$DELMULT^ORY4273($$APPEND(CREF,OCXDD),OCXFLD)
         .;
         .I (OCXFLD=+OCXFLD),'$$EXFLD(+OCXDD,OCXFLD) D
         ..I ($O(@CREF@(OCXDD,OCXFLD,""))="E") D  Q
         ...I $L($G(@RREF@(OCXDD,OCXFLD,"E"))),'$L($G(@LREF@(OCXDD,OCXFLD,"E")))
           D  Q
         ....D WARN("Data Value Missing in "_$$NETNAME^OCXSEND,CREF,OCXDD,OCXFLD
          ,"E")
         ....S QUIT=$$EDITFLD^ORY4274(CREF,OCXDD,OCXFLD,"E")
         ...I $L($G(@LREF@(OCXDD,OCXFLD,"E"))),'$L($G(@RREF@(OCXDD,OCXFLD,"E")))
           D  Q
         ....D WARN("Extra Data Value in "_$$NETNAME^OCXSEND,CREF,OCXDD,OCXFLD,"
          E")
         ....S QUIT=$$DELFLD^ORY4274(CREF,OCXDD,OCXFLD,"E")
         ...I '(@LREF@(OCXDD,OCXFLD,"E")=@RREF@(OCXDD,OCXFLD,"E")) D
         ....D WARN("Inconsistent Data",CREF,OCXDD,OCXFLD,"E")
         ....S QUIT=$$EDITFLD^ORY4274(CREF,OCXDD,OCXFLD,"E")
         ..S OCXSUB=0 F  Q:QUIT  S OCXSUB=$O(@CREF@(OCXDD,OCXFLD,OCXSUB)) Q:'OCX
          SUB  I '($G(@RREF@(OCXDD,OCXFLD,OCXSUB))=$G(@LREF@(OCXDD,OCXFLD,OCXSUB
          ))) D  Q
         ...D WARN("Inconsistent word Data",CREF,OCXDD,OCXFLD,OCXSUB)
         ...S QUIT=$$LOADWORD^ORY4272(RREF,OCXDD,OCXFLD,OCXSUB)
         .;
         .I 'QUIT,(OCXFLD[":") S QUIT=$$MULT($$APPEND(CREF,OCXDD),OCXFLD)
         Q QUIT
         ;
APPEND(ARRAY,OCXSUB) --
          ;
         S:'(OCXSUB=+OCXSUB) OCXSUB=""""_OCXSUB_""""
         Q:'(ARRAY["(") ARRAY_"("_OCXSUB_")"
         Q $E(ARRAY,1,$L(ARRAY)-1)_","_OCXSUB_")"
         ;
EXFLD(FILE,OCXFLD) --
          ;
         N OCXFNAM
         S OCXFNAM=$$FIELD^OCXSENDD(FILE,OCXFLD,"LABEL")
         I (OCXFNAM["UNIQUE OBJECT IDENTIFIER") Q 1
         I (FILE=860.2),(OCXFLD=.02) Q 1
         I (FILE=860.22),(OCXFLD=4) Q 1
         I (FILE=860.3),(OCXFLD=3) Q 1
         I (FILE=860.9),(OCXFLD=1) Q 1
         I (FILE=860.91) Q 1
         I (FILE=860.801) Q 1
         I (FILE=860.81) Q 1
         I (FILE=861.01) Q 1
         I (FILE=863.02) Q 1
         I (FILE=863.54) Q 1
         I (FILE=863.61) Q 1
         I (FILE=863.72) Q 1
         I (FILE=863.81) Q 1
         I ($E(OCXFNAM,1)="*") Q 1
         Q 0
         ;
WARN(MSG,CREF,OCXDD,OCXFLD,OCXSUB) --
          ;
         ;
         Q:$G(OCXAUTO)
         ;
         N D0,DASH,OCXDDPTH,OCXDPTR,FILE,FILEID,LREF,OCXPTR,RREF
         ;
         S DASH="",$P(DASH,"-",(55-$L(MSG)))="-"
         W !!,"------------",MSG,DASH
         D DSPHDR(CREF,OCXDD,OCXFLD)
         I $D(OCXSUB) D DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB)
         I '$D(OCXSUB) D DSPREC(CREF,OCXDD,OCXFLD)
         ;
         W ! Q
         ;
DSPREC(CREF,OCXDD,OCXFLD) --
          ;
         ;
         N OCXDPTR,OCXDDPTH,LEVL,OCXCREF,OCXSUB
         S OCXCREF=$$APPEND($$APPEND(CREF,OCXDD),OCXFLD)
         S OCXDDPTH=$P($P(OCXCREF,"(",2),")",1),LEVL=$L(OCXDDPTH,",")
         S OCXSUB="" F  S OCXSUB=$O(@OCXCREF@(OCXSUB)) Q:'$L(OCXSUB)  D
         .;
         .I '(OCXSUB[":"),'((OCXSUB=.01)&$O(@OCXCREF@(OCXSUB))) D
         ..N LINE
         ..Q:$$EXFLD(+OCXFLD,OCXSUB)
         ..I OCXFLD W !,?(5+((LEVL)*4)),$$FIELD^OCXSENDD(+OCXFLD,OCXSUB,"LABEL")
          ,": ",$G(@OCXCREF@(OCXSUB,"E"))
         ..S LINE=0 F  S LINE=$O(@OCXCREF@(OCXSUB,LINE)) Q:'LINE  D
         ...W !,?(5+(LEVL*4)),$J(LINE,3),">",@OCXCREF@(OCXSUB,LINE)
         .;
         .I (OCXSUB[":") D
         ..N D0,OCXDD,FILENAME
         ..S D0=+$P(OCXSUB,":",2),OCXDD=+OCXSUB
         ..S FILENAME=$$FILENAME^OCXSENDD(OCXDD)
         ..I $L(FILENAME) W !,?(5+($L(LEVL)*4)),FILENAME
         ..E  W !!,?(5+(LEVL*4)),FILENAME
         ..W " ",D0,": ",$G(@OCXCREF@(OCXSUB,.01,"E"))
         ..D DSPREC($$APPEND(CREF,OCXDD),OCXFLD,OCXSUB)
         ;
         Q
         ;
DSPHDR(CREF,OCXDD,OCXFLD) --
          ;
         ;
         N D0,FILE,FILEID,OCXPTR,OCXDDPTH
         S OCXDDPTH=$P($P($$APPEND($$APPEND(CREF,OCXDD),OCXFLD),"(",2),")",1)
         S FILE="" F OCXPTR=1:1:$L(OCXDDPTH,",") D
         .N OCXDD,D0,FILEID
         .S FILEID=$P(OCXDDPTH,",",OCXPTR)
         .I (FILEID[":") D
         ..S D0=+$P(FILEID,":",2),OCXDD=+$E(FILEID,2,$L(FILEID))
         ..W !,?(5+(OCXPTR*4)),$$FILENAME^OCXSENDD(OCXDD)
         ..S:$L(FILE) FILE=FILE_"," S FILE=FILE_FILEID
         ..I $D(@("L("_FILE_",.01,""E"")")) W ": ",@("L("_FILE_",.01,""E"")") W:
          D0 " [",D0,"]"
         ..E  I $D(@("R("_FILE_",.01,""E"")")) W ": ",@("R("_FILE_",.01,""E"")")
           W:D0 " [",D0,"]"
         ;
         Q
         ;
DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB) --
          ;
         ;
         N OCXDPTR,LREF,RREF,OCXDDPTH
         ;
         S OCXDDPTH=$P($P($$APPEND(CREF,OCXDD),"(",2),")",1)
         S LREF="L("_OCXDDPTH_")",RREF="R("_OCXDDPTH_")"
         W !,?(5+(($L(OCXDDPTH,",")+1)*4)),$$FIELD^OCXSENDD(OCXDD,OCXFLD,"LABEL"
          )," field [",OCXFLD,"]"
         I OCXSUB W " Line #",OCXSUB
         ;
         W:($D(@RREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(R) NCCL
          AB1.AAC.DNS   : ",@RREF@(OCXFLD,OCXSUB)
         W:($D(@LREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(L) ",$$
          NETNAME^OCXSEND,": ",@LREF@(OCXFLD,OCXSUB)
         ;
         Q
         ;
         W !,?10 Q 0 Q $$PAUSE
         ;
PAUSE()  W "  Press Enter " R X:DTIME W ! Q (X[U)
         ;
NOW()    N X,Y,%DT S X="N",%DT="T" D ^%DT S Y=$$DATE^OCXSENDD(Y) S:(Y["@") Y=$P(
          Y,"@",1)_" at "_$P(Y,"@",2) Q Y
         ;

*****   INDEX OF ORY4271   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
   %DT          NOW~*
   ARRAY        APPEND~,APPEND+2,APPEND+3
   C            COMPARE+6~*
   C(""         COMPARE+6
   CREF         MULT~,MULT+3,MULT+5,MULT+9,MULT+10,MULT+12,MULT+13,MULT+16
                MULT+18,MULT+19,MULT+21,MULT+22,MULT+24,MULT+25,MULT+26,MULT+27
                MULT+30,WARN~,WARN+8,WARN+9,WARN+10,DSPREC~,DSPREC+3,DSPREC+21
                DSPHDR~,DSPHDR+3,DSPFLD~,DSPFLD+4
   D0           WARN+4~,DSPREC+15~,DSPREC+16*,DSPREC+20,DSPHDR+2~,DSPHDR+5~
                DSPHDR+8*,DSPHDR+11,DSPHDR+12
   DA           RES+5~,RES+6*,RES+7,RES+9,RES+10
   DANEW        RES+8~,RES+9*,RES+10,RES+11,RES+12
   DASH         WARN+4~,WARN+6*,WARN+7
   DD           RES+5~,RES+6*,RES+11
   DTIME        PAUSE
   FILE         EXFLD~,EXFLD+2,EXFLD+4,EXFLD+5,EXFLD+6,EXFLD+7,EXFLD+8,EXFLD+9
                EXFLD+10,EXFLD+11,EXFLD+12,EXFLD+13,EXFLD+14,EXFLD+15,EXFLD+16
                WARN+4~,DSPHDR+2~,DSPHDR+4*,DSPHDR+10*,DSPHDR+11,DSPHDR+12
   FILEID       WARN+4~,DSPHDR+2~,DSPHDR+5~,DSPHDR+6*,DSPHDR+7,DSPHDR+8
                DSPHDR+10
   FILENAME     DSPREC+15~,DSPREC+17*,DSPREC+18,DSPREC+19
   L            COMPARE~,COMPARE+6
   L(""         COMPARE+4
   LEVL         DSPREC+2~,DSPREC+4*,DSPREC+10,DSPREC+12,DSPREC+18,DSPREC+19
   LINE         DSPREC+8~,DSPREC+11*,DSPREC+12
   LREF         MULT+2~,MULT+3*,MULT+8,MULT+11,MULT+17,MULT+20,MULT+23,MULT+26
                WARN+4~,DSPFLD+2~,DSPFLD+5*,DSPFLD+10
   MSG          WARN~,WARN+6,WARN+7
>> OCXAUTO      WARN+2
   OCXCREF      DSPREC+2~,DSPREC+3*,DSPREC+4,DSPREC+5,DSPREC+7,DSPREC+10
                DSPREC+11,DSPREC+12,DSPREC+20
   OCXDD        COMPARE+6~*,MULT~,MULT+5,MULT+8,MULT+9,MULT+10,MULT+11,MULT+12
                MULT+13,MULT+15,MULT+16,MULT+17,MULT+18,MULT+19,MULT+20,MULT+21
                MULT+22,MULT+23,MULT+24,MULT+25,MULT+26,MULT+27,MULT+28,MULT+30
                WARN~,WARN+8,WARN+9,WARN+10,DSPREC~,DSPREC+3
                DSPREC+15~,DSPREC+16*,DSPREC+17,DSPREC+21,DSPHDR~,DSPHDR+3
                DSPHDR+5~,DSPHDR+8*,DSPHDR+9,DSPFLD~,DSPFLD+4,DSPFLD+6
   OCXDDPTH     WARN+4~,DSPREC+2~,DSPREC+4*,DSPHDR+2~,DSPHDR+3*,DSPHDR+4
                DSPHDR+6,DSPFLD+2~,DSPFLD+4*,DSPFLD+5,DSPFLD+6,DSPFLD+9
                DSPFLD+10
   OCXDPTR      WARN+4~,DSPREC+2~,DSPFLD+2~
   OCXFLD       MULT+2~,MULT+5*,MULT+6,MULT+7,MULT+8,MULT+9,MULT+10,MULT+11
                MULT+12,MULT+13,MULT+15,MULT+16,MULT+17,MULT+18,MULT+19,MULT+20
                MULT+21,MULT+22,MULT+23,MULT+24,MULT+25,MULT+26,MULT+27,MULT+28
                MULT+30,EXFLD~,EXFLD+2,EXFLD+4,EXFLD+5,EXFLD+6
                EXFLD+7,WARN~,WARN+8,WARN+9,WARN+10,DSPREC~,DSPREC+3,DSPREC+9
                DSPREC+10,DSPREC+21,DSPHDR~,DSPHDR+3,DSPFLD~,DSPFLD+6,DSPFLD+9
                DSPFLD+10
   OCXFNAM      EXFLD+1~,EXFLD+2*,EXFLD+3,EXFLD+17
   OCXPTR       WARN+4~,DSPHDR+2~,DSPHDR+4*,DSPHDR+6,DSPHDR+9
   OCXSUB       MULT+2~,MULT+26*,MULT+27,MULT+28,APPEND~,APPEND+1*,APPEND+2
                APPEND+3,WARN~,WARN+9,WARN+10,DSPREC+2~,DSPREC+5*,DSPREC+7
                DSPREC+9,DSPREC+10,DSPREC+11,DSPREC+12,DSPREC+14,DSPREC+16
                DSPREC+20,DSPREC+21,DSPFLD~,DSPFLD+7,DSPFLD+9,DSPFLD+10
   QUIT         RES+2~,RES+3*,RES+4,RES+7,RES+10*,RES+12*,RES+16*,RES+18
                MULT+2~,MULT+5*,MULT+6,MULT+10*,MULT+13*,MULT+19*,MULT+22*
                MULT+25*,MULT+26,MULT+28*,MULT+30*,MULT+31
   R            COMPARE~,COMPARE+6
   REF          RES~,RES+4,RES+12,RES+13,RES+14,RES+16
   RREF         MULT+2~,MULT+3*,MULT+8,MULT+11,MULT+17,MULT+20,MULT+23,MULT+26
                MULT+28,WARN+4~,DSPFLD+2~,DSPFLD+5*,DSPFLD+9
   SUB          RES+2~,RES+4*,RES+6,RES+13,RES+14,RES+15*,RES+16
   SUBNEW       RES+8~,RES+11*,RES+12,RES+13
   U            RES+9,RES+10,PAUSE
   X            PAUSE*,NOW~*
   Y            NOW~*

Global Variables  ( * Changed  ! Killed)
   ^OCXS(              RES+9,RES+10

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   NONE

Label References
   $$APPEND     MULT+13,MULT+30,DSPREC+3,DSPREC+21,DSPHDR+3,DSPFLD+4
   $$EXFLD      MULT+7,MULT+15,DSPREC+9
   $$MULT       COMPARE+6,MULT+30
   $$PAUSE      DSPFLD+14
   $$RES        COMPARE+2,RES+16
   DSPFLD       WARN+9
   DSPHDR       WARN+8
   DSPREC       WARN+10,DSPREC+21
   WARN         MULT+9,MULT+12,MULT+18,MULT+21,MULT+24,MULT+27

External References
   ^%DT                NOW
   $$NETNAME^OCXSEND   MULT+18,MULT+21,DSPFLD+10
   $$DATE^OCXSENDD     NOW
   $$FIELD^OCXSENDD    EXFLD+2,DSPREC+10,DSPFLD+6
   $$FILENAME^OCXSENDD DSPREC+17,DSPHDR+9
   $$ADDREC^ORY4272    COMPARE+4
   $$LOADWORD^ORY4272  MULT+28
   $$ADDMULT^ORY4273   MULT+10
   $$DELMULT^ORY4273   MULT+13
   $$DELFLD^ORY4274    MULT+22
   $$EDITFLD^ORY4274   MULT+19,MULT+25

*****   END   *****
ORY4272   4669     printed  Jun 28, 2016@13:15:59                      Page 24

ORY4272   ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Instal
l of OR*3*427) ;MAY 10,2016 at 13:31
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 +3       ;
S         ;
 +1       ;  Record Utilities
 +2        QUIT 
 +3       ;
ADDREC(OCXCREF) ;
 +1       ;
 +2        NEW QUIT,OCXDD,OCXDA,OCXGREF,OCXNAME
 +3        SET OCXDD=$ORDER(@OCXCREF@(""))
           IF 'OCXDD
               QUIT 0
 +4        SET OCXNAME=$GET(@OCXCREF@(OCXDD,.01,"E"))
 +5       ;
 +6        WRITE "   record missing..."
 +7        IF (OCXFLAG["D")
               QUIT 0
 +8       ;
 +9        SET OCXDA=0
           DO CREATE(OCXCREF,OCXDD,.OCXDA,0)
 +10       IF $LENGTH(OCXNAME)
               SET ^TMP("OCXRULE",$JOB,"A",+OCXDD,OCXNAME)=""
 +11      ;
 +12       QUIT 0
 +13      ;
CREATE(OCXCREF,OCXDD,OCXDA,OCXLVL) ;
 +1       ;
 +2        NEW OCXFLD,OCXGREF,OCXKEY
 +3       ;
 +4        IF $LENGTH(OCXDA)
               IF '(OCXDA=+OCXDA)
                   WRITE !!,"Unresolved subscript."
                   QUIT 
 +5       ;
 +6        SET OCXKEY=@OCXCREF@(OCXDD,.01,"E")
 +7        SET OCXGREF=$$GETREF(+OCXDD,.OCXDA,OCXLVL)
           IF '$LENGTH(OCXGREF)
               QUIT 
 +8        IF 'OCXDA
               Begin DoDot:1
 +9                SET OCXDA=$ORDER(^TMP("OCXRULE",$JOB,"B",+OCXDD,OCXKEY,0))
                   IF OCXDA
                       QUIT 
 +10               SET OCXDA=$ORDER(@(OCXGREF_""" "")"),-1)+1
 +11               FOR OCXDA=OCXDA:1
                       IF '$DATA(@(OCXGREF_OCXDA_",0)"))
                           QUIT 
 +12               IF $DATA(@(OCXGREF_OCXDA_",0)"))
                       SET OCXDA=0
               End DoDot:1
 +13      ;
 +14       IF 'OCXDA
               WRITE !!,"Error adding record..."
               QUIT 
 +15      ;
 +16       IF '$DATA(@(OCXGREF_"0)"))
               SET @(OCXGREF_"0)")=U_$$FILEHDR^OCXSENDD(+OCXDD)_U_U
 +17      ;
 +18       SET OCXFLD=0
           FOR 
               SET OCXFLD=$ORDER(@OCXCREF@(OCXDD,OCXFLD))
               IF 'OCXFLD
                   QUIT 
               IF (OCXFLD["
                   QUIT 
               IF '$$EXFLD^ORY4271(+OCXDD,OCXFLD)
                   Begin DoDot:1
 +19                   IF $LENGTH($GET(@OCXCREF@(OCXDD,OCXFLD,"E")))
                           DO DIE(OCXDD,OCXGREF,OCXFLD,@OCXCREF@(OCXDD,OCXFLD,"E
"),.OCXDA,OCXLVL)
 +20                   IF $ORDER(@OCXCREF@(OCXDD,OCXFLD,0))
                           DO WORD(OCXDD,OCXGREF,OCXFLD,.OCXDA,OCXCREF)
                   End DoDot:1
 +21      ;
 +22       DO PUSH(.OCXDA)
 +23       SET OCXFLD=""
           FOR 
               SET OCXFLD=$ORDER(@OCXCREF@(OCXDD,OCXFLD))
               IF '$LENGTH(OCXFLD)
                   QUIT 
               IF (OCXFLD[":")
                   Begin DoDot:1
 +24                   SET OCXDA=$PIECE(OCXFLD,":",2)
                       WRITE !
                       DO CREATE($$APPEND(OCXCREF,OCXDD),OCXFLD,.OCXDA,OCXLVL+1)
                   End DoDot:1
 +25       DO POP(.OCXDA)
 +26       QUIT 
 +27      ;
LOADWORD(RREF,OCXDD,OCXFLD,OCXSUB) ;
 +1       ;
 +2        NEW QUIT,DDPATH,INDEX,OCXDA,OCXGREF
 +3        SET DDPATH=$PIECE($PIECE($$APPEND(RREF,OCXDD),"(",2),")",1)
 +4        FOR INDEX=1:1:$LENGTH(DDPATH,",")
               SET OCXDA($LENGTH(DDPATH,",")-INDEX)=+$PIECE($PIECE(DDPATH,",",IN
DEX),":",2)
 +5        SET OCXDA=$GET(OCXDA(0))
           KILL OCXDA(0)
 +6        IF (OCXFLAG["D")
               QUIT 0
 +7        IF (OCXFLAG["A")
               SET QUIT=$$READ("Y"," Do you want to reload the local '"_$$FIELD^
OCXSENDD(+OCXDD,+OCXFLD,"LABEL")_"' field ?","YES")
               IF 'QUIT
                   QUIT (QUIT[U)
 +8        SET OCXGREF=$$GETREF(+OCXDD,.OCXDA,$LENGTH(DDPATH,",")-1)
           IF '$LENGTH(OCXGREF)
               QUIT 
 +9        DO WORD(OCXDD,OCXGREF,OCXFLD,.OCXDA,RREF)
 +10       QUIT 0
 +11      ;
GETREF(OCXDD,OCXDA,OCXLVL) ;
 +1       ;
 +2        IF 'OCXDD
               QUIT ""
 +3       ;
 +4        NEW OCXIENS,OCXERR,OCXX
 +5        SET OCXIENS=$$IENS^DILF(.OCXDA)
           SET OCXERR=""
 +6        SET OCXX=$$ROOT^DILFD(OCXDD,OCXIENS,0,OCXERR)
 +7        QUIT OCXX
 +8       ;
WORD(DD,GREF,FLD,DA,RREF) ;
 +1       ;
 +2        NEW SUB,GLROOT,LINE
 +3        SET SUB=$PIECE($$FIELD^OCXSENDD(+DD,FLD,"GLOBAL SUBSCRIPT LOCATION"),
";",1)
           IF '(SUB=+SUB)
               SET SUB=""""_SUB_""""
 +4        SET GLROOT=GREF_DA_","_SUB_")"
           KILL @GLROOT
 +5        SET LINE=0
           FOR 
               SET LINE=$ORDER(@RREF@(DD,FLD,LINE))
               IF 'LINE
                   QUIT 
               Begin DoDot:1
 +6                SET @GLROOT@($ORDER(@GLROOT@(""),-1)+1,0)=@RREF@(DD,FLD,LINE)
               End DoDot:1
 +7        SET LINE=$ORDER(@GLROOT@(""),-1)
           SET @GLROOT@(0)=U_U_LINE_U_LINE_U_$$DATE("T")_U
 +8       ;
 +9        QUIT 
 +10      ;
DATE(X)    NEW %DT,Y
           SET %DT=""
           DO ^%DT
           QUIT +Y
 +1       ;
DIE(OCXDD,OCXDIC,OCXFLD,OCXVAL,OCXDA,OCXLVL) ;
 +1       ;
 +2        NEW DIC,DIE,X,Y,DR,DA,OCXDVAL,OCXPTR,OCXGREF,D0,OCXSCR
 +3        SET (D0,DA)=OCXDA
           SET (DIC,DIE)=OCXDIC
           SET DR=""
 +4        IF OCXLVL
               SET D0=OCXDA(1)
               SET DR="S DA(1)="_(+D0)_",D0="_(+D0)_";"
 +5        IF OCXVAL="?"
               SET OCXVAL="? "
           SET DR=DR_OCXFLD_"///^S X=OCXVAL"
 +6        IF '(OCXVAL="@")
               WRITE !,?(OCXLVL*5),$$FIELD^OCXSENDD(+OCXDD,OCXFLD,"LABEL"),": ",
OCXVAL
 +7       ;
 +8        IF '(OCXVAL="@")
               Begin DoDot:1
 +9                NEW OCXIEN,SHORT
 +10               SET OCXPTR=+$PIECE($$FIELD^OCXSENDD(+OCXDD,OCXFLD,"SPECIFIER"
),"P",2)
 +11               IF 'OCXPTR
                       QUIT 
 +12               SET OCXGREF="^"_$$FIELD^OCXSENDD(+OCXDD,OCXFLD,"POINTER")
 +13               IF '($EXTRACT(OCXGREF,1,4)="^OCX")
                       IF '(OCXGREF="^ORD(100.9,")
                           IF '(OCXGREF="^ORD(100.8,")
                               QUIT 
 +14               IF $$DIC(OCXGREF,OCXVAL,0)
                       QUIT 
 +15               SET OCXIEN=$$DIC(OCXGREF,OCXVAL,1)
 +16               SET ^TMP("OCXRULE",$JOB,"B",OCXPTR,OCXVAL,OCXIEN)=""
               End DoDot:1
 +17      ;
 +18       SET OCXSCR=1
 +19       DO ^DIE
 +20      ;
 +21      ; I $D(Y) -> DIE FILER ERROR
 +22       IF $DATA(Y)
               WRITE "   ^DIE filer data error..."
               SET OCXDIER=$GET(OCXDIER)+1
 +23       IF '$DATA(Y)
               WRITE "    ...Correct data Filed"
 +24      ;
 +25       QUIT 
 +26      ;
DIC(DIC,X,OCXADD)  NEW OCXSCR
           SET DIC(0)=""
           SET OCXSCR=1
           IF OCXADD
               SET DIC(0)="L"
           DO ^DIC
           IF (+Y>0)
               QUIT +Y
           QUIT 0
 +1       ;
PUSH(OCXDA) ;
 +1        NEW OCXSUB
           SET OCXSUB=""
           FOR 
               SET OCXSUB=$ORDER(OCXDA(OCXSUB),-1)
               IF 'OCXSUB
                   QUIT 
               SET OCXDA(OCXSUB+1)=OCXDA(OCXSUB)
 +2        SET OCXDA(1)=OCXDA
           SET OCXDA=0
 +3        QUIT 
 +4       ;
POP(OCXDA) ;
 +1        NEW OCXSUB
           SET OCXSUB=""
           FOR 
               SET OCXSUB=$ORDER(OCXDA(OCXSUB))
               IF 'OCXSUB
                   QUIT 
               SET OCXDA(OCXSUB)=$GET(OCXDA(OCXSUB+1))
 +2        SET OCXDA=OCXDA(1)
           KILL OCXDA($ORDER(OCXDA(""),-1))
 +3        QUIT 
 +4       ;
APPEND(ARRAY,OCXSUB) ;
 +1        IF '(OCXSUB=+OCXSUB)
               SET OCXSUB=""""_OCXSUB_""""
 +2        IF '(ARRAY["(")
               QUIT ARRAY_"("_OCXSUB_")"
 +3        QUIT $EXTRACT(ARRAY,1,$LENGTH(ARRAY)-1)_","_OCXSUB_")"
 +4       ;
READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
 +1        NEW OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
 +2        IF '$LENGTH($GET(OCXZ0))
               QUIT U
 +3        SET DIR(0)=OCXZ0
 +4        IF $LENGTH($GET(OCXZA))
               SET DIR("A")=OCXZA
 +5        IF $LENGTH($GET(OCXZB))
               SET DIR("B")=OCXZB
 +6        FOR OCXLINE=1:1:($GET(OCXZL)-1)
               WRITE !
 +7        DO ^DIR
 +8        IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
               QUIT U
 +9        QUIT Y
 +10      ;
PAUSE()    WRITE "  Press Enter "
           READ X:DTIME
           WRITE !
           QUIT (X[U)
 +1       ;


ORY4272  * *  141 Lines,  4669 Bytes, Checksum: B26767346
                                                  Jun 28, 2016@13:15:59 page 25
              200 bytes in comments
ORY4272  ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install
           of OR*3*427) ;MAY 10,2016 at 13:31
         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
         ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
         ;
S        ;
         ;  Record Utilities
         Q
         ;
ADDREC(OCXCREF) --
          ;
         ;
         N QUIT,OCXDD,OCXDA,OCXGREF,OCXNAME
         S OCXDD=$O(@OCXCREF@("")) Q:'OCXDD 0
         S OCXNAME=$G(@OCXCREF@(OCXDD,.01,"E"))
         ;
         W "   record missing..."
         I (OCXFLAG["D") Q 0
         ;
         S OCXDA=0 D CREATE(OCXCREF,OCXDD,.OCXDA,0)
         S:$L(OCXNAME) ^TMP("OCXRULE",$J,"A",+OCXDD,OCXNAME)=""
         ;
         Q 0
         ;
CREATE(OCXCREF,OCXDD,OCXDA,OCXLVL) --
          ;
         ;
         N OCXFLD,OCXGREF,OCXKEY
         ;
         I $L(OCXDA),'(OCXDA=+OCXDA) W !!,"Unresolved subscript." Q
         ;
         S OCXKEY=@OCXCREF@(OCXDD,.01,"E")
         S OCXGREF=$$GETREF(+OCXDD,.OCXDA,OCXLVL) Q:'$L(OCXGREF)
         I 'OCXDA D
         .S OCXDA=$O(^TMP("OCXRULE",$J,"B",+OCXDD,OCXKEY,0)) Q:OCXDA
         .S OCXDA=$O(@(OCXGREF_""" "")"),-1)+1
         .F OCXDA=OCXDA:1 Q:'$D(@(OCXGREF_OCXDA_",0)"))
         .I $D(@(OCXGREF_OCXDA_",0)")) S OCXDA=0
         ;
         I 'OCXDA W !!,"Error adding record..." Q
         ;
         I '$D(@(OCXGREF_"0)")) S @(OCXGREF_"0)")=U_$$FILEHDR^OCXSENDD(+OCXDD)_U
          _U
         ;
         S OCXFLD=0 F  S OCXFLD=$O(@OCXCREF@(OCXDD,OCXFLD)) Q:'OCXFLD  Q:(OCXFLD
          [":")  I '$$EXFLD^ORY4271(+OCXDD,OCXFLD) D
         .I $L($G(@OCXCREF@(OCXDD,OCXFLD,"E"))) D DIE(OCXDD,OCXGREF,OCXFLD,@OCXC
          REF@(OCXDD,OCXFLD,"E"),.OCXDA,OCXLVL)
         .I $O(@OCXCREF@(OCXDD,OCXFLD,0)) D WORD(OCXDD,OCXGREF,OCXFLD,.OCXDA,OCX
          CREF)
         ;
         D PUSH(.OCXDA)
         S OCXFLD="" F  S OCXFLD=$O(@OCXCREF@(OCXDD,OCXFLD)) Q:'$L(OCXFLD)  I (O
          CXFLD[":") D
         .S OCXDA=$P(OCXFLD,":",2) W ! D CREATE($$APPEND(OCXCREF,OCXDD),OCXFLD,.
          OCXDA,OCXLVL+1)
         D POP(.OCXDA)
         Q
         ;
LOADWORD(RREF,OCXDD,OCXFLD,OCXSUB) --
          ;
         ;
         N QUIT,DDPATH,INDEX,OCXDA,OCXGREF
         S DDPATH=$P($P($$APPEND(RREF,OCXDD),"(",2),")",1)
         F INDEX=1:1:$L(DDPATH,",") S OCXDA($L(DDPATH,",")-INDEX)=+$P($P(DDPATH,
          ",",INDEX),":",2)
         S OCXDA=$G(OCXDA(0)) K OCXDA(0)
         Q:(OCXFLAG["D") 0
         I (OCXFLAG["A") S QUIT=$$READ("Y"," Do you want to reload the local '"_
          $$FIELD^OCXSENDD(+OCXDD,+OCXFLD,"LABEL")_"' field ?","YES") Q:'QUIT (Q
          UIT[U)
         S OCXGREF=$$GETREF(+OCXDD,.OCXDA,$L(DDPATH,",")-1) Q:'$L(OCXGREF)
         D WORD(OCXDD,OCXGREF,OCXFLD,.OCXDA,RREF)
         Q 0
         ;
GETREF(OCXDD,OCXDA,OCXLVL) --
          ;
         ;
         Q:'OCXDD ""
         ;
         N OCXIENS,OCXERR,OCXX
         S OCXIENS=$$IENS^DILF(.OCXDA),OCXERR=""
         S OCXX=$$ROOT^DILFD(OCXDD,OCXIENS,0,OCXERR)
         Q OCXX
         ;
WORD(DD,GREF,FLD,DA,RREF) --
          ;
         ;
         N SUB,GLROOT,LINE
         S SUB=$P($$FIELD^OCXSENDD(+DD,FLD,"GLOBAL SUBSCRIPT LOCATION"),";",1) S
          :'(SUB=+SUB) SUB=""""_SUB_""""
         S GLROOT=GREF_DA_","_SUB_")" K @GLROOT
         S LINE=0 F  S LINE=$O(@RREF@(DD,FLD,LINE)) Q:'LINE  D
         .S @GLROOT@($O(@GLROOT@(""),-1)+1,0)=@RREF@(DD,FLD,LINE)
         S LINE=$O(@GLROOT@(""),-1),@GLROOT@(0)=U_U_LINE_U_LINE_U_$$DATE("T")_U
         ;
         Q
         ;
DATE(X)  N %DT,Y S %DT="" D ^%DT Q +Y
         ;
DIE(OCXDD,OCXDIC,OCXFLD,OCXVAL,OCXDA,OCXLVL) --
          ;
         ;
         N DIC,DIE,X,Y,DR,DA,OCXDVAL,OCXPTR,OCXGREF,D0,OCXSCR
         S (D0,DA)=OCXDA,(DIC,DIE)=OCXDIC,DR=""
         S:OCXLVL D0=OCXDA(1),DR="S DA(1)="_(+D0)_",D0="_(+D0)_";"
         S:OCXVAL="?" OCXVAL="? " S DR=DR_OCXFLD_"///^S X=OCXVAL"
         I '(OCXVAL="@") W !,?(OCXLVL*5),$$FIELD^OCXSENDD(+OCXDD,OCXFLD,"LABEL")
          ,": ",OCXVAL
         ;
         I '(OCXVAL="@") D
         .N OCXIEN,SHORT
         .S OCXPTR=+$P($$FIELD^OCXSENDD(+OCXDD,OCXFLD,"SPECIFIER"),"P",2)
         .Q:'OCXPTR
         .S OCXGREF="^"_$$FIELD^OCXSENDD(+OCXDD,OCXFLD,"POINTER")
         .I '($E(OCXGREF,1,4)="^OCX"),'(OCXGREF="^ORD(100.9,"),'(OCXGREF="^ORD(1
          00.8,") Q
         .Q:$$DIC(OCXGREF,OCXVAL,0)
         .S OCXIEN=$$DIC(OCXGREF,OCXVAL,1)
         .S ^TMP("OCXRULE",$J,"B",OCXPTR,OCXVAL,OCXIEN)=""
         ;
         S OCXSCR=1
         D ^DIE
         ;
         ; I $D(Y) -> DIE FILER ERROR
         I $D(Y) W "   ^DIE filer data error..." S OCXDIER=$G(OCXDIER)+1
         I '$D(Y) W "    ...Correct data Filed"
         ;
         Q
         ;
DIC(DIC,X,OCXADD) --
          N OCXSCR S DIC(0)="",OCXSCR=1 S:OCXADD DIC(0)="L" D ^DIC Q:(+Y>0) +Y Q
 
          0
         ;
PUSH(OCXDA) --
          ;
         N OCXSUB S OCXSUB="" F  S OCXSUB=$O(OCXDA(OCXSUB),-1) Q:'OCXSUB  S OCXD
          A(OCXSUB+1)=OCXDA(OCXSUB)
         S OCXDA(1)=OCXDA,OCXDA=0
         Q
         ;
POP(OCXDA) --
          ;
         N OCXSUB S OCXSUB="" F  S OCXSUB=$O(OCXDA(OCXSUB)) Q:'OCXSUB  S OCXDA(O
          CXSUB)=$G(OCXDA(OCXSUB+1))
         S OCXDA=OCXDA(1) K OCXDA($O(OCXDA(""),-1))
         Q
         ;
APPEND(ARRAY,OCXSUB) --
          ;
         S:'(OCXSUB=+OCXSUB) OCXSUB=""""_OCXSUB_""""
         Q:'(ARRAY["(") ARRAY_"("_OCXSUB_")"
         Q $E(ARRAY,1,$L(ARRAY)-1)_","_OCXSUB_")"
         ;
READ(OCXZ0,OCXZA,OCXZB,OCXZL) --
          ;
         N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
         Q:'$L($G(OCXZ0)) U
         S DIR(0)=OCXZ0
         S:$L($G(OCXZA)) DIR("A")=OCXZA
         S:$L($G(OCXZB)) DIR("B")=OCXZB
         F OCXLINE=1:1:($G(OCXZL)-1) W !
         D ^DIR
         I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
         Q Y
         ;
PAUSE()  W "  Press Enter " R X:DTIME W ! Q (X[U)
         ;

*****   INDEX OF ORY4272   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
   %DT          DATE~*
   ARRAY        APPEND~,APPEND+2,APPEND+3
   D0           DIE+2~,DIE+3*,DIE+4*
   DA           WORD~,WORD+4,DIE+2~,DIE+3*
   DD           WORD~,WORD+3,WORD+5,WORD+6
   DDPATH       LOADWORD+2~,LOADWORD+3*,LOADWORD+4,LOADWORD+8
   DIC          DIE+2~,DIE+3*,DIC~
   DIC(0        DIC*
   DIE          DIE+2~,DIE+3*
   DIR          READ+1~
   DIR("A"      READ+4*
   DIR("B"      READ+5*
   DIR(0        READ+3*
   DIROUT       READ+1~,READ+8
   DIRUT        READ+1~,READ+8
   DR           DIE+2~,DIE+3*,DIE+4*,DIE+5*
   DTIME        PAUSE
   DTOUT        READ+1~,READ+8
   DUOUT        READ+1~,READ+8
   FLD          WORD~,WORD+3,WORD+5,WORD+6
   GLROOT       WORD+2~,WORD+4*,WORD+6,WORD+7
   GREF         WORD~,WORD+4
   INDEX        LOADWORD+2~,LOADWORD+4*
   LINE         WORD+2~,WORD+5*,WORD+6,WORD+7*
   OCXADD       DIC~
   OCXCREF      ADDREC~,ADDREC+3,ADDREC+4,ADDREC+9,CREATE~,CREATE+6,CREATE+18
                CREATE+19,CREATE+20,CREATE+23,CREATE+24
   OCXDA        ADDREC+2~,ADDREC+9*,CREATE~,CREATE+4,CREATE+7,CREATE+8
                CREATE+9*,CREATE+10*,CREATE+11*,CREATE+12*,CREATE+14,CREATE+19
                CREATE+20,CREATE+22,CREATE+24*,CREATE+25,LOADWORD+2~
                LOADWORD+5*,LOADWORD+8,LOADWORD+9,GETREF~,GETREF+5,DIE~,DIE+3
                PUSH~,PUSH+2*,POP~,POP+2*
   OCXDA(       LOADWORD+4*,PUSH+1*,POP+1*,POP+2!
   OCXDA(""     POP+2
   OCXDA(0      LOADWORD+5!
   OCXDA(1      DIE+4,PUSH+2*,POP+2
   OCXDD        ADDREC+2~,ADDREC+3*,ADDREC+4,ADDREC+9,ADDREC+10,CREATE~
                CREATE+6,CREATE+7,CREATE+9,CREATE+16,CREATE+18,CREATE+19
                CREATE+20,CREATE+23,CREATE+24,LOADWORD~,LOADWORD+3,LOADWORD+7
                LOADWORD+8,LOADWORD+9,GETREF~,GETREF+2,GETREF+6,DIE~,DIE+6
                DIE+10,DIE+12
   OCXDIC       DIE~,DIE+3
>> OCXDIER      DIE+22*
   OCXDVAL      DIE+2~
   OCXERR       GETREF+4~,GETREF+5*,GETREF+6
>> OCXFLAG      ADDREC+7,LOADWORD+6,LOADWORD+7
   OCXFLD       CREATE+2~,CREATE+18*,CREATE+19,CREATE+20,CREATE+23*,CREATE+24
                LOADWORD~,LOADWORD+7,LOADWORD+9,DIE~,DIE+5,DIE+6,DIE+10,DIE+12
   OCXGREF      ADDREC+2~,CREATE+2~,CREATE+7*,CREATE+10,CREATE+11,CREATE+12
                CREATE+16,CREATE+19,CREATE+20,LOADWORD+2~,LOADWORD+8*
                LOADWORD+9,DIE+2~,DIE+12*,DIE+13,DIE+14,DIE+15
   OCXIEN       DIE+9~,DIE+15*,DIE+16
   OCXIENS      GETREF+4~,GETREF+5*,GETREF+6
   OCXKEY       CREATE+2~,CREATE+6*,CREATE+9
   OCXLINE      READ+1~,READ+6*
   OCXLVL       CREATE~,CREATE+7,CREATE+19,CREATE+24,GETREF~,DIE~,DIE+4,DIE+6
   OCXNAME      ADDREC+2~,ADDREC+4*,ADDREC+10
   OCXPTR       DIE+2~,DIE+10*,DIE+11,DIE+16
   OCXSCR       DIE+2~,DIE+18*,DIC~*
   OCXSUB       LOADWORD~,PUSH+1~*,POP+1~*,APPEND~,APPEND+1*,APPEND+2,APPEND+3
   OCXVAL       DIE~,DIE+5*,DIE+6,DIE+8,DIE+14,DIE+15,DIE+16
   OCXX         GETREF+4~,GETREF+6*,GETREF+7
   OCXZ0        READ~,READ+2,READ+3
   OCXZA        READ~,READ+4
   OCXZB        READ~,READ+5
   OCXZL        READ~,READ+6
   QUIT         ADDREC+2~,LOADWORD+2~,LOADWORD+7*
   RREF         LOADWORD~,LOADWORD+3,LOADWORD+9,WORD~,WORD+5,WORD+6
   SHORT        DIE+9~
   SUB          WORD+2~,WORD+3*,WORD+4
   U            CREATE+16,LOADWORD+7,WORD+7,READ+2,READ+8,PAUSE
   X            DATE~,DIE+2~,DIC~,PAUSE*
   Y            DATE~,DIE+2~,DIE+22,DIE+23,DIC,READ+9

Global Variables  ( * Changed  ! Killed)
   ^TMP("OCXRULE"      ADDREC+10*,CREATE+9,DIE+16*

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   NONE

Label References
   $$APPEND     CREATE+24,LOADWORD+3
   $$DATE       WORD+7
   $$DIC        DIE+14,DIE+15
   $$GETREF     CREATE+7,LOADWORD+8
   $$READ       LOADWORD+7
   CREATE       ADDREC+9,CREATE+24
   DIE          CREATE+19
   POP          CREATE+25
   PUSH         CREATE+22
   WORD         CREATE+20,LOADWORD+9

External References
   ^%DT                DATE
   ^DIC                DIC
   ^DIE                DIE+19
   $$IENS^DILF         GETREF+5
   $$ROOT^DILFD        GETREF+6
   ^DIR                READ+7
   $$FIELD^OCXSENDD    LOADWORD+7,WORD+3,DIE+6,DIE+10,DIE+12
   $$FILEHDR^OCXSENDD  CREATE+16
   $$EXFLD^ORY4271     CREATE+18

*****   END   *****
ORY4273   2931     printed  Jun 28, 2016@13:15:59                      Page 26

ORY4273   ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Instal
l of OR*3*427) ;MAY 10,2016 at 13:31
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 +3       ;
S         ;
 +1       ;  Multiple Utilities
 +2        QUIT 
 +3       ;
ADDMULT(OCXCREF,OCXDD,OCXFLD) ;
 +1       ;
 +2       ;
 +3        NEW QUIT,OCXDA,OCXGREF,OCXNAME,DDPATH,INDEX
 +4       ;
 +5        SET DDPATH=$PIECE($PIECE($$APPEND($$APPEND(OCXCREF,OCXDD),OCXFLD),"("
,2),")",1)
 +6        FOR INDEX=1:1:$LENGTH(DDPATH,",")
               SET OCXDA($LENGTH(DDPATH,",")-INDEX)=+$PIECE($PIECE(DDPATH,",",IN
DEX),":",2)
 +7        SET OCXDA=$GET(OCXDA(0))
           KILL OCXDA(0)
 +8       ;
 +9        IF (OCXFLAG["D")
               QUIT 0
 +10       IF (OCXFLAG["A")
               SET QUIT=$$READ("Y"," Do you want to add a local '"_$$FILENAME^OC
XSENDD(+OCXFLD)_"' multiple ?","YES")
               IF 'QUIT
                   QUIT (QUIT[U)
 +11      ;
 +12       SET OCXGREF=$$GETREF^ORY4272(+OCXFLD,.OCXDA,1)
 +13       DO CREATE($$APPEND(OCXCREF,OCXDD),OCXFLD,.OCXDA,1)
 +14      ;
 +15       QUIT 0
 +16      ;
DELMULT(OCXCREF,OCXDD) ;
 +1       ;
 +2        NEW QUIT,OCXGREF,DA,INDEX,DDPATH
 +3       ;
 +4        IF (OCXFLAG["D")
               QUIT 0
 +5        IF (OCXFLAG["A")
               SET QUIT=$$READ("Y"," Do you want to delete the local '"_$$FILENA
ME^OCXSENDD(+OCXDD)_"' multiple ?","YES")
               IF 'QUIT
                   QUIT (QUIT[U)
 +6       ;
 +7        SET DDPATH=$PIECE($PIECE($$APPEND(OCXCREF,OCXDD),"(",2),")",1)
 +8        FOR INDEX=1:1:$LENGTH(DDPATH,",")
               SET DA($LENGTH(DDPATH,",")-INDEX)=+$PIECE($PIECE(DDPATH,",",INDEX
),":",2)
 +9        SET DA=$GET(DA(0))
           KILL DA(0)
 +10       SET OCXGREF=$$GETREF^ORY4272(+OCXDD,.DA,1)
 +11      ;
 +12       DO DIE^ORY4272(+OCXDD,OCXGREF,.01,"@",.DA,$LENGTH(DDPATH,",")-1)
 +13       KILL @OCXCREF@(OCXDD)
           WRITE !!,"  deleted..."
 +14      ;
 +15       QUIT 0
 +16      ;
CREATE(OCXCREF,OCXDD,OCXDA,OCXLVL) ;
 +1       ;
 +2        NEW OCXFLD,OCXGREF
 +3       ;
 +4        SET OCXGREF=$$GETREF^ORY4272(+OCXDD,.OCXDA,OCXLVL)
           IF '$LENGTH(OCXGREF)
               QUIT 
           IF 'OCXDA
               SET OCXDA=$ORDER(@(OCXGREF_"""@"")"),-1)+1
 +5       ;
 +6        IF '$DATA(@(OCXGREF_"0)"))
               SET @(OCXGREF_"0)")=U_$$FILEHDR^OCXSENDD(+OCXDD)_U_U
 +7       ;
 +8        SET OCXFLD=0
           FOR 
               SET OCXFLD=$ORDER(@OCXCREF@(OCXDD,OCXFLD))
               IF 'OCXFLD
                   QUIT 
               IF (OCXFLD["
                   QUIT 
               IF '$$EXFLD^ORY4271(+OCXDD,OCXFLD)
                   Begin DoDot:1
 +9                    IF $LENGTH($GET(@OCXCREF@(OCXDD,OCXFLD,"E")))
                           DO DIE^ORY4272(OCXDD,OCXGREF,OCXFLD,@OCXCREF@(OCXDD,O
CXFLD,"E"),.OCXDA,OCXLVL)
                   End DoDot:1
 +10      ;
 +11       DO PUSH(.OCXDA)
 +12       SET OCXFLD=""
           FOR 
               SET OCXFLD=$ORDER(@OCXCREF@(OCXDD,OCXFLD))
               IF '$LENGTH(OCXFLD)
                   QUIT 
               IF (OCXFLD[":")
                   Begin DoDot:1
 +13                   SET OCXDA=$PIECE(OCXFLD,":",2)
                       WRITE !
                       DO CREATE($$APPEND(OCXCREF,OCXDD),OCXFLD,.OCXDA,OCXLVL+1)
                   End DoDot:1
 +14       DO POP(.OCXDA)
 +15       QUIT 
 +16      ;
PUSH(OCXDA) ;
 +1        NEW OCXSUB
           SET OCXSUB=""
           FOR 
               SET OCXSUB=$ORDER(OCXDA(OCXSUB),-1)
               IF 'OCXSUB
                   QUIT 
               SET OCXDA(OCXSUB+1)=OCXDA(OCXSUB)
 +2        SET OCXDA(1)=OCXDA
           SET OCXDA=0
 +3        QUIT 
 +4       ;
POP(OCXDA) ;
 +1        NEW OCXSUB
           SET OCXSUB=""
           FOR 
               SET OCXSUB=$ORDER(OCXDA(OCXSUB))
               IF 'OCXSUB
                   QUIT 
               SET OCXDA(OCXSUB)=$GET(OCXDA(OCXSUB+1))
 +2        SET OCXDA=OCXDA(1)
           KILL OCXDA($ORDER(OCXDA(""),-1))
 +3        QUIT 
 +4       ;
APPEND(ARRAY,OCXSUB) ;
 +1        IF '(OCXSUB=+OCXSUB)
               SET OCXSUB=""""_OCXSUB_""""
 +2        IF '(ARRAY["(")
               QUIT ARRAY_"("_OCXSUB_")"
 +3        QUIT $EXTRACT(ARRAY,1,$LENGTH(ARRAY)-1)_","_OCXSUB_")"
 +4       ;
READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
 +1        NEW OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
 +2        IF '$LENGTH($GET(OCXZ0))
               QUIT U
 +3        SET DIR(0)=OCXZ0
 +4        IF $LENGTH($GET(OCXZA))
               SET DIR("A")=OCXZA
 +5        IF $LENGTH($GET(OCXZB))
               SET DIR("B")=OCXZB
 +6        FOR OCXLINE=1:1:($GET(OCXZL)-1)
               WRITE !
 +7        DO ^DIR
 +8        IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
               QUIT U
 +9        QUIT Y
 +10      ;
PAUSE()    WRITE "  Press Enter "
           READ X:DTIME
           WRITE !
           QUIT (X[U)
 +1       ;


ORY4273  * *  87 Lines,  2931 Bytes, Checksum: B12998366
                                                  Jun 28, 2016@13:15:59 page 27
              161 bytes in comments
ORY4273  ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install
           of OR*3*427) ;MAY 10,2016 at 13:31
         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
         ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
         ;
S        ;
         ;  Multiple Utilities
         Q
         ;
ADDMULT(OCXCREF,OCXDD,OCXFLD) --
          ;
         ;
         ;
         N QUIT,OCXDA,OCXGREF,OCXNAME,DDPATH,INDEX
         ;
         S DDPATH=$P($P($$APPEND($$APPEND(OCXCREF,OCXDD),OCXFLD),"(",2),")",1)
         F INDEX=1:1:$L(DDPATH,",") S OCXDA($L(DDPATH,",")-INDEX)=+$P($P(DDPATH,
          ",",INDEX),":",2)
         S OCXDA=$G(OCXDA(0)) K OCXDA(0)
         ;
         Q:(OCXFLAG["D") 0
         I (OCXFLAG["A") S QUIT=$$READ("Y"," Do you want to add a local '"_$$FIL
          ENAME^OCXSENDD(+OCXFLD)_"' multiple ?","YES") Q:'QUIT (QUIT[U)
         ;
         S OCXGREF=$$GETREF^ORY4272(+OCXFLD,.OCXDA,1)
         D CREATE($$APPEND(OCXCREF,OCXDD),OCXFLD,.OCXDA,1)
         ;
         Q 0
         ;
DELMULT(OCXCREF,OCXDD) --
          ;
         ;
         N QUIT,OCXGREF,DA,INDEX,DDPATH
         ;
         Q:(OCXFLAG["D") 0
         I (OCXFLAG["A") S QUIT=$$READ("Y"," Do you want to delete the local '"_
          $$FILENAME^OCXSENDD(+OCXDD)_"' multiple ?","YES") Q:'QUIT (QUIT[U)
         ;
         S DDPATH=$P($P($$APPEND(OCXCREF,OCXDD),"(",2),")",1)
         F INDEX=1:1:$L(DDPATH,",") S DA($L(DDPATH,",")-INDEX)=+$P($P(DDPATH,","
          ,INDEX),":",2)
         S DA=$G(DA(0)) K DA(0)
         S OCXGREF=$$GETREF^ORY4272(+OCXDD,.DA,1)
         ;
         D DIE^ORY4272(+OCXDD,OCXGREF,.01,"@",.DA,$L(DDPATH,",")-1)
         K @OCXCREF@(OCXDD) W !!,"  deleted..."
         ;
         Q 0
         ;
CREATE(OCXCREF,OCXDD,OCXDA,OCXLVL) --
          ;
         ;
         N OCXFLD,OCXGREF
         ;
         S OCXGREF=$$GETREF^ORY4272(+OCXDD,.OCXDA,OCXLVL) Q:'$L(OCXGREF)  S:'OCX
          DA OCXDA=$O(@(OCXGREF_"""@"")"),-1)+1
         ;
         I '$D(@(OCXGREF_"0)")) S @(OCXGREF_"0)")=U_$$FILEHDR^OCXSENDD(+OCXDD)_U
          _U
         ;
         S OCXFLD=0 F  S OCXFLD=$O(@OCXCREF@(OCXDD,OCXFLD)) Q:'OCXFLD  Q:(OCXFLD
          [":")  I '$$EXFLD^ORY4271(+OCXDD,OCXFLD) D
         .I $L($G(@OCXCREF@(OCXDD,OCXFLD,"E"))) D DIE^ORY4272(OCXDD,OCXGREF,OCXF
          LD,@OCXCREF@(OCXDD,OCXFLD,"E"),.OCXDA,OCXLVL)
         ;
         D PUSH(.OCXDA)
         S OCXFLD="" F  S OCXFLD=$O(@OCXCREF@(OCXDD,OCXFLD)) Q:'$L(OCXFLD)  I (O
          CXFLD[":") D
         .S OCXDA=$P(OCXFLD,":",2) W ! D CREATE($$APPEND(OCXCREF,OCXDD),OCXFLD,.
          OCXDA,OCXLVL+1)
         D POP(.OCXDA)
         Q
         ;
PUSH(OCXDA) --
          ;
         N OCXSUB S OCXSUB="" F  S OCXSUB=$O(OCXDA(OCXSUB),-1) Q:'OCXSUB  S OCXD
          A(OCXSUB+1)=OCXDA(OCXSUB)
         S OCXDA(1)=OCXDA,OCXDA=0
         Q
         ;
POP(OCXDA) --
          ;
         N OCXSUB S OCXSUB="" F  S OCXSUB=$O(OCXDA(OCXSUB)) Q:'OCXSUB  S OCXDA(O
          CXSUB)=$G(OCXDA(OCXSUB+1))
         S OCXDA=OCXDA(1) K OCXDA($O(OCXDA(""),-1))
         Q
         ;
APPEND(ARRAY,OCXSUB) --
          ;
         S:'(OCXSUB=+OCXSUB) OCXSUB=""""_OCXSUB_""""
         Q:'(ARRAY["(") ARRAY_"("_OCXSUB_")"
         Q $E(ARRAY,1,$L(ARRAY)-1)_","_OCXSUB_")"
         ;
READ(OCXZ0,OCXZA,OCXZB,OCXZL) --
          ;
         N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
         Q:'$L($G(OCXZ0)) U
         S DIR(0)=OCXZ0
         S:$L($G(OCXZA)) DIR("A")=OCXZA
         S:$L($G(OCXZB)) DIR("B")=OCXZB
         F OCXLINE=1:1:($G(OCXZL)-1) W !
         D ^DIR
         I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
         Q Y
         ;
PAUSE()  W "  Press Enter " R X:DTIME W ! Q (X[U)
         ;

*****   INDEX OF ORY4273   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
   ARRAY        APPEND~,APPEND+2,APPEND+3
   DA           DELMULT+2~,DELMULT+9*,DELMULT+10,DELMULT+12
   DA(          DELMULT+8*
   DA(0         DELMULT+9!
   DDPATH       ADDMULT+3~,ADDMULT+5*,ADDMULT+6,DELMULT+2~,DELMULT+7*,DELMULT+8
                DELMULT+12
   DIR          READ+1~
   DIR("A"      READ+4*
   DIR("B"      READ+5*
   DIR(0        READ+3*
   DIROUT       READ+1~,READ+8
   DIRUT        READ+1~,READ+8
   DTIME        PAUSE
   DTOUT        READ+1~,READ+8
   DUOUT        READ+1~,READ+8
   INDEX        ADDMULT+3~,ADDMULT+6*,DELMULT+2~,DELMULT+8*
   OCXCREF      ADDMULT~,ADDMULT+5,ADDMULT+13,DELMULT~,DELMULT+7,DELMULT+13
                CREATE~,CREATE+8,CREATE+9,CREATE+12,CREATE+13
   OCXDA        ADDMULT+3~,ADDMULT+7*,ADDMULT+12,ADDMULT+13,CREATE~,CREATE+4*
                CREATE+9,CREATE+11,CREATE+13*,CREATE+14,PUSH~,PUSH+2*,POP~
                POP+2*
   OCXDA(       ADDMULT+6*,PUSH+1*,POP+1*,POP+2!
   OCXDA(""     POP+2
   OCXDA(0      ADDMULT+7!
   OCXDA(1      PUSH+2*,POP+2
   OCXDD        ADDMULT~,ADDMULT+5,ADDMULT+13,DELMULT~,DELMULT+5,DELMULT+7
                DELMULT+10,DELMULT+12,DELMULT+13,CREATE~,CREATE+4,CREATE+6
                CREATE+8,CREATE+9,CREATE+12,CREATE+13
>> OCXFLAG      ADDMULT+9,ADDMULT+10,DELMULT+4,DELMULT+5
   OCXFLD       ADDMULT~,ADDMULT+5,ADDMULT+10,ADDMULT+12,ADDMULT+13,CREATE+2~
                CREATE+8*,CREATE+9,CREATE+12*,CREATE+13
   OCXGREF      ADDMULT+3~,ADDMULT+12*,DELMULT+2~,DELMULT+10*,DELMULT+12
                CREATE+2~,CREATE+4*,CREATE+6,CREATE+9
   OCXLINE      READ+1~,READ+6*
   OCXLVL       CREATE~,CREATE+4,CREATE+9,CREATE+13
   OCXNAME      ADDMULT+3~
   OCXSUB       PUSH+1~*,POP+1~*,APPEND~,APPEND+1*,APPEND+2,APPEND+3
   OCXZ0        READ~,READ+2,READ+3
   OCXZA        READ~,READ+4
   OCXZB        READ~,READ+5
   OCXZL        READ~,READ+6
   QUIT         ADDMULT+3~,ADDMULT+10*,DELMULT+2~,DELMULT+5*
   U            ADDMULT+10,DELMULT+5,CREATE+6,READ+2,READ+8,PAUSE
>> X            PAUSE*
>> Y            READ+9

Global Variables  ( * Changed  ! Killed)
   NONE

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   NONE

Label References
   $$APPEND     ADDMULT+5,ADDMULT+13,DELMULT+7,CREATE+13
   $$READ       ADDMULT+10,DELMULT+5
   CREATE       ADDMULT+13,CREATE+13
   POP          CREATE+14
   PUSH         CREATE+11

External References
   ^DIR                READ+7
   $$FILEHDR^OCXSENDD  CREATE+6
   $$FILENAME^OCXSENDD ADDMULT+10,DELMULT+5
   $$EXFLD^ORY4271     CREATE+8
   $$GETREF^ORY4272    ADDMULT+12,DELMULT+10,CREATE+4
   DIE^ORY4272         DELMULT+12,CREATE+9

*****   END   *****
ORY4274   3060     printed  Jun 28, 2016@13:15:59                      Page 28

ORY4274   ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Instal
l of OR*3*427) ;MAY 10,2016 at 13:31
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 +3       ;
S         ;
 +1       ;  Field Utilities
 +2        QUIT 
 +3       ;
EDITFLD(OCXCREF,OCXDD,OCXFLD,OCXSUB) ;
 +1       ;
 +2        NEW DDPATH,OCXDA,OCXPC,OCXLVL,QUIT
 +3       ;
 +4        SET QUIT=0
           SET DDPATH=$PIECE($PIECE($$APPEND(OCXCREF,OCXDD),"(",2),")",1)
 +5        SET OCXLVL=$LENGTH(DDPATH,",")
 +6        FOR OCXPC=1:1:OCXLVL
               SET OCXDA(OCXLVL-OCXPC)=+$PIECE($PIECE(DDPATH,",",OCXPC),":",2)
 +7        SET OCXDA=OCXDA(0)
           KILL OCXDA(0)
 +8        IF $LENGTH($GET(@OCXCREF@(OCXDD,OCXFLD,"E")))
               Begin DoDot:1
 +9                NEW RESP
 +10               IF (OCXFLAG["D")
                       QUIT 
 +11               IF (OCXFLAG["A")
                       SET RESP=$$READ("Y"," Do you want to change the local '"_
$$FILENAME^OCXSENDD(+OCXDD)_"' field ?","YES")
                       IF 'RESP
                           SET QUIT=(RESP[U)
                           QUIT 
 +12               SET OCXGREF=$$GETREF^ORY4272(+OCXDD,.OCXDA,OCXLVL-1)
                   IF '$LENGTH(OCXGREF)
                       QUIT 
 +13               DO DIE^ORY4272(OCXDD,OCXGREF,OCXFLD,@OCXCREF@(OCXDD,OCXFLD,"E
"),.OCXDA,OCXLVL-1)
               End DoDot:1
 +14      ;
 +15       QUIT QUIT
 +16      ;
DELFLD(OCXCREF,OCXDD,OCXFLD,OCXSUB) ;
 +1       ;
 +2        NEW DDPATH,OCXDA,OCXPC,OCXLVL,QUIT,RESP
 +3       ;
 +4        SET QUIT=0
           SET DDPATH=$PIECE($PIECE($$APPEND(OCXCREF,OCXDD),"(",2),")",1)
 +5        SET OCXLVL=$LENGTH(DDPATH,",")
 +6        FOR OCXPC=1:1:OCXLVL
               SET OCXDA(OCXLVL-OCXPC)=+$PIECE($PIECE(DDPATH,",",OCXPC),":",2)
 +7        SET OCXDA=OCXDA(0)
           KILL OCXDA(0)
 +8        IF (OCXFLAG["D")
               QUIT 0
 +9        IF (OCXFLAG["A")
               SET RESP=$$READ("Y"," Do you want to Delete the local '"_$$FILENA
ME^OCXSENDD(+OCXDD)_"' value ?","YES")
               IF 'RESP
                   SET QUIT=(RESP[U)
                   QUIT QUIT
 +10       SET OCXGREF=$$GETREF^ORY4272(+OCXDD,.OCXDA,OCXLVL-1)
           IF '$LENGTH(OCXGREF)
               QUIT 
 +11       DO DIE^ORY4272(OCXDD,OCXGREF,OCXFLD,"@",.OCXDA,OCXLVL-1)
 +12      ;
 +13       QUIT QUIT
 +14      ;
CREATE(OCXCREF,OCXDD,OCXDA,OCXLVL) ;
 +1       ;
 +2        NEW OCXFLD,OCXGREF
 +3       ;
 +4        SET OCXGREF=$$GETREF^ORY4272(+OCXDD,.OCXDA,OCXLVL)
           IF '$LENGTH(OCXGREF)
               QUIT 
           IF 'OCXDA
               SET OCXDA=$ORDER(@(OCXGREF_"""@"")"),-1)+1
 +5       ;
 +6        IF '$DATA(@(OCXGREF_"0)"))
               SET @(OCXGREF_"0)")=U_$$FILEHDR^OCXSENDD(+OCXDD)_U_U
 +7       ;
 +8        SET OCXFLD=0
           FOR 
               SET OCXFLD=$ORDER(@OCXCREF@(OCXDD,OCXFLD))
               IF 'OCXFLD
                   QUIT 
               IF (OCXFLD["
                   QUIT 
               IF '$$EXFLD^ORY4271(+OCXDD,OCXFLD)
                   Begin DoDot:1
 +9                    IF $LENGTH($GET(@OCXCREF@(OCXDD,OCXFLD,"E")))
                           DO DIE^ORY4272(OCXDD,OCXGREF,OCXFLD,@OCXCREF@(OCXDD,O
CXFLD,"E"),.OCXDA,OCXLVL)
                   End DoDot:1
 +10      ;
 +11       DO PUSH(.OCXDA)
 +12       SET OCXFLD=""
           FOR 
               SET OCXFLD=$ORDER(@OCXCREF@(OCXDD,OCXFLD))
               IF '$LENGTH(OCXFLD)
                   QUIT 
               IF (OCXFLD[":")
                   Begin DoDot:1
 +13                   SET OCXDA=$PIECE(OCXFLD,":",2)
                       WRITE !
                       DO CREATE($$APPEND(OCXCREF,OCXDD),OCXFLD,.OCXDA,OCXLVL+1)
                   End DoDot:1
 +14       DO POP(.OCXDA)
 +15       QUIT 
 +16      ;
PUSH(OCXDA) ;
 +1        NEW OCXSUB
           SET OCXSUB=""
           FOR 
               SET OCXSUB=$ORDER(OCXDA(OCXSUB),-1)
               IF 'OCXSUB
                   QUIT 
               SET OCXDA(OCXSUB+1)=OCXDA(OCXSUB)
 +2        SET OCXDA(1)=OCXDA
           SET OCXDA=0
 +3        QUIT 
 +4       ;
POP(OCXDA) ;
 +1        NEW OCXSUB
           SET OCXSUB=""
           FOR 
               SET OCXSUB=$ORDER(OCXDA(OCXSUB))
               IF 'OCXSUB
                   QUIT 
               SET OCXDA(OCXSUB)=$GET(OCXDA(OCXSUB+1))
 +2        SET OCXDA=OCXDA(1)
           KILL OCXDA($ORDER(OCXDA(""),-1))
 +3        QUIT 
 +4       ;
APPEND(ARRAY,OCXSUB) ;
 +1        IF '(OCXSUB=+OCXSUB)
               SET OCXSUB=""""_OCXSUB_""""
 +2        IF '(ARRAY["(")
               QUIT ARRAY_"("_OCXSUB_")"
 +3        QUIT $EXTRACT(ARRAY,1,$LENGTH(ARRAY)-1)_","_OCXSUB_")"
 +4       ;
READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
 +1        NEW OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
 +2        IF '$LENGTH($GET(OCXZ0))
               QUIT U
 +3        SET DIR(0)=OCXZ0
 +4        IF $LENGTH($GET(OCXZA))
               SET DIR("A")=OCXZA
 +5        IF $LENGTH($GET(OCXZB))
               SET DIR("B")=OCXZB
 +6        FOR OCXLINE=1:1:($GET(OCXZL)-1)
               WRITE !
 +7        DO ^DIR
 +8        IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
               QUIT U
 +9        QUIT Y
 +10      ;
PAUSE()    WRITE "  Press Enter "
           READ X:DTIME
           WRITE !
           QUIT (X[U)
 +1       ;


ORY4274  * *  85 Lines,  3060 Bytes, Checksum: B13528386
                                                  Jun 28, 2016@13:15:59 page 29
              153 bytes in comments
ORY4274  ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install
           of OR*3*427) ;MAY 10,2016 at 13:31
         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
         ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
         ;
S        ;
         ;  Field Utilities
         Q
         ;
EDITFLD(OCXCREF,OCXDD,OCXFLD,OCXSUB) --
          ;
         ;
         N DDPATH,OCXDA,OCXPC,OCXLVL,QUIT
         ;
         S QUIT=0,DDPATH=$P($P($$APPEND(OCXCREF,OCXDD),"(",2),")",1)
         S OCXLVL=$L(DDPATH,",")
         F OCXPC=1:1:OCXLVL S OCXDA(OCXLVL-OCXPC)=+$P($P(DDPATH,",",OCXPC),":",2
          )
         S OCXDA=OCXDA(0) K OCXDA(0)
         I $L($G(@OCXCREF@(OCXDD,OCXFLD,"E"))) D
         .N RESP
         .Q:(OCXFLAG["D")
         .I (OCXFLAG["A") S RESP=$$READ("Y"," Do you want to change the local '"
          _$$FILENAME^OCXSENDD(+OCXDD)_"' field ?","YES") I 'RESP S QUIT=(RESP[U
          ) Q
         .S OCXGREF=$$GETREF^ORY4272(+OCXDD,.OCXDA,OCXLVL-1) Q:'$L(OCXGREF)
         .D DIE^ORY4272(OCXDD,OCXGREF,OCXFLD,@OCXCREF@(OCXDD,OCXFLD,"E"),.OCXDA,
          OCXLVL-1)
         ;
         Q QUIT
         ;
DELFLD(OCXCREF,OCXDD,OCXFLD,OCXSUB) --
          ;
         ;
         N DDPATH,OCXDA,OCXPC,OCXLVL,QUIT,RESP
         ;
         S QUIT=0,DDPATH=$P($P($$APPEND(OCXCREF,OCXDD),"(",2),")",1)
         S OCXLVL=$L(DDPATH,",")
         F OCXPC=1:1:OCXLVL S OCXDA(OCXLVL-OCXPC)=+$P($P(DDPATH,",",OCXPC),":",2
          )
         S OCXDA=OCXDA(0) K OCXDA(0)
         Q:(OCXFLAG["D") 0
         I (OCXFLAG["A") S RESP=$$READ("Y"," Do you want to Delete the local '"_
          $$FILENAME^OCXSENDD(+OCXDD)_"' value ?","YES") I 'RESP S QUIT=(RESP[U)
           Q QUIT
         S OCXGREF=$$GETREF^ORY4272(+OCXDD,.OCXDA,OCXLVL-1) Q:'$L(OCXGREF)
         D DIE^ORY4272(OCXDD,OCXGREF,OCXFLD,"@",.OCXDA,OCXLVL-1)
         ;
         Q QUIT
         ;
CREATE(OCXCREF,OCXDD,OCXDA,OCXLVL) --
          ;
         ;
         N OCXFLD,OCXGREF
         ;
         S OCXGREF=$$GETREF^ORY4272(+OCXDD,.OCXDA,OCXLVL) Q:'$L(OCXGREF)  S:'OCX
          DA OCXDA=$O(@(OCXGREF_"""@"")"),-1)+1
         ;
         I '$D(@(OCXGREF_"0)")) S @(OCXGREF_"0)")=U_$$FILEHDR^OCXSENDD(+OCXDD)_U
          _U
         ;
         S OCXFLD=0 F  S OCXFLD=$O(@OCXCREF@(OCXDD,OCXFLD)) Q:'OCXFLD  Q:(OCXFLD
          [":")  I '$$EXFLD^ORY4271(+OCXDD,OCXFLD) D
         .I $L($G(@OCXCREF@(OCXDD,OCXFLD,"E"))) D DIE^ORY4272(OCXDD,OCXGREF,OCXF
          LD,@OCXCREF@(OCXDD,OCXFLD,"E"),.OCXDA,OCXLVL)
         ;
         D PUSH(.OCXDA)
         S OCXFLD="" F  S OCXFLD=$O(@OCXCREF@(OCXDD,OCXFLD)) Q:'$L(OCXFLD)  I (O
          CXFLD[":") D
         .S OCXDA=$P(OCXFLD,":",2) W ! D CREATE($$APPEND(OCXCREF,OCXDD),OCXFLD,.
          OCXDA,OCXLVL+1)
         D POP(.OCXDA)
         Q
         ;
PUSH(OCXDA) --
          ;
         N OCXSUB S OCXSUB="" F  S OCXSUB=$O(OCXDA(OCXSUB),-1) Q:'OCXSUB  S OCXD
          A(OCXSUB+1)=OCXDA(OCXSUB)
         S OCXDA(1)=OCXDA,OCXDA=0
         Q
         ;
POP(OCXDA) --
          ;
         N OCXSUB S OCXSUB="" F  S OCXSUB=$O(OCXDA(OCXSUB)) Q:'OCXSUB  S OCXDA(O
          CXSUB)=$G(OCXDA(OCXSUB+1))
         S OCXDA=OCXDA(1) K OCXDA($O(OCXDA(""),-1))
         Q
         ;
APPEND(ARRAY,OCXSUB) --
          ;
         S:'(OCXSUB=+OCXSUB) OCXSUB=""""_OCXSUB_""""
         Q:'(ARRAY["(") ARRAY_"("_OCXSUB_")"
         Q $E(ARRAY,1,$L(ARRAY)-1)_","_OCXSUB_")"
         ;
READ(OCXZ0,OCXZA,OCXZB,OCXZL) --
          ;
         N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
         Q:'$L($G(OCXZ0)) U
         S DIR(0)=OCXZ0
         S:$L($G(OCXZA)) DIR("A")=OCXZA
         S:$L($G(OCXZB)) DIR("B")=OCXZB
         F OCXLINE=1:1:($G(OCXZL)-1) W !
         D ^DIR
         I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
         Q Y
         ;
PAUSE()  W "  Press Enter " R X:DTIME W ! Q (X[U)
         ;

*****   INDEX OF ORY4274   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
   ARRAY        APPEND~,APPEND+2,APPEND+3
   DDPATH       EDITFLD+2~,EDITFLD+4*,EDITFLD+5,EDITFLD+6,DELFLD+2~,DELFLD+4*
                DELFLD+5,DELFLD+6
   DIR          READ+1~
   DIR("A"      READ+4*
   DIR("B"      READ+5*
   DIR(0        READ+3*
   DIROUT       READ+1~,READ+8
   DIRUT        READ+1~,READ+8
   DTIME        PAUSE
   DTOUT        READ+1~,READ+8
   DUOUT        READ+1~,READ+8
   OCXCREF      EDITFLD~,EDITFLD+4,EDITFLD+8,EDITFLD+13,DELFLD~,DELFLD+4
                CREATE~,CREATE+8,CREATE+9,CREATE+12,CREATE+13
   OCXDA        EDITFLD+2~,EDITFLD+7*,EDITFLD+12,EDITFLD+13,DELFLD+2~,DELFLD+7*
                DELFLD+10,DELFLD+11,CREATE~,CREATE+4*,CREATE+9,CREATE+11
                CREATE+13*,CREATE+14,PUSH~,PUSH+2*,POP~,POP+2*
   OCXDA(       EDITFLD+6*,DELFLD+6*,PUSH+1*,POP+1*,POP+2!
   OCXDA(""     POP+2
   OCXDA(0      EDITFLD+7!,DELFLD+7!
   OCXDA(1      PUSH+2*,POP+2
   OCXDD        EDITFLD~,EDITFLD+4,EDITFLD+8,EDITFLD+11,EDITFLD+12,EDITFLD+13
                DELFLD~,DELFLD+4,DELFLD+9,DELFLD+10,DELFLD+11,CREATE~,CREATE+4
                CREATE+6,CREATE+8,CREATE+9,CREATE+12,CREATE+13
>> OCXFLAG      EDITFLD+10,EDITFLD+11,DELFLD+8,DELFLD+9
   OCXFLD       EDITFLD~,EDITFLD+8,EDITFLD+13,DELFLD~,DELFLD+11,CREATE+2~
                CREATE+8*,CREATE+9,CREATE+12*,CREATE+13
   OCXGREF      EDITFLD+12*,EDITFLD+13,DELFLD+10*,DELFLD+11,CREATE+2~,CREATE+4*
                CREATE+6,CREATE+9
   OCXLINE      READ+1~,READ+6*
   OCXLVL       EDITFLD+2~,EDITFLD+5*,EDITFLD+6,EDITFLD+12,EDITFLD+13,DELFLD+2~
                DELFLD+5*,DELFLD+6,DELFLD+10,DELFLD+11,CREATE~,CREATE+4
                CREATE+9,CREATE+13
   OCXPC        EDITFLD+2~,EDITFLD+6*,DELFLD+2~,DELFLD+6*
   OCXSUB       EDITFLD~,DELFLD~,PUSH+1~*,POP+1~*,APPEND~,APPEND+1*,APPEND+2
                APPEND+3
   OCXZ0        READ~,READ+2,READ+3
   OCXZA        READ~,READ+4
   OCXZB        READ~,READ+5
   OCXZL        READ~,READ+6
   QUIT         EDITFLD+2~,EDITFLD+4*,EDITFLD+11*,EDITFLD+15,DELFLD+2~
                DELFLD+4*,DELFLD+9*,DELFLD+13
   RESP         EDITFLD+9~,EDITFLD+11*,DELFLD+2~,DELFLD+9*
   U            EDITFLD+11,DELFLD+9,CREATE+6,READ+2,READ+8,PAUSE
>> X            PAUSE*
>> Y            READ+9

Global Variables  ( * Changed  ! Killed)
   NONE

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   NONE

Label References
   $$APPEND     EDITFLD+4,DELFLD+4,CREATE+13
   $$READ       EDITFLD+11,DELFLD+9
   CREATE       CREATE+13
   POP          CREATE+14
   PUSH         CREATE+11

External References
   ^DIR                READ+7
   $$FILEHDR^OCXSENDD  CREATE+6
   $$FILENAME^OCXSENDD EDITFLD+11,DELFLD+9
   $$EXFLD^ORY4271     CREATE+8
   $$GETREF^ORY4272    EDITFLD+12,DELFLD+10,CREATE+4
   DIE^ORY4272         EDITFLD+13,DELFLD+11,CREATE+9

*****   END   *****
ORY427ES   3169     printed  Jun 28, 2016@13:15:59                     Page 30

ORY427ES  ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Instal
l of OR*3*427) ;MAY 10,2016 at 13:31
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 +3       ;
S         ;
 +1       ;
 +2        NEW OCXDIER,QUIT,LINE,TEXT,REMOTE,LOCAL,D0,OPCODE,REF,OCXFLAG
           SET QUIT=0
 +3        NEW OCXAUTO,OCZSCR
 +4       ;
 +5        DO DOT
 +6        IF $LENGTH($TEXT(VERSION^OCXOCMP))
               IF ($$VERSION^OCXOCMP="ORDER CHECK EXPERT version 1.01 released O
CT 29,1998")
                   IF 1
 +7       IF '$TEST
               Begin DoDot:1
 +8                WRITE !
 +9                WRITE !,"Rule Transport aborted, version mismatch."
 +10               WRITE !,"Current Local version: ",$$VERSION^OCXOCMP
 +11               WRITE !,"   Rule Transport Version: ORDER CHECK EXPERT versio
n 1.01 released OCT 29,1998"
               End DoDot:1
               QUIT 
 +12       IF '$DATA(DTIME)
               WRITE !!,"DTIME not defined !!",!!
               QUIT 
 +13       WRITE !!,"Order Check Expert System Rule Transporter"
 +14       WRITE !," Created: MAY 10,2016 at 13:31  at  NCCLAB1.AAC.DNS   "
 +15       WRITE !," Current Date: ",$$NOW^ORY4270,"  at  ",$$NETNAME^OCXSEND,!!
 +16       SET LASTFILE=0
           KILL ^TMP("OCXRULE",$JOB)
 +17       SET ^TMP("OCXRULE",$JOB)=($PIECE($HOROLOG,",",2)+($HOROLOG*86400)+(1*
60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
 +18       SET OCXFLAG="O"
 +19      ;
RUN       ;
 +1       ;
 +2        WRITE !,"Loading Data "
           DO ^ORY42701
 +3       ;
 +4        SET LINE=0
           FOR 
               SET LINE=$ORDER(^TMP("OCXRULE",$JOB,LINE))
               IF 'LINE
                   QUIT 
               Begin DoDot:1
 +5                IF '(LINE#50)
                       DO STATUS^OCXOPOST(LINE,$ORDER(^TMP("OCXRULE",$JOB," "),-
1))
 +6                SET TEXT=$GET(^TMP("OCXRULE",$JOB,LINE))
                   IF $LENGTH(TEXT)
                       Begin DoDot:2
 +7                        SET TEXT=$PIECE(TEXT,";",2,999)
                           SET OPCODE=$PIECE(TEXT,U,1)
                           SET TEXT=$PIECE(TEXT,U,2,999)
 +8       ;
 +9                        IF OPCODE="KEY"
                               DO DOT
                               SET LOCAL=""
                               SET D0=$$GETFILE^ORY4270(+$PIECE(TEXT,U,1),$PIECE
(TEXT,U,2),.LOCAL)
                               SET QUIT=(D0=(-10))
                               QUIT 
 +10                       IF OPCODE="R"
                               SET REF="REMOTE("_$PIECE(TEXT,":",1)_":"_D0_$PIEC
E(TEXT,":",2,99)_")"
                               QUIT 
 +11                       IF OPCODE="D"
                               IF $DATA(REF)
                                   SET @REF=$PIECE(TEXT,U,1,999)
                                   KILL REF
                                   QUIT 
 +12      ;
 +13                       IF OPCODE="EOR"
                               SET QUIT=$$COMPARE^ORY4271(.LOCAL,.REMOTE)
                               KILL LOCAL,REMOTE
                               QUIT 
 +14                       IF OPCODE="EOF"
                               KILL LOCAL,REMOTE
                               QUIT 
 +15                       IF OPCODE="SOF"
                               WRITE !,"  Installing '",TEXT,"' records... "
                               QUIT 
 +16                       IF OPCODE="ROOT"
                               Begin DoDot:3
 +17                               NEW FILE,DATA
 +18                               SET FILE=U_$PIECE(TEXT,U,1)
                                   SET DATA=$PIECE(TEXT,U,2,3)
 +19                               IF ($PIECE($GET(@FILE),U,1,2)=DATA)
                                       QUIT 
 +20                               SET $PIECE(@FILE,U,1,2)=DATA
 +21                               WRITE !,"  Restoring file #",(+$PIECE(DATA,U,
2))," zero node"
                               End DoDot:3
                               QUIT 
 +22      ;
 +23                       WRITE !,"Unknown OpCode: ",OPCODE,"  in: ",TEXT
                           SET QUIT=$$PAUSE^ORY4270
                           WRITE !
                       End DoDot:2
                       IF QUIT
                           QUIT 
               End DoDot:1
               IF QUIT
                   QUIT 
 +24      ;
 +25       KILL ^TMP("OCXRULE",$JOB)
 +26      ;
 +27       IF $DATA(^OCXS)
               Begin DoDot:1
 +28               NEW FILE,DO,PD0,CNT
 +29               SET FILE=0
                   FOR 
                       SET FILE=$ORDER(^OCXS(FILE))
                       IF 'FILE
                           QUIT 
                       Begin DoDot:2
 +30                       SET D0=0
                           FOR CNT=0:1
                               SET PD0=D0
                               SET D0=$ORDER(^OCXS(FILE,D0))
                               IF 'D0
                                   QUIT 
 +31                       SET $PIECE(^OCXS(FILE,0),U,3,4)=CNT_U_PD0
                       End DoDot:2
               End DoDot:1
 +32      ;
 +33       IF $GET(OCXDIER)
               Begin DoDot:1
 +34               WRITE !!!!!!!
 +35               WRITE !,?5,"******************** Warning ********************
 "
 +36               WRITE !,?7,+$GET(OCXDIER)," data filing error",$SELECT(($GET(
OCXDIER)=1):"",1:"s"),"."
 +37               WRITE !,?7,"Some expert system rules may be incomplete."
 +38               WRITE !,?5,"******************** Warning ********************
 "
               End DoDot:1
 +39       IF '$GET(OCXDIER)
               WRITE !!,?5," No data filing errors."
 +40       WRITE !!,"Transport Finished..."
 +41      ;
 +42       Begin DoDot:1
 +43           NEW OCXOETIM
 +44           DO BMES^XPDUTL("---Creating Order Check Routines-----------------
------------------")
 +45           DO AUTO^OCXOCMP
           End DoDot:1
 +46      ;
 +47       QUIT 
 +48      ;
DOT        IF $GET(OCXAUTO)
               QUIT 
           IF ($X>70)
               WRITE !
           WRITE " ."
           QUIT 
 +1       ;
READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
 +1        NEW OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
 +2        IF '$LENGTH($GET(OCXZ0))
               QUIT U
 +3        SET DIR(0)=OCXZ0
 +4        IF $LENGTH($GET(OCXZA))
               SET DIR("A")=OCXZA
 +5        IF $LENGTH($GET(OCXZB))
               SET DIR("B")=OCXZB
 +6        FOR OCXLINE=1:1:($GET(OCXZL)-1)
               WRITE !
 +7        DO ^DIR
 +8        IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
               QUIT U
 +9        QUIT Y
 +10      ;


ORY427ES * *  86 Lines,  3169 Bytes, Checksum: B12600854
                                                  Jun 28, 2016@13:15:59 page 31
              126 bytes in comments
ORY427ES ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install
           of OR*3*427) ;MAY 10,2016 at 13:31
         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 242
         ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
         ;
S        ;
         ;
         N OCXDIER,QUIT,LINE,TEXT,REMOTE,LOCAL,D0,OPCODE,REF,OCXFLAG S QUIT=0
         N OCXAUTO,OCZSCR
         ;
         D DOT
         I $L($T(VERSION^OCXOCMP)),($$VERSION^OCXOCMP="ORDER CHECK EXPERT versio
          n 1.01 released OCT 29,1998"),1
         E  D  Q
         .W !
         .W !,"Rule Transport aborted, version mismatch."
         .W !,"Current Local version: ",$$VERSION^OCXOCMP
         .W !,"   Rule Transport Version: ORDER CHECK EXPERT version 1.01 releas
          ed OCT 29,1998"
         I '$D(DTIME) W !!,"DTIME not defined !!",!! Q
         W !!,"Order Check Expert System Rule Transporter"
         W !," Created: MAY 10,2016 at 13:31  at  NCCLAB1.AAC.DNS   "
         W !," Current Date: ",$$NOW^ORY4270,"  at  ",$$NETNAME^OCXSEND,!!
         S LASTFILE=0 K ^TMP("OCXRULE",$J)
         S ^TMP("OCXRULE",$J)=($P($H,",",2)+($H*86400)+(1*60*60))_" <- ^TMP ENTR
          Y EXPIRATION DATE FOR ^OCXOPURG"
         S OCXFLAG="O"
         ;
RUN      ;
         ;
         W !,"Loading Data " D ^ORY42701
         ;
         S LINE=0 F  S LINE=$O(^TMP("OCXRULE",$J,LINE)) Q:'LINE   D  Q:QUIT
         .D:'(LINE#50) STATUS^OCXOPOST(LINE,$O(^TMP("OCXRULE",$J," "),-1))
         .S TEXT=$G(^TMP("OCXRULE",$J,LINE)) I $L(TEXT) D  Q:QUIT
         ..S TEXT=$P(TEXT,";",2,999),OPCODE=$P(TEXT,U,1),TEXT=$P(TEXT,U,2,999)
         ..;
         ..I OPCODE="KEY" D DOT S LOCAL="",D0=$$GETFILE^ORY4270(+$P(TEXT,U,1),$P
          (TEXT,U,2),.LOCAL) S QUIT=(D0=(-10)) Q
         ..I OPCODE="R" S REF="REMOTE("_$P(TEXT,":",1)_":"_D0_$P(TEXT,":",2,99)_
          ")" Q
         ..I OPCODE="D",$D(REF) S @REF=$P(TEXT,U,1,999) K REF Q
         ..;
         ..I OPCODE="EOR" S QUIT=$$COMPARE^ORY4271(.LOCAL,.REMOTE) K LOCAL,REMOT
          E Q
         ..I OPCODE="EOF" K LOCAL,REMOTE Q
         ..I OPCODE="SOF" W !,"  Installing '",TEXT,"' records... " Q
         ..I OPCODE="ROOT" D  Q
         ...N FILE,DATA
         ...S FILE=U_$P(TEXT,U,1),DATA=$P(TEXT,U,2,3)
         ...I ($P($G(@FILE),U,1,2)=DATA) Q
         ...S $P(@FILE,U,1,2)=DATA
         ...W !,"  Restoring file #",(+$P(DATA,U,2))," zero node"
         ..;
         ..W !,"Unknown OpCode: ",OPCODE,"  in: ",TEXT S QUIT=$$PAUSE^ORY4270 W 
          !
         ;
         K ^TMP("OCXRULE",$J)
         ;
         I $D(^OCXS) D
         .N FILE,DO,PD0,CNT
         .S FILE=0 F  S FILE=$O(^OCXS(FILE)) Q:'FILE  D
         ..S D0=0 F CNT=0:1 S PD0=D0,D0=$O(^OCXS(FILE,D0)) Q:'D0
         ..S $P(^OCXS(FILE,0),U,3,4)=CNT_U_PD0
         ;
         I $G(OCXDIER) D
         .W !!!!!!!
         .W !,?5,"******************** Warning ******************** "
         .W !,?7,+$G(OCXDIER)," data filing error",$S(($G(OCXDIER)=1):"",1:"s"),
          "."
         .W !,?7,"Some expert system rules may be incomplete."
         .W !,?5,"******************** Warning ******************** "
         I '$G(OCXDIER) W !!,?5," No data filing errors."
         W !!,"Transport Finished..."
         ;
         D
         .N OCXOETIM
         .D BMES^XPDUTL("---Creating Order Check Routines-----------------------
          ------------")
         .D AUTO^OCXOCMP
         ;
         Q
         ;
DOT      Q:$G(OCXAUTO)  W:($X>70) ! W " ." Q
         ;
READ(OCXZ0,OCXZA,OCXZB,OCXZL) --
          ;
         N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
         Q:'$L($G(OCXZ0)) U
         S DIR(0)=OCXZ0
         S:$L($G(OCXZA)) DIR("A")=OCXZA
         S:$L($G(OCXZB)) DIR("B")=OCXZB
         F OCXLINE=1:1:($G(OCXZL)-1) W !
         D ^DIR
         I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
         Q Y
         ;

*****   INDEX OF ORY427ES   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
   CNT          RUN+28~,RUN+30*,RUN+31
   D0           S+2~,RUN+9*,RUN+10,RUN+30*
   DATA         RUN+17~,RUN+18*,RUN+19,RUN+20,RUN+21
   DIR          READ+1~
   DIR("A"      READ+4*
   DIR("B"      READ+5*
   DIR(0        READ+3*
   DIROUT       READ+1~,READ+8
   DIRUT        READ+1~,READ+8
   DO           RUN+28~
   DTIME        S+12
   DTOUT        READ+1~,READ+8
   DUOUT        READ+1~,READ+8
   FILE         RUN+17~,RUN+18*,RUN+19,RUN+20*,RUN+28~,RUN+29*,RUN+30,RUN+31
>> LASTFILE     S+16*
   LINE         S+2~,RUN+4*,RUN+5,RUN+6
   LOCAL        S+2~,RUN+9*,RUN+13!,RUN+14!
   OCXAUTO      S+3~,DOT
   OCXDIER      S+2~,RUN+33,RUN+36,RUN+39
   OCXFLAG      S+2~,S+18*
   OCXLINE      READ+1~,READ+6*
   OCXOETIM     RUN+43~
   OCXZ0        READ~,READ+2,READ+3
   OCXZA        READ~,READ+4
   OCXZB        READ~,READ+5
   OCXZL        READ~,READ+6
   OCZSCR       S+3~
   OPCODE       S+2~,RUN+7*,RUN+9,RUN+10,RUN+11,RUN+13,RUN+14,RUN+15,RUN+16
                RUN+23
   PD0          RUN+28~,RUN+30*,RUN+31
   QUIT         S+2~*,RUN+4,RUN+6,RUN+9*,RUN+13*,RUN+23*
   REF          S+2~,RUN+10*,RUN+11!
   REMOTE       S+2~,RUN+13!,RUN+14!
   TEXT         S+2~,RUN+6*,RUN+7*,RUN+9,RUN+10,RUN+11,RUN+15,RUN+18,RUN+23
   U            RUN+7,RUN+9,RUN+11,RUN+18,RUN+19,RUN+20,RUN+21,RUN+31,READ+2
                READ+8
>> Y            READ+9

Global Variables  ( * Changed  ! Killed)
   ^OCXS               RUN+27
   ^OCXS(              RUN+29,RUN+30,RUN+31*
   ^TMP("OCXRULE"      S+16!,S+17*,RUN+4,RUN+5,RUN+6,RUN+25!

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   $T(VERSION^OCXOCMP
                S+6

Label References
   DOT          S+5,RUN+9

External References
   ^DIR                READ+7
   $$VERSION^OCXOCMP   S+6,S+10
   AUTO^OCXOCMP        RUN+45
   VERSION^OCXOCMP     S+6
   STATUS^OCXOPOST     RUN+5
   $$NETNAME^OCXSEND   S+15
   $$GETFILE^ORY4270   RUN+9
   $$NOW^ORY4270       S+15
   $$PAUSE^ORY4270     RUN+23
   ^ORY42701           RUN+2
   $$COMPARE^ORY4271   RUN+13
   BMES^XPDUTL         RUN+44

*****   END   *****


--- CROSS-REFERENCING ALL ROUTINES ---

*****   Cross Reference of all Routines   *****   Jun 28, 2016@13:15:59 page 32

Local Variables    Routines   ( >> not killed explicitly)
                              ( * Changed  ! Killed  ~ Newed)
   %DT          ORY4270*~,ORY4271*~,ORY4272*~
   ARRAY        ORY4270~,ORY4271~,ORY4272~,ORY4273~,ORY4274~
   ARRAY(       ORY4270
   C            ORY4271*~
   C(""         ORY4271
   CHECK        ORY4270*~
   CNT          ORY4270*~,ORY427ES*~
   COUNT        ORALWORD*~,ORALWORD*~
   CREF         ORY4271~
   D0           ORY4270*~,ORY4271*~,ORY4272*~,ORY427ES*~
   D1           ORY4270*~
   DA           ORY4270~,ORY4271*~,ORY4272*~,ORY4273*~
   DA(          ORY4273*
   DA(0         ORY4273!
   DANEW        ORY4271*~
   DASH         ORY4270*~,ORY4271*~
   DATA         ORY4270*~,ORY427ES*~
   DATA(        ORY4270
   DATA(0       ORY4270
   DD           ORY4270*~,ORY4271*~,ORY4272~
   DDPATH       ORY4272*~,ORY4273*~,ORY4274*~
   DFN          ORALWORD~
   DIC          ORY4270~,ORY4272*~
   DIC(0        ORY4272*
   DIE          ORY4272*~
   DIQ          ORY4270*~
   DIQ(0        ORY4270*
   DIR          ORY4272~,ORY4273~,ORY4274~,ORY427ES~
   DIR("A"      ORY4272*,ORY4273*,ORY4274*,ORY427ES*
   DIR("B"      ORY4272*,ORY4273*,ORY4274*,ORY427ES*
   DIR(0        ORY4272*,ORY4273*,ORY4274*,ORY427ES*
   DIROUT       ORY4272~,ORY4273~,ORY4274~,ORY427ES~
   DIRUT        ORY4272~,ORY4273~,ORY4274~,ORY427ES~
   DO           ORY427ES~
   DR           ORY4270*~,ORY4272*~
   DTIME        ORY4270,ORY4271,ORY4272,ORY4273,ORY4274,ORY427ES
   DTOUT        ORY4272~,ORY4273~,ORY4274~,ORY427ES~
   DUOUT        ORY4272~,ORY4273~,ORY4274~,ORY427ES~
   DUZ          ORALWORD
   FILE         ORY4270~,ORY4271*~,ORY427ES*~
   FILEID       ORY4271*~
   FILENAME     ORY4271*~
   FLD          ORY4270~,ORY4272~
   GL           ORY4270*~
   GLNEXT       ORY4270~
   GLREF        ORY4270*~
   GLROOT       ORY4272*~
   GREF         ORY4272~
   INDEX        ORY4272*~,ORY4273*~
   KEY          ORY4270~
   L            ORY4271~
   L(""         ORY4271
>> LASTFILE     ORY4270*,ORY427ES*
   LEVL         ORY4271*~
   LINE         ORY4270*~,ORY42701*,ORY42702*,ORY42703*,ORY42704*,ORY42705*
                ORY42706*,ORY42707*,ORY42708*,ORY4271*~,ORY4272*~,ORY427ES*~
   LINES        ORY4270*~
   LINES(       ORY4270
   LINES(0      ORY4270
   LOCAL        ORY42701!,ORY42702!,ORY42703!,ORY42704!,ORY42705!,ORY42706!
                ORY42707!,ORY42708!,ORY427ES*!~
   LREF         ORY4271*~
   MSG          ORY4270~,ORY4271~
   NLINE        ORY4270*~
   OCXADD       ORY4272~
   OCXARY       ORY4270~
   OCXAUTO      ORY4270,ORY4271,ORY427ES~
   OCXCREF      ORY4271*~,ORY4272~,ORY4273~,ORY4274~
   OCXDA        ORY4272*~,ORY4272*~,ORY4273*~,ORY4274*~
   OCXDA(       ORY4272*!,ORY4273*!,ORY4274*!
   OCXDA(""     ORY4272,ORY4273,ORY4274
   OCXDA(0      ORY4272!,ORY4273!,ORY4274!
   OCXDA(1      ORY4272*,ORY4273*,ORY4274*
   OCXDD        ORY4271*~,ORY4271*~,ORY4272*~,ORY4272,ORY4273~,ORY4274~
   OCXDDPTH     ORY4271*~
   OCXDIC       ORY4272~
   OCXDIER      ORY4272*,ORY427ES~
   OCXDPTR      ORY4271~
   OCXDVAL      ORY4272~
   OCXERR       ORY4272*~
   OCXFLAG      ORY4272,ORY4273,ORY4274,ORY427ES*~
   OCXFLD       ORY4271*~,ORY4271~,ORY4272*~,ORY4273*~,ORY4274*~
   OCXFNAM      ORY4271*~
   OCXGREF      ORY4272*~,ORY4273*~,ORY4274*~
   OCXIEN       ORY4272*~
   OCXIENS      ORY4272*~
   OCXKEY       ORY4272*~
   OCXLINE      ORY4272*~,ORY4273*~,ORY4274*~,ORY427ES*~
   OCXLVL       ORY4272~,ORY4273~,ORY4274*~
   OCXNAME      ORY4272*~,ORY4273~
   OCXOETIM     ORY427ES~
   OCXPC        ORY4274*~
   OCXPTR       ORY4271*~,ORY4272*~
   OCXSCR       ORY4272*~
   OCXSUB       ORY4271*~,ORY4272*~,ORY4273*~,ORY4274*~
   OCXVAL       ORY4272*~
   OCXX         ORY4272*~
   OCXZ0        ORY4272~,ORY4273~,ORY4274~,ORY427ES~
   OCXZA        ORY4272~,ORY4273~,ORY4274~,ORY427ES~
   OCXZB        ORY4272~,ORY4273~,ORY4274~,ORY427ES~
   OCXZL        ORY4272~,ORY4273~,ORY4274~,ORY427ES~
   OCZSCR       ORY427ES~
   OPCODE       ORY42701!,ORY42702!,ORY42703!,ORY42704!,ORY42705!,ORY42706!
                ORY42707!,ORY42708!,ORY427ES*~
   ORCLOZ       ORALWORD*~
   ORCLPAT      ORALWORD*~
   ORDFN        ORALWORD*~
   ORDRG        ORALWORD~
   ORDS         ORALWORD~
   ORDUR        ORALWORD*~
   ORMAX        ORALWORD*~
   ORMAXDS      ORALWORD*~
   ORMAXQT      ORALWORD~
   ORMAXREF     ORALWORD~
   ORN          ORALWORD~
   OROI         ORALWORD*~
   ORPSDRUG     ORALWORD*~
   ORPSOI       ORALWORD*~
   ORQT         ORALWORD~
   ORQUIT       ORALWORD*~
   ORREF        ORALWORD~
   ORSCH        ORALWORD*~
   ORTYPE       ORALWORD~
   ORUPD        ORALWORD~
   ORX          ORALWORD~
   ORY          ORALWORD*!~
   ORY(         ORALWORD*,ORALWORD*
   ORY(0        ORALWORD*
   ORY(1        ORALWORD*
   ORY(2        ORALWORD*
   ORY(3        ORALWORD*
   ORY(4        ORALWORD*
   ORY(5        ORALWORD*
   ORY(6        ORALWORD*
   ORYS         ORALWORD*~
   PATH         ORY4270*~
   PD0          ORY427ES*~
   PLINE        ORY4270*~
   PROV         ORALWORD*~
   QOAA         ORALWORD*~
   QODS         ORALWORD*~
   QOIEN        ORALWORD*~
   QORF         ORALWORD*~
   QPIEN        ORALWORD*~
   QUIT         ORY42701,ORY42702,ORY42703,ORY42704,ORY42705,ORY42706,ORY42707
                ORY42708,ORY4271*~,ORY4272*~,ORY4273*~,ORY4274*~,ORY427ES*~
   R            ORY4271~
   REC          ORY4270*~
   RECNAM       ORY4270*~
   RECNAME      ORY4270~
   REF          ORY42701!,ORY42702!,ORY42703!,ORY42704!,ORY42705!,ORY42706!
                ORY42707!,ORY42708!,ORY4271~,ORY427ES*!~
   REFILLS      ORALWORD~
   REM          ORY4270~
   REMOTE       ORY42701!,ORY42702!,ORY42703!,ORY42704!,ORY42705!,ORY42706!
                ORY42707!,ORY42708!,ORY427ES!~
   RESP         ORY4274*~
   RREF         ORY4271*~,ORY4272~
   RTN          ORY4270~
   S1           ORY4270*~
   SHORT        ORY4270*~,ORY4272~
   SUB          ORY4271*~,ORY4272*~
   SUBNEW       ORY4271*~
   TEXT         ORY4270~,ORY42701*,ORY42702*,ORY42703*,ORY42704*,ORY42705*
                ORY42706*,ORY42707*,ORY42708*,ORY427ES*~
   U            ORALWORD,ORALWORD,ORY4270,ORY4271,ORY4272,ORY4273,ORY4274
                ORY427ES
   X            ORY4270*~,ORY4271*~,ORY4272*~,ORY4273*,ORY4274*
>> X0           ORALWORD
>> XQSAV        ORALWORD
>> XQY0         ORALWORD
>> XQZ          ORALWORD
   Y            ORY4270*~,ORY4271*~,ORY4272~,ORY4273,ORY4274,ORY427ES

Global Variables
   ^OCXS               ORY427ES
   ^OCXS(              ORY4271,ORY427ES*
   ^OR(100             ORALWORD
   ^ORD(101.41         ORALWORD
   ^ORD(101.43         ORALWORD
   ^TMP("OCXRULE"      ORY4270*!,ORY42701*,ORY42702*,ORY42703*,ORY42704*
                       ORY42705*,ORY42706*,ORY42707*,ORY42708*,ORY4272*
                       ORY427ES*!
   ^TMP("RJS"          ORALWORD*
   ^TMP($J             ORALWORD!
   ^XUSEC("YSCL AUTHORIZED"
                       ORALWORD

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   $T(DATA+LINE ORY42701,ORY42702,ORY42703,ORY42704,ORY42705,ORY42706,ORY42707
                ORY42708
   $T(VERSION^OCXOCMP
                ORY427ES

Routine             Invokes:
   ORALWORD     $$DATE^ORU,$$DEFSPLY^ORWDPS1,DAY2QTY^ORWDPS2,MAXREF^ORWDPS2
                ASP^PSS50,CLOZ^PSS50,$$DEA^XUSER,$$CL^YSCLTST2
                $$OVERRIDE^YSCLTST2
   ORY4270      %DT,EN^DIQ1,$$NETNAME^OCXSEND,$$DATE^OCXSENDD,$$FILE^OCXSENDD
                $$FILENAME^OCXSENDD
   ORY42701     ORY42702,DOT^ORY427ES
   ORY42702     ORY42703,DOT^ORY427ES
   ORY42703     ORY42704,DOT^ORY427ES
   ORY42704     ORY42705,DOT^ORY427ES
   ORY42705     ORY42706,DOT^ORY427ES
   ORY42706     ORY42707,DOT^ORY427ES
   ORY42707     ORY42708,DOT^ORY427ES
   ORY42708     DOT^ORY427ES
   ORY4271      %DT,$$NETNAME^OCXSEND,$$DATE^OCXSENDD,$$FIELD^OCXSENDD
                $$FILENAME^OCXSENDD,$$ADDREC^ORY4272,$$LOADWORD^ORY4272
                $$ADDMULT^ORY4273,$$DELMULT^ORY4273,$$DELFLD^ORY4274
                $$EDITFLD^ORY4274
   ORY4272      %DT,DIC,DIE,$$IENS^DILF,$$ROOT^DILFD,DIR,$$FIELD^OCXSENDD
                $$FILEHDR^OCXSENDD,$$EXFLD^ORY4271
   ORY4273      DIR,$$FILEHDR^OCXSENDD,$$FILENAME^OCXSENDD,$$EXFLD^ORY4271
                $$GETREF^ORY4272,DIE^ORY4272
   ORY4274      DIR,$$FILEHDR^OCXSENDD,$$FILENAME^OCXSENDD,$$EXFLD^ORY4271
                $$GETREF^ORY4272,DIE^ORY4272
   ORY427ES     DIR,$$VERSION^OCXOCMP,AUTO^OCXOCMP,VERSION^OCXOCMP
                STATUS^OCXOPOST,$$NETNAME^OCXSEND,$$GETFILE^ORY4270
                $$NOW^ORY4270,$$PAUSE^ORY4270,ORY42701,$$COMPARE^ORY4271
                BMES^XPDUTL

Routine             is Invoked by:
   ^%DT                ORY4270,ORY4271,ORY4272
   ^DIC                ORY4272
   ^DIE                ORY4272
   $$IENS^DILF         ORY4272
   $$ROOT^DILFD        ORY4272
   EN^DIQ1             ORY4270
   ^DIR                ORY4272,ORY4273,ORY4274,ORY427ES
   $$VERSION^OCXOCMP   ORY427ES
   AUTO^OCXOCMP        ORY427ES
   VERSION^OCXOCMP     ORY427ES
   STATUS^OCXOPOST     ORY427ES
   $$NETNAME^OCXSEND   ORY4270,ORY4271,ORY427ES
   $$DATE^OCXSENDD     ORY4270,ORY4271
   $$FIELD^OCXSENDD    ORY4271,ORY4272
   $$FILE^OCXSENDD     ORY4270
   $$FILEHDR^OCXSENDD  ORY4272,ORY4273,ORY4274
   $$FILENAME^OCXSENDD ORY4270,ORY4271,ORY4273,ORY4274
   $$DATE^ORU          ORALWORD
   $$DEFSPLY^ORWDPS1   ORALWORD
   DAY2QTY^ORWDPS2     ORALWORD
   MAXREF^ORWDPS2      ORALWORD
   $$GETFILE^ORY4270   ORY427ES
   $$NOW^ORY4270       ORY427ES
   $$PAUSE^ORY4270     ORY427ES
   ^ORY42701           ORY427ES
   ^ORY42702           ORY42701
   ^ORY42703           ORY42702
   ^ORY42704           ORY42703
   ^ORY42705           ORY42704
   ^ORY42706           ORY42705
   ^ORY42707           ORY42706
   ^ORY42708           ORY42707
   $$COMPARE^ORY4271   ORY427ES
   $$EXFLD^ORY4271     ORY4272,ORY4273,ORY4274
   $$ADDREC^ORY4272    ORY4271
   $$GETREF^ORY4272    ORY4273,ORY4274
   $$LOADWORD^ORY4272  ORY4271
   DIE^ORY4272         ORY4273,ORY4274
   $$ADDMULT^ORY4273   ORY4271
   $$DELMULT^ORY4273   ORY4271
   $$DELFLD^ORY4274    ORY4271
   $$EDITFLD^ORY4274   ORY4271
   DOT^ORY427ES        ORY42701,ORY42702,ORY42703,ORY42704,ORY42705,ORY42706
                       ORY42707,ORY42708
   ASP^PSS50           ORALWORD
   CLOZ^PSS50          ORALWORD
   BMES^XPDUTL         ORY427ES
   $$DEA^XUSER         ORALWORD
   $$CL^YSCLTST2       ORALWORD
   $$OVERRIDE^YSCLTST2 ORALWORD

*****   END   *****


--- END ---
VISTAS1:VISTA>

VISTAS1:VISTA>

VISTAS1:VISTA>

