ORY31605.m

ORY31605 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install of OR*3*316) ;NOV 17,2009 at 13:36

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**316**;Dec 17,1997;Build 17

 ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998

 ;

S ;

 ;

 D DOT^ORY316ES

 ;

 ;

 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 ^ORY31606

 ;

 Q

 ;

DATA ;

 ;

 ;;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 OCXDFI 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","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 ;;R^"860.8:",100,5

 ;;D^  ; F PTR=$L(STR):-1:1 S ASC=$A(STR,PTR)-42 I (ASC>0),(ASC<51) S CKSUM=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 returns 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))=",") LIST=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"

 ;;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(OCXMESS)_")")

 ;;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,OCXTSPL

 ;;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,OCXCKSUM))+$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),.OCXDATA,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,OCXELE,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,OCXDFI)) 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

 ;1;

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ORY31605   7690     printed  Dec 13, 2024@02:41:15                                                                                                                                                                                                    Page 2

ORY31605  ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install of OR*3*316) ;NOV 17,2009 at 13:36

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**316**;Dec 17,1997;Build 17

 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998

 +3       ;

S         ;

 +1       ;

 +2        DO DOT^ORY316ES

 +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 ^ORY31606

 +10      ;

 +11       QUIT 

 +12      ;

DATA      ;

 +1       ;

 +2       ;;R^"860.8:",100,6

 +3       ;;D^  ; ;

 +4       ;;R^"860.8:",100,7

 +5       ;;D^  ; Q:'DFN 1 Q:'OCXELE 1 K OCXDATA

 +6       ;;R^"860.8:",100,8

 +7       ;;D^  ; ;

 +8       ;;R^"860.8:",100,9

 +9       ;;D^  ; S OCXDATA(DFN,OCXELE)=1

 +10      ;;R^"860.8:",100,10

 +11      ;;D^  ; F OCXPC=1:1:$L(OCXDFL,",") S OCXDFI=$P(OCXDFL,",",OCXPC) I OCXDFI D

 +12      ;;R^"860.8:",100,11

 +13      ;;D^  ; .S OCXVAL=$G(OCXDF(+OCXDFI)),OCXDATA(DFN,OCXELE,+OCXDFI)=OCXVAL

 +14      ;;R^"860.8:",100,12

 +15      ;;D^T+; .I $G(OCXTRACE) W !,"%%%%",?20,"   ",$P($G(^OCXS(860.4,+OCXDFI,0)),U,1)," = """,OCXVAL,""""

 +16      ;;R^"860.8:",100,13

 +17      ;;D^  ; ;

 +18      ;;R^"860.8:",100,14

 +19      ;;D^  ; M ^TMP("OCXCHK",$J,DFN)=OCXDATA(DFN)

 +20      ;;R^"860.8:",100,15

 +21      ;;D^  ; ;

 +22      ;;R^"860.8:",100,16

 +23      ;;D^  ; Q 0

 +24      ;;R^"860.8:",100,17

 +25      ;;D^  ; ;

 +26      ;;EOR^

 +27      ;;KEY^860.8:^GENERATE STRING CHECKSUM

 +28      ;;R^"860.8:",.01,"E"

 +29      ;;D^GENERATE STRING CHECKSUM

 +30      ;;R^"860.8:",.02,"E"

 +31      ;;D^CKSUM

 +32      ;;R^"860.8:",100,1

 +33      ;;D^  ;CKSUM(STR) ;

 +34      ;;R^"860.8:",100,2

 +35      ;;D^  ; ;

 +36      ;;R^"860.8:",100,3

 +37      ;;D^  ; N CKSUM,PTR,ASC S CKSUM=0

 +38      ;;R^"860.8:",100,4

 +39      ;;D^  ; S STR=$TR(STR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 +40      ;;R^"860.8:",100,5

 +41      ;;D^  ; F PTR=$L(STR):-1:1 S ASC=$A(STR,PTR)-42 I (ASC>0),(ASC<51) S CKSUM=CKSUM*2+ASC

 +42      ;;R^"860.8:",100,6

 +43      ;;D^  ; Q +CKSUM

 +44      ;;R^"860.8:",100,7

 +45      ;;D^  ; ;

 +46      ;;EOR^

 +47      ;;KEY^860.8:^GET DATA FROM THE ACTIVE DATA FILE

 +48      ;;R^"860.8:",.01,"E"

 +49      ;;D^GET DATA FROM THE ACTIVE DATA FILE

 +50      ;;R^"860.8:",.02,"E"

 +51      ;;D^GETDATA

 +52      ;;R^"860.8:",100,1

 +53      ;;D^  ;GETDATA(DFN,OCXL,OCXDFI) ;     This Local Extrinsic Function returns runtime data

 +54      ;;R^"860.8:",100,2

 +55      ;;D^  ; ;

 +56      ;;R^"860.8:",100,3

 +57      ;;D^  ; N OCXE,VAL,PC S VAL=""

 +58      ;;R^"860.8:",100,4

 +59      ;;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)

 +60      ;;R^"860.8:",100,5

 +61      ;;D^  ; Q VAL

 +62      ;;R^"860.8:",100,6

 +63      ;;D^  ; ;

 +64      ;;EOR^

 +65      ;;KEY^860.8:^IN LIST OPERATOR

 +66      ;;R^"860.8:",.01,"E"

 +67      ;;D^IN LIST OPERATOR

 +68      ;;R^"860.8:",.02,"E"

 +69      ;;D^LIST

 +70      ;;R^"860.8:",100,1

 +71      ;;D^  ;LIST(DATA,LIST) ;   IS THE DATA FIELD IN THE LIST

 +72      ;;R^"860.8:",100,2

 +73      ;;D^  ; ;

 +74      ;;R^"860.8:",100,3

 +75      ;;D^T+; W:$G(OCXTRACE) !,"%%%%",?20,"     $$LIST(""",DATA,""",""",LIST,""")"

 +76      ;;R^"860.8:",100,4

 +77      ;;D^  ; S:'($E(LIST,1)=",") LIST=","_LIST S:'($E(LIST,$L(LIST))=",") LIST=LIST_"," S DATA=","_DATA_","

 +78      ;;R^"860.8:",100,5

 +79      ;;D^  ; Q (LIST[DATA)

 +80      ;;R^"860.8:",100,6

 +81      ;;D^  ; ;

 +82      ;;EOR^

 +83      ;;KEY^860.8:^LOCAL TERM LOOKUP

 +84      ;;R^"860.8:",.01,"E"

 +85      ;;D^LOCAL TERM LOOKUP

 +86      ;;R^"860.8:",.02,"E"

 +87      ;;D^TERMLKUP

 +88      ;;R^"860.8:",1,1

 +89      ;;D^ 

 +90      ;;R^"860.8:",1,2

 +91      ;;D^  This function allows a local site to define to Order Checking

 +92      ;;R^"860.8:",1,3

 +93      ;;D^ a term specific to that site. (ie. Lab Test Name, Radiology

 +94      ;;R^"860.8:",1,4

 +95      ;;D^ procedure name, etc.)

 +96      ;;R^"860.8:",1,5

 +97      ;;D^ 

 +98      ;;R^"860.8:",100,1

 +99      ;;D^  ;TERMLKUP(OCXTERM,OCXFILE) ;

 +100     ;;R^"860.8:",100,2

 +101     ;;D^  ; ;

 +102     ;;R^"860.8:",100,3

 +103     ;;D^  ; Q

 +104     ;;R^"860.8:",100,4

 +105     ;;D^  ; ;

 +106     ;;EOR^

 +107     ;;KEY^860.8:^NEW RULE MESSAGE

 +108     ;;R^"860.8:",.01,"E"

 +109     ;;D^NEW RULE MESSAGE

 +110     ;;R^"860.8:",.02,"E"

 +111     ;;D^NEWRULE

 +112     ;;R^"860.8:",100,1

 +113     ;;D^  ;NEWRULE(OCXDFN,OCXORD,OCXRUL,OCXREL,OCXNOTF,OCXMESS) ; Has this rule already been triggered for this order number

 +114     ;;R^"860.8:",100,2

 +115     ;;D^  ; ;

 +116     ;;R^"860.8:",100,3

 +117     ;;D^L+; S OCXERR=$$TIMELOG("M","NEWRULE("_(+$G(OCXDFN))_","_(+$G(OCXORD))_","_(+$G(OCXRUL))_","_(+$G(OCXREL))_","_(+$G(OCXNOTF))_","_$G(OCXMESS)_")")

 +118     ;;R^"860.8:",100,4

 +119     ;;D^  ; ;

 +120     ;;R^"860.8:",100,5

 +121     ;;D^  ; Q:'$G(OCXDFN) 0 Q:'$G(OCXRUL) 0

 +122     ;;R^"860.8:",100,6

 +123     ;;D^  ; Q:'$G(OCXREL) 0  Q:'$G(OCXNOTF) 0  Q:'$L($G(OCXMESS)) 0

 +124     ;;R^"860.8:",100,7

 +125     ;;D^  ; S OCXORD=+$G(OCXORD),OCXDFN=+OCXDFN

 +126     ;;R^"860.8:",100,8

 +127     ;;D^  ; ;

 +128     ;;R^"860.8:",100,9

 +129     ;;D^  ; N OCXNDX,OCXDATA,OCXDFI,OCXELE,OCXGR,OCXTIME,OCXCKSUM,OCXTSP,OCXTSPL

 +130     ;;R^"860.8:",100,10

 +131     ;;D^  ; ;

 +132     ;;R^"860.8:",100,11

 +133     ;;D^  ; S OCXTIME=(+$H)

 +134     ;;R^"860.8:",100,12

 +135     ;;D^  ; S OCXCKSUM=$$CKSUM(OCXMESS)

 +136     ;;R^"860.8:",100,13

 +137     ;;D^  ; ;

 +138     ;;R^"860.8:",100,14

 +139     ;;D^  ; S OCXTSP=($H*86400)+$P($H,",",2)

 +140     ;;R^"860.8:",100,15

 +141     ;;D^  ; S OCXTSPL=($G(^OCXD(860.7,"AT",OCXTIME,OCXDFN,OCXRUL,+OCXORD,OCXCKSUM))+$G(OCXTSPI,300))

 +142     ;;R^"860.8:",100,16

 +143     ;;D^  ; ;

 +144     ;;R^"860.8:",100,17

 +145     ;;D^  ; Q:(OCXTSPL>OCXTSP) 0

 +146     ;;R^"860.8:",100,18

 +147     ;;D^  ; ;

 +148     ;;R^"860.8:",100,19

 +149     ;;D^  ; K OCXDATA

 +150     ;;R^"860.8:",100,20

 +151     ;;D^  ; S OCXDATA(OCXDFN,0)=OCXDFN

 +152     ;;R^"860.8:",100,21

 +153     ;;D^  ; S OCXDATA("B",OCXDFN,OCXDFN)=""

 +154     ;;R^"860.8:",100,22

 +155     ;;D^  ; S OCXDATA("AT",OCXTIME,OCXDFN,OCXRUL,+OCXORD,OCXCKSUM)=OCXTSP

 +156     ;;R^"860.8:",100,23

 +157     ;;D^  ; ;

 +158     ;;R^"860.8:",100,24

 +159     ;;D^  ; S OCXGR="^OCXD(860.7"

 +160     ;;R^"860.8:",100,25

 +161     ;;D^T+; D SETAP(OCXGR_")",0,"Patient",$P($G(^DPT(OCXDFN,0)),U,1),.OCXDATA,OCXDFN)

 +162     ;;R^"860.8:",100,26

 +163     ;;D^T-; D SETAP(OCXGR_")",0,.OCXDATA,OCXDFN)

 +164     ;;R^"860.8:",100,27

 +165     ;;D^  ; ;

 +166     ;;R^"860.8:",100,28

 +167     ;;D^  ; K OCXDATA

 +168     ;;R^"860.8:",100,29

 +169     ;;D^  ; S OCXDATA(OCXRUL,0)=OCXRUL_U_(OCXTIME)_U_(+OCXORD)

 +170     ;;R^"860.8:",100,30

 +171     ;;D^  ; S OCXDATA(OCXRUL,"M")=OCXMESS

 +172     ;;R^"860.8:",100,31

 +173     ;;D^  ; S OCXDATA("B",OCXRUL,OCXRUL)=""

 +174     ;;R^"860.8:",100,32

 +175     ;;D^  ; S OCXGR=OCXGR_","_OCXDFN_",1"

 +176     ;;R^"860.8:",100,33

 +177     ;;D^T+; D SETAP(OCXGR_")","860.71P","Rule",$P($G(^OCXS(860.2,OCXRUL,0)),U,1),.OCXDATA,OCXRUL)

 +178     ;;R^"860.8:",100,34

 +179     ;;D^T-; D SETAP(OCXGR_")","860.71P",.OCXDATA,OCXRUL)

 +180     ;;R^"860.8:",100,35

 +181     ;;D^  ; ;

 +182     ;;R^"860.8:",100,36

 +183     ;;D^  ; K OCXDATA

 +184     ;;R^"860.8:",100,37

 +185     ;;D^  ; S OCXDATA(OCXREL,0)=OCXREL

 +186     ;;R^"860.8:",100,38

 +187     ;;D^  ; S OCXDATA("B",OCXREL,OCXREL)=""

 +188     ;;R^"860.8:",100,39

 +189     ;;D^  ; S OCXGR=OCXGR_","_OCXRUL_",1"

 +190     ;;R^"860.8:",100,40

 +191     ;;D^T+; D SETAP(OCXGR_")","860.712","Relation",OCXREL,.OCXDATA,OCXREL)

 +192     ;;R^"860.8:",100,41

 +193     ;;D^T-; D SETAP(OCXGR_")","860.712",.OCXDATA,OCXREL)

 +194     ;;R^"860.8:",100,42

 +195     ;;D^  ; ;

 +196     ;;R^"860.8:",100,43

 +197     ;;D^  ; S OCXELE=0 F  S OCXELE=$O(^OCXS(860.2,OCXRUL,"C","C",OCXELE)) Q:'OCXELE  D

 +198     ;;R^"860.8:",100,44

 +199     ;;D^  ; .;

 +200     ;;R^"860.8:",100,45

 +201     ;;D^  ; .N OCXGR1

 +202     ;;R^"860.8:",100,46

 +203     ;;D^  ; .S OCXGR1=OCXGR_","_OCXREL_",1"

 +204     ;;R^"860.8:",100,47

 +205     ;;D^  ; .K OCXDATA

 +206     ;;R^"860.8:",100,48

 +207     ;;D^  ; .S OCXDATA(OCXELE,0)=OCXELE

 +208     ;;R^"860.8:",100,49

 +209     ;;D^  ; .S OCXDATA(OCXELE,"TIME")=OCXTIME

 +210     ;;R^"860.8:",100,50

 +211     ;;D^  ; .S OCXDATA(OCXELE,"LOG")=$G(OCXOLOG)

 +212     ;;R^"860.8:",100,51

 +213     ;;D^  ; .S OCXDATA("B",OCXELE,OCXELE)=""

 +214     ;;R^"860.8:",100,52

 +215     ;;D^  ; .K ^OCXD(860.7,OCXDFN,1,OCXRUL,1,OCXREL,1,OCXELE)

 +216     ;;R^"860.8:",100,53

 +217     ;;D^T+; .D SETAP(OCXGR1_")","860.7122P","Element",$P($G(^OCXS(860.3,OCXELE,0)),U,1),.OCXDATA,OCXELE)

 +218     ;;R^"860.8:",100,54

 +219     ;;D^T-; .D SETAP(OCXGR1_")","860.7122P",.OCXDATA,OCXELE)

 +220     ;;R^"860.8:",100,55

 +221     ;;D^  ; .;

 +222     ;;R^"860.8:",100,56

 +223     ;;D^  ; .S OCXDFI=0 F  S OCXDFI=$O(^TMP("OCXCHK",$J,OCXDFN,OCXELE,OCXDFI)) Q:'OCXDFI  D

 +224     ;;R^"860.8:",100,57

 +225     ;;D^  ; ..N OCXGR2

 +226     ;;R^"860.8:",100,58

 +227     ;;D^  ; ..S OCXGR2=OCXGR1_","_OCXELE_",1"

 +228     ;;R^"860.8:",100,59

 +229     ;;D^  ; ..K OCXDATA

 +230     ;;R^"860.8:",100,60

 +231     ;;D^  ; ..S OCXDATA(OCXDFI,0)=OCXDFI

 +232     ;;R^"860.8:",100,61

 +233     ;;D^  ; ..S OCXDATA(OCXDFI,"VAL")=^TMP("OCXCHK",$J,OCXDFN,OCXELE,OCXDFI)

 +234     ;;R^"860.8:",100,62

 +235     ;;D^  ; ..S OCXDATA("B",OCXDFI,OCXDFI)=""

 +236     ;;R^"860.8:",100,63

 +237     ;1;

 +238     ;