PSJADT0 ;BIR/CML3,PR,MLM-AUTO DC/HOLD CANCEL ;11 Aug 98 / 8:25 AM
 ;;5.0; INPATIENT MEDICATIONS ;**17,111,112,135**;16 DEC 97
 ;
 ;Reference to ^PS(55 supported by DBIA #2191.
 ;Reference to ^PS(59.7 supported by DBIA #2181.
 ;
ENDC ; dc active orders first, then non-verified orders
 W:'$D(PSJQUIET)&'$D(DGQUIET) !,"...discontinuing Inpatient Medication orders..."
 S $P(PSJPIND,"^")=""
 D NOW^%DTC N PSJDCDT S (PSJDCDT,PSGDT)=+%,PSJSYSW0="" I PSJFW S PSJSYSW=$O(^PS(59.6,"B",PSJFW,0)) S:PSJSYSW PSJSYSW0=$G(^PS(59.6,PSJSYSW,0))
 I PSGALO=1010!(PSGALO=1030)!(PSGALO=1050) D AUDDD
 D ENUNM^PSGOU S PSGALR=10,DIE="^PS(55,"_PSGP_",5," S:PSJFW PSGTOL=1,PSGUOW=PSJFW,PSGTOO=1
 F PSJS=PSGDT:0 S PSJS=$O(^PS(55,PSGP,5,"AUS",PSJS)) Q:'PSJS  F PSJDA=0:0 S PSJDA=$O(^PS(55,PSGP,5,"AUS",PSJS,PSJDA)) Q:'PSJDA  D
 .Q:'$$DCIMO(PSGP,PSJDA,"U") 
 .;first naked reference below refers to the full global reference to the right of the = sign (inside the $S)
 .K DA S DA(1)=PSGP,DA=PSJDA,PSGAL("C")=0,$P(^(2),"^",3)=$S($D(^PS(55,PSGP,5,DA,2)):$P(^(2),"^",4),1:"")
 .D ^PSGAL5
 .K TMP
 .S TMP(55.06,""_PSJDA_","_PSGP_","_"",28)="D"
 .D FILE^DIE("","TMP")
 .K TMP
 .S TMP(55.06,""_PSJDA_","_PSGP_","_"",34)=PSJDCDT
 .S TMP(55.06,""_PSJDA_","_PSGP_","_"",49)=1
 .D FILE^DIE("","TMP")
 .K TMP
 .D EN1^PSJHL2(PSGP,"OD",PSJDA_"U","AUTO DC")
 .I PSGALO'=1050 S DA=PSJDA,^PS(55,"AUE",PSGP,DA)="" I $P(PSJSYSW0,"^",15),(PSGALO'<1060) S $P(^PS(55,PSGP,5,PSJDA,7),"^",1,2)=PSJDCDT_"^D" D ENL^PSGVDS
 S PSGTOO=2 F PSJDA=0:0 S PSJDA=$O(^PS(53.1,"AC",PSGP,PSJDA)) Q:'PSJDA  D
 .Q:'$$DCIMO(PSGP,PSJDA,"P")
 .I PSGALO'<1060,$P(PSJSYSW0,U,15),$P($G(^PS(53.1,PSJDA,0)),U,9)="N" K DA D ENLBL^PSIVOPT(PSGTOL,PSGUOW,DFN,2,+PSJDA,"AD")
 .K DA S DA=PSJDA D  I $P($G(^PS(53.1,DA,0)),"^",21) D EN1^PSJHL2(PSGP,"OC",PSJDA_"P","AUTO DC")
 ..K TMP
 ..S TMP(53.1,""_PSJDA_","_"",28)="D"
 ..S TMP(53.1,""_PSJDA_","_"",42)=1
 ..D FILE^DIE("","TMP")
 ..K TMP
 ;
ENIV ;
 S DFN=PSGP F PSJIVON=0:0 S PSJIVON=$O(^PS(55,DFN,"IV",PSJIVON)) Q:'PSJIVON  S Y=$G(^(PSJIVON,0)) I "PDEN"'[$P(Y,U,17) S P(17)=$P(Y,U,17),P(3)=$P(Y,U,3) D DC
 Q
DC ;
 Q:'$$DCIMO(DFN,PSJIVON,"V")
 S (ON,ON55)=PSJIVON_"V" D NOW^%DTC I P(17)="H",P(3)<% D  D EXPIR^PSIVOE Q
 .K TMP
 .S TMP(55.01,""_+ON_","_DFN_","_"",100)="E"
 .D FILE^DIE("","TMP")
 .K TMP
 K PSIVALT S PSIVAC="AD",PSIVALCK="STOP",PSIVREA="D",PSIVAL=$S('+$G(PSGALO):$G(PSIVRES),1:$P($G(^PS(53.3,+PSGALO,0)),U)) D D1^PSIVOPT2,LOG^PSIVORAL
 K TMP
 S TMP(55.01,""_+ON_","_DFN_","_"",.03)=PSJDCDT
 S TMP(55.01,""_+ON_","_DFN_","_"",121)=1
 D FILE^DIE("","TMP")
 K TMP
 D EN1^PSJHL2(DFN,"OD",+ON_"V","AUTO DC")
 S PSJIVDCF=1
 Q
 ;
SIVDIE ; Setup DIE,DA for IV
 K DA,DIE,DR S DA=+ON,DA(1)=DFN,DIE="^PS(55,"_DFN_",""IV"","
 Q
 ;
AUDDD ; set up orders for discharge report and purging
 S DIS=+VAIP(17,1) I $S('DIS:1,1:$D(^PS(55,"AUDDD",DIS,PSGP))) Q
 S X=$$EN^PSGCT(+VAIP(13,1),-1)
 F Q=X:0 S Q=$O(^PS(55,PSGP,5,"AUS",Q)) Q:'Q  F QQ=0:0 S QQ=$O(^PS(55,PSGP,5,"AUS",Q,QQ)) Q:'QQ  I $S($D(^PS(55,PSGP,5,QQ,0)):'$P(^(0),"^",20),1:1) S $P(^(0),"^",20)=DIS,^PS(55,"AUDDD",DIS,PSGP,QQ)=""
 Q
 ;
ENHE ; status from hold to expired
 D NOW^%DTC S PSGDT=+$E(%,1,12),DIE="^PS(55,"_PSGP_",5,"
 F PSJS=+PSJPAD:0 S PSJS=$O(^PS(55,PSGP,5,"AUS",PSJS)) Q:'PSJS  Q:PSJS>PSGDT  F PSJDA=0:0 S PSJDA=$O(^PS(55,PSGP,5,"AUS",PSJS,PSJDA)) Q:'PSJDA  K DA S DA(1)=PSGP,DA=PSJDA I $D(^PS(55,PSGP,5,DA,0)),$P(^(0),"^",9)="H" S DR="28////E" D ^DIE
 Q
 ;
ENUNDC(PSJDCDT,PSGP,PSJUOW,PSGALO) ; Auto-reinstate orders DC'ed due to a patient movement.
 N PSJSYSW0 D NOW^%DTC S PSJUNDC=1,PSGDT=%,PSJFIRST='$D(PSJQUIET),PSJSYSW0=$G(^PS(59.6,+$O(^PS(59.6,"B",+PSJUOW,0)),0))
 S PSJS=$O(^PS(55,PSGP,5,"AUS",PSJDCDT-.0002)) F PSGORD=0:0 S PSGORD=$O(^PS(55,PSGP,5,"AUS",+PSJS,PSGORD)) Q:'PSGORD  D
 .I $P($G(^PS(55,PSGP,5,PSGORD,0)),U,9)["D",$P($G(^(4)),U,11) D DISREIN,ENRI^PSGOERI
 .S ^PS(55,"AUE",PSGP,PSGORD)=""
 ;
 S:PSJS="" PSJS=$O(^PS(55,PSGP,"IV","AIS",PSJDCDT-.0002))
 F PSGORD=0:0 S PSGORD=$O(^PS(55,PSGP,"IV","AIS",+PSJS,PSGORD)) Q:'PSGORD  D
 .I $P($G(^PS(55,PSGP,"IV",PSGORD,0)),U,12),$P($G(^(2)),U,7)>PSGDT S P(3)=$P($G(^(0)),U,3) D DISREIN,ENARI^PSIVOPT(PSGP,PSGORD,+PSJUOW,PSGALO)
 I $D(^TMP("PSJUNDC")) S ^TMP("PSJUNDC",$J,DFN)=$P(^DPT(DFN,0),"^")_"^"_$G(^DPT(PSGP,.1))_"^"_PSGALO D ^PSJADT2
 ;
ENKL ;
 F UW=0:0 S UW=$O(^PS(53.41,1,1,UW)) Q:'UW  D  I '$O(^PS(53.41,1,1,0)) K DA S DA=1,DIK="^PS(53.41," D ^DIK
 .F PSGP=0:0 S PSGP=$O(^PS(53.41,1,1,UW,1,PSGP)) Q:'PSGP  D  I '$O(^PS(53.41,1,1,UW,1,0)) K DA S DIK="^PS(53.41,1,1,",DA(1)=1,DA=UW D ^DIK
 ..F TO=0:0 S TO=$O(^PS(53.41,1,1,UW,1,PSGP,1,TO)) Q:'TO  D  I '$O(^PS(53.41,1,1,UW,1,PSGP,1,0)) K DA S DA(2)=1,DA(1)=UW,DA=PSGP,DIK="^PS(53.41,1,1,"_UW_",1," D ^DIK
 ...I '$O(^PS(53.41,1,1,UW,1,PSGP,1,TO,1,0))  K DA S DA(3)=1,DA(2)=UW,DA(1)=PSGP,DA=TO,DIK="^PS(53.41,1,1,"_UW_",1,"_PSGP_",1," D ^DIK
 K DA,DIK,P,PSGDT,PSGP,PSGORD,PSJS,PSJUNDC,TO,UW
 Q
 ;
DISREIN ; Display reinstate msg. for first order.
 W:PSJFIRST&'$D(DGQUIET) !,"...reinstating Inpatient Medication orders..." S PSJFIRST=0
 Q
 ;
DCIMO(DFN,ON,TYP) ; Check parameter before DC'ing clinic order
 N GLO,IMOND,A,CLINIC,APPT,B,C S GLO=$S(TYP="P":"^PS(53.1,",TYP="U":"^PS(55,"_DFN_",5,",TYP="V":"^PS(55,"_PSGP_",""IV"",",1:"") I TYP="" Q 1
 S IMOND=$S(TYP="P"!(TYP="V"):"""DSS""",TYP="U":8,1:"") I IMOND="" Q 1
 S GLO=GLO_+ON_","_IMOND_")",A=$G(@GLO),CLINIC=$P(A,"^"),APPT=$P(A,"^",2)
 Q:'$$CLINIC^PSJBCMA(A) 1
 I '$D(^PS(53.46,"B",CLINIC)) Q 1
 S B=$O(^PS(53.46,"B",CLINIC,"")),C=+$P(^PS(53.46,B,0),"^",3) Q C