- 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 Mar 13, 2025@20:51:35 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 ;
