60 lines
3.3 KiB
Mathematica
60 lines
3.3 KiB
Mathematica
|
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
|