- PSJADT2 ;BIR/RSB-UNDO AUTO DC MAIL MESSAGE ;25 Aug 98 / 9:44 AM
- ;;5.0; INPATIENT MEDICATIONS ;**17,27,93**;16 DEC 97
- ;
- ; Reference to ^PS(55 is supported by DBIA# 2191
- ; Reference to ^PSDRUG supported by DBIA# 2192
- ;
- SENDMSG ;Send mail message when check is complete.
- N NF,PSJDISP,WS,SM,CNT,CNT1,ON,LINE
- K PSJ,PSJOC,PSJLINE,XMY S XMDUZ="Inpatient Medications",XMSUB="Medication Orders Automatically Reinstated",XMTEXT="PSJ(",XMY("G.PSJ-ORDERS REINSTATED@"_$G(^XMB("NETNAME")))=""
- ;Add additional recipients to mail message i.e. verifying Nurse, Pharmacist, etc.
- I $D(PSJSENTO) D
- .S PSJLOOP=""
- .F S PSJLOOP=$O(PSJSENTO($J,PSJLOOP)) Q:PSJLOOP="" D
- ..S XMY(PSJLOOP)=""
- S PSJ(1,0)="PATIENT : "_$P(^TMP("PSJUNDC",$J,DFN),"^")_" ("_$E($P(^DPT(DFN,0),"^",9),6,9)_")"
- I $P(^TMP("PSJUNDC",$J,DFN),"^",2)'="" D
- .S PSJ(2,0)="CURRENT WARD LOCATION: "_$P(^TMP("PSJUNDC",$J,DFN),"^",2)
- E D
- .S PSJ(2,0)="CURRENT WARD LOCATION: NOT FOUND"
- S PSJ(3,0)="REINSTATEMENT REASON : "_$S($P(^TMP("PSJUNDC",$J,DFN),U,3)=18550:"TRANSFER DELETED",1:"DISCHARGE DELETED")
- S PSJ(4,0)="THE FOLLOWING MEDICATION ORDERS WERE AUTOMATICALLY REINSTATED."
- S PSJLINE=0 S ON="" F S ON=$O(^TMP("PSJUNDC",$J,DFN,ON)) Q:ON="" D
- .S (SM,WS,NF,PSJDISP)=""
- .I ON["U" D DSPLORDU^PSJLMUT1(DFN,ON) D
- ..S SM=$S('$P(^PS(55,DFN,5,+ON,0),"^",5):0,$P(^PS(55,DFN,5,+ON,0),"^",6):1,1:2)
- ..S PSJPWD=$P($G(^DPT(DFN,.1)),U) S PSJPWD=$O(^DIC(42,"B",PSJPWD,0)) S WS=$$WS^PSJO(PSJPWD,DFN,"^PS(55,"_DFN_",5,",ON)
- ..F PSJDISP=0:0 S PSJDISP=$O(^PS(55,DFN,5,+ON,1,PSJDISP)) Q:'PSJDISP D
- ...I $P($G(^PSDRUG(+$P($G(^PS(55,DFN,5,+ON,1,PSJDISP,0)),"^"),0)),"^",9)=1 S NF=1
- ..I NF!WS!SM S PSJOC(ON,PSJLINE-2)=PSJOC(ON,PSJLINE-2)_" "_$S(NF:"NF ",WS:"WS ",SM:$E("HSM",SM,3),1:"")
- .I ON["V" D DSPLORDV^PSJLMUT1(DFN,ON)
- S LINE=5,CNT1=0,ON="" F S ON=$O(PSJOC(ON)) Q:ON="" D
- .;S PSJ(LINE,0)=" ",LINE=LINE+1,CNT=1,CNT1=CNT1+1
- .S CNT=1,CNT1=CNT1+1
- .S ON2="" F S ON2=$O(PSJOC(ON,ON2)) Q:ON2="" D
- ..S PSJ(LINE,0)=$J($S(CNT=1:CNT1,1:" "),3)_$S(CNT=0:" ",1:"")_PSJOC(ON,ON2)
- ..S LINE=LINE+1,CNT=0
- I $D(^TMP("PSJNOTUNDC",$J,DFN)) D
- .S PSJ(LINE,0)=""
- .S LINE=LINE+1,PSJ(LINE,0)="********* THE FOLLOWING ORDERS WERE NOT AUTOMATICALLY RE-INSTATED *********"
- .S LINE=LINE+1,PSJ(LINE,0)="******************* DUPLICATE ORDERABLE ITEMS WERE FOUND ******************"
- .S PSJLINE=0 S ON="" K PSJOC F S ON=$O(^TMP("PSJNOTUNDC",$J,DFN,ON)) Q:ON="" D
- ..S (SM,WS,NF,PSJDISP)=""
- ..I ON["U" D DSPLORDU^PSJLMUT1(DFN,ON) D
- ...S SM=$S('$P(^PS(55,DFN,5,+ON,0),"^",5):0,$P(^PS(55,DFN,5,+ON,0),"^",6):1,1:2)
- ...S PSJPWD=$P($G(^DPT(DFN,.1)),U) S PSJPWD=$O(^DIC(42,"B",PSJPWD,0)) S WS=$$WS^PSJO(PSJPWD,DFN,"^PS(55,"_DFN_",5,",ON)
- ...F PSJDISP=0:0 S PSJDISP=$O(^PS(55,DFN,5,+ON,1,PSJDISP)) Q:'PSJDISP D
- ....I $P($G(^PSDRUG(+$P($G(^PS(55,DFN,5,+ON,1,PSJDISP,0)),"^"),0)),"^",9)=1 S NF=1
- ...I NF!WS!SM S PSJOC(ON,PSJLINE-2)=PSJOC(ON,PSJLINE-2)_" "_$S(NF:"NF ",WS:"WS ",SM:$E("HSM",SM,3),1:"")
- ..I ON["V" D DSPLORDV^PSJLMUT1(DFN,ON)
- .S LINE=LINE+1,CNT1=0,ON="" F S ON=$O(PSJOC(ON)) Q:ON="" D
- ..S CNT=1,CNT1=CNT1+1
- ..S ON2="" F S ON2=$O(PSJOC(ON,ON2)) Q:ON2="" D
- ...S PSJ(LINE,0)=$J($S(CNT=1:CNT1,1:" "),3)_$S(CNT=0:" ",1:"")_PSJOC(ON,ON2)
- ...S LINE=LINE+1,CNT=0
- D ^XMD I $D(XMZ) S DA=XMZ,DIE=3.9,DR="1.7///P;" D ^DIE
- ;
- DONE ;
- K PSJ,PSJOC,XMDUZ,XMSUB,XMTEXT,PSJLINE,^TMP("PSJUNDC",$J),^TMP("PSJNOTUNDC",$J),PSJENTO($J)
- Q
- PSJADT2 ;BIR/RSB-UNDO AUTO DC MAIL MESSAGE ;25 Aug 98 / 9:44 AM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**17,27,93**;16 DEC 97
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA# 2191
- +4 ; Reference to ^PSDRUG supported by DBIA# 2192
- +5 ;
- SENDMSG ;Send mail message when check is complete.
- +1 NEW NF,PSJDISP,WS,SM,CNT,CNT1,ON,LINE
- +2 KILL PSJ,PSJOC,PSJLINE,XMY
- SET XMDUZ="Inpatient Medications"
- SET XMSUB="Medication Orders Automatically Reinstated"
- SET XMTEXT="PSJ("
- SET XMY("G.PSJ-ORDERS REINSTATED@"_$GET(^XMB("NETNAME")))=""
- +3 ;Add additional recipients to mail message i.e. verifying Nurse, Pharmacist, etc.
- +4 IF $DATA(PSJSENTO)
- Begin DoDot:1
- +5 SET PSJLOOP=""
- +6 FOR
- SET PSJLOOP=$ORDER(PSJSENTO($JOB,PSJLOOP))
- IF PSJLOOP=""
- QUIT
- Begin DoDot:2
- +7 SET XMY(PSJLOOP)=""
- End DoDot:2
- End DoDot:1
- +8 SET PSJ(1,0)="PATIENT : "_$PIECE(^TMP("PSJUNDC",$JOB,DFN),"^")_" ("_$EXTRACT($PIECE(^DPT(DFN,0),"^",9),6,9)_")"
- +9 IF $PIECE(^TMP("PSJUNDC",$JOB,DFN),"^",2)'=""
- Begin DoDot:1
- +10 SET PSJ(2,0)="CURRENT WARD LOCATION: "_$PIECE(^TMP("PSJUNDC",$JOB,DFN),"^",2)
- End DoDot:1
- +11 IF '$TEST
- Begin DoDot:1
- +12 SET PSJ(2,0)="CURRENT WARD LOCATION: NOT FOUND"
- End DoDot:1
- +13 SET PSJ(3,0)="REINSTATEMENT REASON : "_$SELECT($PIECE(^TMP("PSJUNDC",$JOB,DFN),U,3)=18550:"TRANSFER DELETED",1:"DISCHARGE DELETED")
- +14 SET PSJ(4,0)="THE FOLLOWING MEDICATION ORDERS WERE AUTOMATICALLY REINSTATED."
- +15 SET PSJLINE=0
- SET ON=""
- FOR
- SET ON=$ORDER(^TMP("PSJUNDC",$JOB,DFN,ON))
- IF ON=""
- QUIT
- Begin DoDot:1
- +16 SET (SM,WS,NF,PSJDISP)=""
- +17 IF ON["U"
- DO DSPLORDU^PSJLMUT1(DFN,ON)
- Begin DoDot:2
- +18 SET SM=$SELECT('$PIECE(^PS(55,DFN,5,+ON,0),"^",5):0,$PIECE(^PS(55,DFN,5,+ON,0),"^",6):1,1:2)
- +19 SET PSJPWD=$PIECE($GET(^DPT(DFN,.1)),U)
- SET PSJPWD=$ORDER(^DIC(42,"B",PSJPWD,0))
- SET WS=$$WS^PSJO(PSJPWD,DFN,"^PS(55,"_DFN_",5,",ON)
- +20 FOR PSJDISP=0:0
- SET PSJDISP=$ORDER(^PS(55,DFN,5,+ON,1,PSJDISP))
- IF 'PSJDISP
- QUIT
- Begin DoDot:3
- +21 IF $PIECE($GET(^PSDRUG(+$PIECE($GET(^PS(55,DFN,5,+ON,1,PSJDISP,0)),"^"),0)),"^",9)=1
- SET NF=1
- End DoDot:3
- +22 IF NF!WS!SM
- SET PSJOC(ON,PSJLINE-2)=PSJOC(ON,PSJLINE-2)_" "_$SELECT(NF:"NF ",WS:"WS ",SM:$EXTRACT("HSM",SM,3),1:"")
- End DoDot:2
- +23 IF ON["V"
- DO DSPLORDV^PSJLMUT1(DFN,ON)
- End DoDot:1
- +24 SET LINE=5
- SET CNT1=0
- SET ON=""
- FOR
- SET ON=$ORDER(PSJOC(ON))
- IF ON=""
- QUIT
- Begin DoDot:1
- +25 ;S PSJ(LINE,0)=" ",LINE=LINE+1,CNT=1,CNT1=CNT1+1
- +26 SET CNT=1
- SET CNT1=CNT1+1
- +27 SET ON2=""
- FOR
- SET ON2=$ORDER(PSJOC(ON,ON2))
- IF ON2=""
- QUIT
- Begin DoDot:2
- +28 SET PSJ(LINE,0)=$JUSTIFY($SELECT(CNT=1:CNT1,1:" "),3)_$SELECT(CNT=0:" ",1:"")_PSJOC(ON,ON2)
- +29 SET LINE=LINE+1
- SET CNT=0
- End DoDot:2
- End DoDot:1
- +30 IF $DATA(^TMP("PSJNOTUNDC",$JOB,DFN))
- Begin DoDot:1
- +31 SET PSJ(LINE,0)=""
- +32 SET LINE=LINE+1
- SET PSJ(LINE,0)="********* THE FOLLOWING ORDERS WERE NOT AUTOMATICALLY RE-INSTATED *********"
- +33 SET LINE=LINE+1
- SET PSJ(LINE,0)="******************* DUPLICATE ORDERABLE ITEMS WERE FOUND ******************"
- +34 SET PSJLINE=0
- SET ON=""
- KILL PSJOC
- FOR
- SET ON=$ORDER(^TMP("PSJNOTUNDC",$JOB,DFN,ON))
- IF ON=""
- QUIT
- Begin DoDot:2
- +35 SET (SM,WS,NF,PSJDISP)=""
- +36 IF ON["U"
- DO DSPLORDU^PSJLMUT1(DFN,ON)
- Begin DoDot:3
- +37 SET SM=$SELECT('$PIECE(^PS(55,DFN,5,+ON,0),"^",5):0,$PIECE(^PS(55,DFN,5,+ON,0),"^",6):1,1:2)
- +38 SET PSJPWD=$PIECE($GET(^DPT(DFN,.1)),U)
- SET PSJPWD=$ORDER(^DIC(42,"B",PSJPWD,0))
- SET WS=$$WS^PSJO(PSJPWD,DFN,"^PS(55,"_DFN_",5,",ON)
- +39 FOR PSJDISP=0:0
- SET PSJDISP=$ORDER(^PS(55,DFN,5,+ON,1,PSJDISP))
- IF 'PSJDISP
- QUIT
- Begin DoDot:4
- +40 IF $PIECE($GET(^PSDRUG(+$PIECE($GET(^PS(55,DFN,5,+ON,1,PSJDISP,0)),"^"),0)),"^",9)=1
- SET NF=1
- End DoDot:4
- +41 IF NF!WS!SM
- SET PSJOC(ON,PSJLINE-2)=PSJOC(ON,PSJLINE-2)_" "_$SELECT(NF:"NF ",WS:"WS ",SM:$EXTRACT("HSM",SM,3),1:"")
- End DoDot:3
- +42 IF ON["V"
- DO DSPLORDV^PSJLMUT1(DFN,ON)
- End DoDot:2
- +43 SET LINE=LINE+1
- SET CNT1=0
- SET ON=""
- FOR
- SET ON=$ORDER(PSJOC(ON))
- IF ON=""
- QUIT
- Begin DoDot:2
- +44 SET CNT=1
- SET CNT1=CNT1+1
- +45 SET ON2=""
- FOR
- SET ON2=$ORDER(PSJOC(ON,ON2))
- IF ON2=""
- QUIT
- Begin DoDot:3
- +46 SET PSJ(LINE,0)=$JUSTIFY($SELECT(CNT=1:CNT1,1:" "),3)_$SELECT(CNT=0:" ",1:"")_PSJOC(ON,ON2)
- +47 SET LINE=LINE+1
- SET CNT=0
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +48 DO ^XMD
- IF $DATA(XMZ)
- SET DA=XMZ
- SET DIE=3.9
- SET DR="1.7///P;"
- DO ^DIE
- +49 ;
- DONE ;
- +1 KILL PSJ,PSJOC,XMDUZ,XMSUB,XMTEXT,PSJLINE,^TMP("PSJUNDC",$JOB),^TMP("PSJNOTUNDC",$JOB),PSJENTO($JOB)
- +2 QUIT
