PXRMORHL ; SLC/AGP - Reminder Order Checks HL7 updates;11/13/2017
;;2.0;CLINICAL REMINDERS;**16,45**;Feb 04, 2005;Build 566
;
Q
ADDMSG(OI,ACT,NL) ;
N ACTION,GIEN,OINAME
I '$D(^PXD(801,"O",OI_";ORD(101.43,")),ACT'=1 Q
S OINAME=$P($G(^ORD(101.43,OI,0)),U)
S ACTION=$S(ACT=1:"added",ACT=2:"inactivated",ACT=3:"changed",ACT=4:"reactivated",1:"unknown")
;only build message for new OI and OI contains within a group
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=OINAME_" was "_ACTION
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" it is used in the following Orderable Item Groups"
;build OI message for each OI
;add specific OI group to the message
I '$D(^PXD(801,"O",OI_";ORD(101.43,")) D Q
.S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" None" Q
S GIEN=0 F S GIEN=$O(^PXD(801,"O",OI_";ORD(101.43,",GIEN)) Q:GIEN'>0 D
.S NL=NL+1
.S ^TMP("PXRMXMZ",$J,NL,0)=" "_$P($G(^PXD(801,GIEN,0)),U)
Q
;
EN ;
N ACT,CHANGED,NL,NODE,OIIEN,SUB,SUB1
K ^TMP("PXRMXMZ",$J)
S NL=0
;check for new OI first
I $D(^TMP($J,"NEW")) D
.S OIIEN=0 F S OIIEN=$O(^TMP($J,"NEW",OIIEN)) Q:OIIEN'>0 D ADDMSG(OIIEN,1,.NL)
;
S OIIEN=0 F S OIIEN=$O(^TMP($J,"BEFORE",OIIEN)) Q:OIIEN'>0 D
.I '$D(^TMP($J,"AFTER",OIIEN)) Q
.S CHANGED=0,SUB=""
.;loop through each OI using the Before Global
.F S SUB=$O(^TMP($J,"BEFORE",OIIEN,SUB)) Q:SUB=""!(CHANGED>0) D
..;do checks on multiples node
..I SUB=2!(SUB=8)!(SUB=9)!(SUB=10) D Q
...;
...;check the zero node first
...S NODE=^TMP($J,"BEFORE",OIIEN,SUB,0)
...I NODE'=$G(^TMP($J,"AFTER",OIIEN,SUB,0)) S CHANGED=3 Q
...;
...;check word processing field
...I SUB=8 D Q
....S SUB1=0
....F S SUB1=$O(^TMP($J,"BEFORE",OIIEN,SUB,SUB1)) Q:SUB1'>0!(CHANGED>0) D
.....S NODE=^TMP($J,"AFTER",OIIEN,8,SUB1,0)
.....I NODE'=$G(^TMP($J,"AFTER",OIIEN,8,SUB1,0)) S CHANGED=3 Q
...;
...;for other nodes check the "B" xref
...S SUB1=""
...F S SUB1=$O(^TMP($J,"BEFORE",OIIEN,SUB,"B",SUB1)) Q:SUB1=""!(CHANGED>0) D
....I '$D(^TMP($J,"AFTER",OIIEN,SUB,"B",SUB1)) S CHANGED=3
..;
..;check non-multiple
..S NODE=^TMP($J,"BEFORE",OIIEN,SUB)
..I NODE'=^TMP($J,"AFTER",OIIEN,SUB) D
...I SUB=.1 D Q
....I NODE="" S CHANGED=2 Q
....S CHANGED=4
...S CHANGED=3
.;
.I CHANGED>0 D ADDMSG(OIIEN,CHANGED,.NL)
I $D(^TMP("PXRMXMZ",$J)) D SEND^PXRMMSG("PXRMXMZ","Orderable Item Updates")
K ^TMP("PXRMXMZ",$J),^TMP($J,"BEFORE"),^TMP($J,"AFTER"),^TMP($J,"NEW")
Q
;
OIUPDATE(MSG) ;
K ^TMP($J,"AFTER"),^TMP($J,"BEFORE"),^TMP($J,"NEW")
M ^TMP($J,"AFTER")=^TMP($J,"OR OI AFTER")
M ^TMP($J,"BEFORE")=^TMP($J,"OR OI BEFORE")
I $D(^TMP($J,"OR OI NEW")) M ^TMP($J,"NEW")=^TMP($J,"OR OI NEW")
D EN
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMORHL 2723 printed Apr 09, 2024@20:49:30 Page 2
PXRMORHL ; SLC/AGP - Reminder Order Checks HL7 updates;11/13/2017
+1 ;;2.0;CLINICAL REMINDERS;**16,45**;Feb 04, 2005;Build 566
+2 ;
+3 QUIT
ADDMSG(OI,ACT,NL) ;
+1 NEW ACTION,GIEN,OINAME
+2 IF '$DATA(^PXD(801,"O",OI_";ORD(101.43,"))
IF ACT'=1
QUIT
+3 SET OINAME=$PIECE($GET(^ORD(101.43,OI,0)),U)
+4 SET ACTION=$SELECT(ACT=1:"added",ACT=2:"inactivated",ACT=3:"changed",ACT=4:"reactivated",1:"unknown")
+5 ;only build message for new OI and OI contains within a group
+6 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+7 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=OINAME_" was "_ACTION
+8 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" it is used in the following Orderable Item Groups"
+9 ;build OI message for each OI
+10 ;add specific OI group to the message
+11 IF '$DATA(^PXD(801,"O",OI_";ORD(101.43,"))
Begin DoDot:1
+12 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" None"
QUIT
End DoDot:1
QUIT
+13 SET GIEN=0
FOR
SET GIEN=$ORDER(^PXD(801,"O",OI_";ORD(101.43,",GIEN))
if GIEN'>0
QUIT
Begin DoDot:1
+14 SET NL=NL+1
+15 SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "_$PIECE($GET(^PXD(801,GIEN,0)),U)
End DoDot:1
+16 QUIT
+17 ;
EN ;
+1 NEW ACT,CHANGED,NL,NODE,OIIEN,SUB,SUB1
+2 KILL ^TMP("PXRMXMZ",$JOB)
+3 SET NL=0
+4 ;check for new OI first
+5 IF $DATA(^TMP($JOB,"NEW"))
Begin DoDot:1
+6 SET OIIEN=0
FOR
SET OIIEN=$ORDER(^TMP($JOB,"NEW",OIIEN))
if OIIEN'>0
QUIT
DO ADDMSG(OIIEN,1,.NL)
End DoDot:1
+7 ;
+8 SET OIIEN=0
FOR
SET OIIEN=$ORDER(^TMP($JOB,"BEFORE",OIIEN))
if OIIEN'>0
QUIT
Begin DoDot:1
+9 IF '$DATA(^TMP($JOB,"AFTER",OIIEN))
QUIT
+10 SET CHANGED=0
SET SUB=""
+11 ;loop through each OI using the Before Global
+12 FOR
SET SUB=$ORDER(^TMP($JOB,"BEFORE",OIIEN,SUB))
if SUB=""!(CHANGED>0)
QUIT
Begin DoDot:2
+13 ;do checks on multiples node
+14 IF SUB=2!(SUB=8)!(SUB=9)!(SUB=10)
Begin DoDot:3
+15 ;
+16 ;check the zero node first
+17 SET NODE=^TMP($JOB,"BEFORE",OIIEN,SUB,0)
+18 IF NODE'=$GET(^TMP($JOB,"AFTER",OIIEN,SUB,0))
SET CHANGED=3
QUIT
+19 ;
+20 ;check word processing field
+21 IF SUB=8
Begin DoDot:4
+22 SET SUB1=0
+23 FOR
SET SUB1=$ORDER(^TMP($JOB,"BEFORE",OIIEN,SUB,SUB1))
if SUB1'>0!(CHANGED>0)
QUIT
Begin DoDot:5
+24 SET NODE=^TMP($JOB,"AFTER",OIIEN,8,SUB1,0)
+25 IF NODE'=$GET(^TMP($JOB,"AFTER",OIIEN,8,SUB1,0))
SET CHANGED=3
QUIT
End DoDot:5
End DoDot:4
QUIT
+26 ;
+27 ;for other nodes check the "B" xref
+28 SET SUB1=""
+29 FOR
SET SUB1=$ORDER(^TMP($JOB,"BEFORE",OIIEN,SUB,"B",SUB1))
if SUB1=""!(CHANGED>0)
QUIT
Begin DoDot:4
+30 IF '$DATA(^TMP($JOB,"AFTER",OIIEN,SUB,"B",SUB1))
SET CHANGED=3
End DoDot:4
End DoDot:3
QUIT
+31 ;
+32 ;check non-multiple
+33 SET NODE=^TMP($JOB,"BEFORE",OIIEN,SUB)
+34 IF NODE'=^TMP($JOB,"AFTER",OIIEN,SUB)
Begin DoDot:3
+35 IF SUB=.1
Begin DoDot:4
+36 IF NODE=""
SET CHANGED=2
QUIT
+37 SET CHANGED=4
End DoDot:4
QUIT
+38 SET CHANGED=3
End DoDot:3
End DoDot:2
+39 ;
+40 IF CHANGED>0
DO ADDMSG(OIIEN,CHANGED,.NL)
End DoDot:1
+41 IF $DATA(^TMP("PXRMXMZ",$JOB))
DO SEND^PXRMMSG("PXRMXMZ","Orderable Item Updates")
+42 KILL ^TMP("PXRMXMZ",$JOB),^TMP($JOB,"BEFORE"),^TMP($JOB,"AFTER"),^TMP($JOB,"NEW")
+43 QUIT
+44 ;
OIUPDATE(MSG) ;
+1 KILL ^TMP($JOB,"AFTER"),^TMP($JOB,"BEFORE"),^TMP($JOB,"NEW")
+2 MERGE ^TMP($JOB,"AFTER")=^TMP($JOB,"OR OI AFTER")
+3 MERGE ^TMP($JOB,"BEFORE")=^TMP($JOB,"OR OI BEFORE")
+4 IF $DATA(^TMP($JOB,"OR OI NEW"))
MERGE ^TMP($JOB,"NEW")=^TMP($JOB,"OR OI NEW")
+5 DO EN
+6 QUIT
+7 ;
