PSJOERI ;BIR/LDT-CPRS ORDER UPDATE FOR INPATIENT MEDS ; 7/30/08 7:51am
;;5.0;INPATIENT MEDICATIONS ;**86,108,204,276**;16 DEC 97;Build 3
;
; Reference to ^PS(55 is supported by DBIA 2191
; Reference to ^%DTC is supported by DBIA 10000
; Reference to ^DIE is supported by DBIA 10018
;
ENR(DFN,ON,PSJWARD) ;
I $G(DFN)=""!($G(ON)="")!(+$G(PSJWARD)'>0) Q
I PSJWARD'=+PSJWARD Q
D NOW^%DTC S PSJNOW=%
I ON["V" D Q
. I '$D(^PS(55,DFN,"IV",+ON)) Q
. I $P(^PS(55,DFN,"IV",+ON,0),"^",17)'="D" Q
. I $P(^PS(55,DFN,"IV",+ON,0),"^",12)="" Q
. N DA,DR,DIE,DIK,PSIVREA,PSIVALCK,PSIVOPT,PSIVAL,PSIVALT,X,Y
. S P(3)=$P($G(^PS(55,DFN,"IV",+ON,0)),"^",3)
. S X=$G(^PS(55,DFN,"IV",+ON,"ADC")) I X K ^PS(55,"ADC",X,DFN,+ON),^PS(55,DFN,"IV",+ON,"ADC")
. ;*276 - Update Display Status on reinstate
. S PSIVACT=1,DR="100///A;157///@;.03////"_+$P($G(^PS(55,DFN,"IV",+ON,2)),U,7)_";9////^S X=PSJWARD;109///@;116///@;121///@",DIE="^PS(55,"_DFN_",""IV"",",DA=+ON,DA(1)=DFN
.;PSJ*5.0*204
. I $P($G(^PS(55,DFN,"IV",+ON,4)),"^",18)=1 S DR=$S(+$P($G(^PS(55,DFN,"IV",+ON,0)),U,10)=1:"100////H;157////HP",1:"100////H;157////@")_";.03////"_+$P($G(^PS(55,DFN,"IV",+ON,2)),U,7)_";9////^S X=PSJWARD;109///@;116///@;121///@"
. N CHKIT S CHKIT=$G(^PS(55,DFN,"IV",+ON,2)) I $P(CHKIT,U,6)["P",($P(CHKIT,U,9)="R") S DR=DR_";114///@;123///@"
. D ^DIE
. D IRA(1),EN1^PSJHL2(DFN,"SC",ON,"AUTO REINSTATED (CPRS)")
I ON["U" D Q
. I '$D(^PS(55,DFN,5,+ON)) Q
. I $P(^PS(55,DFN,5,+ON,0),"^",9)'="D" Q
. I $P(^PS(55,DFN,5,+ON,4),"^",11)="" Q
. N DA,DR,DIE,PSGFD,X,Z
. S PSGFD=$P($G(^PS(55,DFN,5,+ON,2)),"^",3)
. ;*276 - Update Display Status on reinstate
. S DR="28////A;136////@;34////^S X=PSGFD;68////^S X=PSJWARD",Z=$G(^PS(55,DFN,5,+ON,4)),$P(Z,U,11)="",$P(Z,"^",15,17)="^^" S ^(4)=Z
.;PSJ*5.0*204
. I $P($G(^PS(55,DFN,5,+ON,4)),"^",18)=1 S DR=$S(+$P($G(^PS(55,DFN,5,+ON,4)),U,26)=1:"28////H;136////HP",1:"28///H;136////@")_";34////^S X=PSGFD;68////^S X=PSJWARD"
. N CHKIT S CHKIT=$G(^PS(55,DFN,5,+ON,0)) I $P(CHKIT,U,26)["P",($P(CHKIT,U,27)="R") S DR=DR_";105///@;107///@"
. S DIE="^PS(55,"_DFN_",5,",DA(1)=DFN,DA=+ON D ^DIE
. S X=$P(^PS(55,DFN,5,+ON,0),"^",20),$P(^(0),"^",20)="" K:X ^PS(55,"AUDDD",X,DFN,+ON) ;Removed cross reference after reinstate order.
. D URA(1),EN1^PSJHL2(DFN,"SC",ON,"AUTO REINSTATED (CPRS)")
Q
IRA(STAT) ;
S ON55=ON,P(17)="A",PSIVREA="AI",PSIVALCK="STOP",(PSIVOPT,PSIVALT)=1,PSJUNDC=1,PSIVAL="AUTO REINSTATED (CPRS)"
D LOG^PSIVORAL
Q
URA(STAT) ;
S PSGAL("C")=18560 D ^PSGAL5
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJOERI 2548 printed Apr 09, 2024@21:05:28 Page 2
PSJOERI ;BIR/LDT-CPRS ORDER UPDATE FOR INPATIENT MEDS ; 7/30/08 7:51am
+1 ;;5.0;INPATIENT MEDICATIONS ;**86,108,204,276**;16 DEC 97;Build 3
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191
+4 ; Reference to ^%DTC is supported by DBIA 10000
+5 ; Reference to ^DIE is supported by DBIA 10018
+6 ;
ENR(DFN,ON,PSJWARD) ;
+1 IF $GET(DFN)=""!($GET(ON)="")!(+$GET(PSJWARD)'>0)
QUIT
+2 IF PSJWARD'=+PSJWARD
QUIT
+3 DO NOW^%DTC
SET PSJNOW=%
+4 IF ON["V"
Begin DoDot:1
+5 IF '$DATA(^PS(55,DFN,"IV",+ON))
QUIT
+6 IF $PIECE(^PS(55,DFN,"IV",+ON,0),"^",17)'="D"
QUIT
+7 IF $PIECE(^PS(55,DFN,"IV",+ON,0),"^",12)=""
QUIT
+8 NEW DA,DR,DIE,DIK,PSIVREA,PSIVALCK,PSIVOPT,PSIVAL,PSIVALT,X,Y
+9 SET P(3)=$PIECE($GET(^PS(55,DFN,"IV",+ON,0)),"^",3)
+10 SET X=$GET(^PS(55,DFN,"IV",+ON,"ADC"))
IF X
KILL ^PS(55,"ADC",X,DFN,+ON),^PS(55,DFN,"IV",+ON,"ADC")
+11 ;*276 - Update Display Status on reinstate
+12 SET PSIVACT=1
SET DR="100///A;157///@;.03////"_+$PIECE($GET(^PS(55,DFN,"IV",+ON,2)),U,7)_";9////^S X=PSJWARD;109///@;116///@;121///@"
SET DIE="^PS(55,"_DFN_",""IV"","
SET DA=+ON
SET DA(1)=DFN
+13 ;PSJ*5.0*204
+14 IF $PIECE($GET(^PS(55,DFN,"IV",+ON,4)),"^",18)=1
SET DR=$SELECT(+$PIECE($GET(^PS(55,DFN,"IV",+ON,0)),U,10)=1:"100////H;157////HP",1:"100////H;157////@")_";.03////"_+$PIECE($GET(^PS(55,DFN,"IV",+ON,2)),U,7)_";9////^S X=PSJWARD;109///@;116///@;121///@"
+15 NEW CHKIT
SET CHKIT=$GET(^PS(55,DFN,"IV",+ON,2))
IF $PIECE(CHKIT,U,6)["P"
IF ($PIECE(CHKIT,U,9)="R")
SET DR=DR_";114///@;123///@"
+16 DO ^DIE
+17 DO IRA(1)
DO EN1^PSJHL2(DFN,"SC",ON,"AUTO REINSTATED (CPRS)")
End DoDot:1
QUIT
+18 IF ON["U"
Begin DoDot:1
+19 IF '$DATA(^PS(55,DFN,5,+ON))
QUIT
+20 IF $PIECE(^PS(55,DFN,5,+ON,0),"^",9)'="D"
QUIT
+21 IF $PIECE(^PS(55,DFN,5,+ON,4),"^",11)=""
QUIT
+22 NEW DA,DR,DIE,PSGFD,X,Z
+23 SET PSGFD=$PIECE($GET(^PS(55,DFN,5,+ON,2)),"^",3)
+24 ;*276 - Update Display Status on reinstate
+25 SET DR="28////A;136////@;34////^S X=PSGFD;68////^S X=PSJWARD"
SET Z=$GET(^PS(55,DFN,5,+ON,4))
SET $PIECE(Z,U,11)=""
SET $PIECE(Z,"^",15,17)="^^"
SET ^(4)=Z
+26 ;PSJ*5.0*204
+27 IF $PIECE($GET(^PS(55,DFN,5,+ON,4)),"^",18)=1
SET DR=$SELECT(+$PIECE($GET(^PS(55,DFN,5,+ON,4)),U,26)=1:"28////H;136////HP",1:"28///H;136////@")_";34////^S X=PSGFD;68////^S X=PSJWARD"
+28 NEW CHKIT
SET CHKIT=$GET(^PS(55,DFN,5,+ON,0))
IF $PIECE(CHKIT,U,26)["P"
IF ($PIECE(CHKIT,U,27)="R")
SET DR=DR_";105///@;107///@"
+29 SET DIE="^PS(55,"_DFN_",5,"
SET DA(1)=DFN
SET DA=+ON
DO ^DIE
+30 ;Removed cross reference after reinstate order.
SET X=$PIECE(^PS(55,DFN,5,+ON,0),"^",20)
SET $PIECE(^(0),"^",20)=""
if X
KILL ^PS(55,"AUDDD",X,DFN,+ON)
+31 DO URA(1)
DO EN1^PSJHL2(DFN,"SC",ON,"AUTO REINSTATED (CPRS)")
End DoDot:1
QUIT
+32 QUIT
IRA(STAT) ;
+1 SET ON55=ON
SET P(17)="A"
SET PSIVREA="AI"
SET PSIVALCK="STOP"
SET (PSIVOPT,PSIVALT)=1
SET PSJUNDC=1
SET PSIVAL="AUTO REINSTATED (CPRS)"
+2 DO LOG^PSIVORAL
+3 QUIT
URA(STAT) ;
+1 SET PSGAL("C")=18560
DO ^PSGAL5
+2 QUIT
