- 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 Mar 13, 2025@21:13:06 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
