PSJBCMA4.m

PSJBCMA4 ;BIR/JLC-BCMA ORDER UPDATE FOR INPATIENT MEDS ;18 JUN 01

 ;;5.0; INPATIENT MEDICATIONS ;**63,66,58,104**;16 DEC 97

 ;

 ;Reference to ^DPT is supported by DBIA 10035

 ;Reference to ^PS(55 is supported by DBIA 2191

 ;Reference to ^XMB is supported by DBIA 1131

 ;Reference to ^%DTC is supported by DBIA 10000

 ;Reference to ^DIE is supported by DBIA 10018

 ;Reference to ^DIQ is supported by DBIA 2056

 ;Reference to ^XMD is supported by DBIA 10070

 ;

ENE(DFN,ON) ;

 N PSJIEN,PSJSTOP,PSJSTAT,PSJSTOP,PSJNOW,DA,DR,DIE,PSIVACT,ON55,PSIVREA,PSIVAL,PSIVALT,PSJSCH,X

 I $G(DFN)=""!($G(ON)="") Q

 D NOW^%DTC S PSJNOW=%

 I ON["V" D  Q

 . I '$D(^PS(55,DFN,"IV",+ON)) Q

 . S X=$G(^PS(55,DFN,"IV",+ON,0))

 . S PSJSTART=$P(X,"^",2),PSJSTOP=$P(X,"^",3),PSJSCH=$P(X,"^",9),PSJSTAT=$P(X,"^",17)

 . I $P($G(^PS(55,DFN,"IV",+ON,.2)),"^",4)="D" Q

 . S DIE="^PS(55,"_DFN_",""IV"",",DA=+ON,DA(1)=DFN

 . I PSJSTAT'="A" D IEA(0) Q

 . I PSJSTOP'>PSJNOW D IEA(0) Q

 . I $$ONE^PSJBCMA(DFN,ON,PSJSCH,PSJSTART,PSJSTOP)'="O" D IEA(0) Q

 . S PSIVACT=1,DR="116////"_PSJSTOP_";.03////"_PSJNOW_";100////E;147////1" D ^DIE

 . D IEA(1),EN1^PSJHL2(DFN,"SC",ON,"BCMA EXPIRED")

 I ON["U" D  Q

 . I '$D(^PS(55,DFN,5,+ON)) Q

 . S X=$G(^PS(55,DFN,5,+ON,2)),PSJSCH=$P(X,"^"),PSJSTART=$P(X,"^",2),PSJSTOP=$P(X,"^",4)

 . S PSJIEN=+ON_","_DFN_",",PSJSTAT=$$GET1^DIQ(55.06,PSJIEN,28,"I")

 . I $P($G(^PS(55,DFN,5,+ON,.2)),"^",4)="D" Q

 . S DIE="^PS(55,"_DFN_",5,",DA=+ON,DA(1)=DFN

 . I PSJSTAT'="A" D UEA(0) Q

 . I PSJSTOP'>PSJNOW D UEA(0) Q

 . I $$ONE^PSJBCMA(DFN,ON,PSJSCH,PSJSTART,PSJSTOP)'="O" D UEA(0) Q

 . S DR="25////"_PSJSTOP_";34////"_PSJNOW_";28////E;123////1" D ^DIE

 . D UEA(1),EN1^PSJHL2(DFN,"SC",ON,"BCMA EXPIRED")

 Q

ENR(DFN,ON) ;

 N PSJIEN,PSJORIG,PSJSTAT,PSJSTOP,PSJNOW,DA,DR,DIE,PSIVACT,PSJF,X,PSJ,XMY,XMDUZ,XMSUB,XMTEXT

 I $G(DFN)=""!($G(ON)="") Q

 D NOW^%DTC S PSJNOW=%

 I ON["V" D  Q

 . I '$D(^PS(55,DFN,"IV",+ON)) Q

 . S PSJIEN=+ON_","_DFN_",",PSJBCMA=$$GET1^DIQ(55.01,PSJIEN,147,"I"),PSJORIG=$$GET1^DIQ(55.01,PSJIEN,116,"I")

 . S DIE="^PS(55,"_DFN_",""IV"",",DA=+ON,DA(1)=DFN

 . I PSJBCMA'=1!(PSJORIG'>PSJNOW) D IRA(0) Q

 . S PSIVACT=1,DR="116////;.03////"_PSJORIG_";100////A;147////0" D ^DIE

 . D IRA(1),EN1^PSJHL2(DFN,"SC",ON,"BCMA REINSTATED")

 I ON["U" D  Q

 . I '$D(^PS(55,DFN,5,+ON)) Q

 . S PSJIEN=+ON_","_DFN_",",PSJBCMA=$$GET1^DIQ(55.06,PSJIEN,123,"I"),PSJORIG=$$GET1^DIQ(55.06,PSJIEN,25,"I")

 . S DIE="^PS(55,"_DFN_",5,",DA=+ON,DA(1)=DFN

 . I PSJBCMA'=1!(PSJORIG'>PSJNOW) D URA(0) Q

 . S DR="25////;34////"_PSJORIG_";28////A;123////0" D ^DIE

 . D URA(1),EN1^PSJHL2(DFN,"SC",ON,"BCMA REINSTATED")

 Q

IEA(STAT) ;

 S ON55=ON,PSIVREA="E",PSIVAL=$S(STAT:"BCMA EXPIRED",1:"BCMA EXPIRE DENIED")

 D LOG^PSIVORAL Q

UEA(STAT) ;

 S PSGAL("C")=$S(STAT:25000,1:25100) D ^PSGAL5 Q

IRA(STAT) ;

 S ON55=ON,PSIVREA="E",PSIVAL=$S(STAT:"BCMA REINSTATED",1:"BCMA REINSTATE DENIED")

 D LOG^PSIVORAL

 F PSJF=.06,135,16 S X=$$GET1^DIQ(55.01,PSJIEN,PSJF,"I") I X]"" S XMY(X)=""

 D MSG(STAT)

 Q

URA(STAT) ;

 S PSGAL("C")=$S(STAT:25200,1:25300) D ^PSGAL5

 F PSJF=16,18,20 S X=$$GET1^DIQ(55.06,PSJIEN,PSJF,"I") I X]"" S XMY(X)=""

 D MSG(STAT)

 Q

MSG(STAT) ;

 S XMDUZ="Inpatient Medications",XMSUB="Medication Order"_$S(STAT:"",1:" not")_" reinstated.",XMTEXT="PSJ(",XMY(DUZ)="",XMY("G.PSJ-ORDERS REINSTATED@"_$G(^XMB("NETNAME")))=""

 S PSJ(1,0)="Patient: "_$P(^DPT(DFN,0),"^"),PSJ(2,0)="The following order was"_$S(STAT:"",1:" not")_" reinstated after a status change in BCMA."

 S PSJLINE=0 I ON["U" D DSPLORDU^PSJLMUT1(DFN,ON)

 I ON["V" D DSPLORDV^PSJLMUT1(DFN,ON)

 S CNT=2,X="" F  S X=$O(PSJOC(ON,X)) Q:X=""  S CNT=CNT+1,PSJ(CNT,0)=PSJOC(ON,X)

 D ^XMD I $D(XMZ) S DA=XMZ,DIE=3.9,DR="1.7///P;" D ^DIE

 Q

PSJBCMA4  ;BIR/JLC-BCMA ORDER UPDATE FOR INPATIENT MEDS ;18 JUN 01

 +1       ;;5.0; INPATIENT MEDICATIONS ;**63,66,58,104**;16 DEC 97

 +2       ;

 +3       ;Reference to ^DPT is supported by DBIA 10035

 +4       ;Reference to ^PS(55 is supported by DBIA 2191

 +5       ;Reference to ^XMB is supported by DBIA 1131

 +6       ;Reference to ^%DTC is supported by DBIA 10000

 +7       ;Reference to ^DIE is supported by DBIA 10018

 +8       ;Reference to ^DIQ is supported by DBIA 2056

 +9       ;Reference to ^XMD is supported by DBIA 10070

 +10      ;

ENE(DFN,ON) ;

 +1        NEW PSJIEN,PSJSTOP,PSJSTAT,PSJSTOP,PSJNOW,DA,DR,DIE,PSIVACT,ON55,PSIVREA,PSIVAL,PSIVALT,PSJSCH,X

 +2        IF $GET(DFN)=""!($GET(ON)="")

               QUIT 

 +3        DO NOW^%DTC

           SET PSJNOW=%

 +4        IF ON["V"

               Begin DoDot:1

 +5                IF '$DATA(^PS(55,DFN,"IV",+ON))

                       QUIT 

 +6                SET X=$GET(^PS(55,DFN,"IV",+ON,0))

 +7                SET PSJSTART=$PIECE(X,"^",2)

                   SET PSJSTOP=$PIECE(X,"^",3)

                   SET PSJSCH=$PIECE(X,"^",9)

                   SET PSJSTAT=$PIECE(X,"^",17)

 +8                IF $PIECE($GET(^PS(55,DFN,"IV",+ON,.2)),"^",4)="D"

                       QUIT 

 +9                SET DIE="^PS(55,"_DFN_",""IV"","

                   SET DA=+ON

                   SET DA(1)=DFN

 +10               IF PSJSTAT'="A"

                       DO IEA(0)

                       QUIT 

 +11               IF PSJSTOP'>PSJNOW

                       DO IEA(0)

                       QUIT 

 +12               IF $$ONE^PSJBCMA(DFN,ON,PSJSCH,PSJSTART,PSJSTOP)'="O"

                       DO IEA(0)

                       QUIT 

 +13               SET PSIVACT=1

                   SET DR="116////"_PSJSTOP_";.03////"_PSJNOW_";100////E;147////1"

                   DO ^DIE

 +14               DO IEA(1)

                   DO EN1^PSJHL2(DFN,"SC",ON,"BCMA EXPIRED")

               End DoDot:1

               QUIT 

 +15       IF ON["U"

               Begin DoDot:1

 +16               IF '$DATA(^PS(55,DFN,5,+ON))

                       QUIT 

 +17               SET X=$GET(^PS(55,DFN,5,+ON,2))

                   SET PSJSCH=$PIECE(X,"^")

                   SET PSJSTART=$PIECE(X,"^",2)

                   SET PSJSTOP=$PIECE(X,"^",4)

 +18               SET PSJIEN=+ON_","_DFN_","

                   SET PSJSTAT=$$GET1^DIQ(55.06,PSJIEN,28,"I")

 +19               IF $PIECE($GET(^PS(55,DFN,5,+ON,.2)),"^",4)="D"

                       QUIT 

 +20               SET DIE="^PS(55,"_DFN_",5,"

                   SET DA=+ON

                   SET DA(1)=DFN

 +21               IF PSJSTAT'="A"

                       DO UEA(0)

                       QUIT 

 +22               IF PSJSTOP'>PSJNOW

                       DO UEA(0)

                       QUIT 

 +23               IF $$ONE^PSJBCMA(DFN,ON,PSJSCH,PSJSTART,PSJSTOP)'="O"

                       DO UEA(0)

                       QUIT 

 +24               SET DR="25////"_PSJSTOP_";34////"_PSJNOW_";28////E;123////1"

                   DO ^DIE

 +25               DO UEA(1)

                   DO EN1^PSJHL2(DFN,"SC",ON,"BCMA EXPIRED")

               End DoDot:1

               QUIT 

 +26       QUIT 

ENR(DFN,ON) ;

 +1        NEW PSJIEN,PSJORIG,PSJSTAT,PSJSTOP,PSJNOW,DA,DR,DIE,PSIVACT,PSJF,X,PSJ,XMY,XMDUZ,XMSUB,XMTEXT

 +2        IF $GET(DFN)=""!($GET(ON)="")

               QUIT 

 +3        DO NOW^%DTC

           SET PSJNOW=%

 +4        IF ON["V"

               Begin DoDot:1

 +5                IF '$DATA(^PS(55,DFN,"IV",+ON))

                       QUIT 

 +6                SET PSJIEN=+ON_","_DFN_","

                   SET PSJBCMA=$$GET1^DIQ(55.01,PSJIEN,147,"I")

                   SET PSJORIG=$$GET1^DIQ(55.01,PSJIEN,116,"I")

 +7                SET DIE="^PS(55,"_DFN_",""IV"","

                   SET DA=+ON

                   SET DA(1)=DFN

 +8                IF PSJBCMA'=1!(PSJORIG'>PSJNOW)

                       DO IRA(0)

                       QUIT 

 +9                SET PSIVACT=1

                   SET DR="116////;.03////"_PSJORIG_";100////A;147////0"

                   DO ^DIE

 +10               DO IRA(1)

                   DO EN1^PSJHL2(DFN,"SC",ON,"BCMA REINSTATED")

               End DoDot:1

               QUIT 

 +11       IF ON["U"

               Begin DoDot:1

 +12               IF '$DATA(^PS(55,DFN,5,+ON))

                       QUIT 

 +13               SET PSJIEN=+ON_","_DFN_","

                   SET PSJBCMA=$$GET1^DIQ(55.06,PSJIEN,123,"I")

                   SET PSJORIG=$$GET1^DIQ(55.06,PSJIEN,25,"I")

 +14               SET DIE="^PS(55,"_DFN_",5,"

                   SET DA=+ON

                   SET DA(1)=DFN

 +15               IF PSJBCMA'=1!(PSJORIG'>PSJNOW)

                       DO URA(0)

                       QUIT 

 +16               SET DR="25////;34////"_PSJORIG_";28////A;123////0"

                   DO ^DIE

 +17               DO URA(1)

                   DO EN1^PSJHL2(DFN,"SC",ON,"BCMA REINSTATED")

               End DoDot:1

               QUIT 

 +18       QUIT 

IEA(STAT) ;

 +1        SET ON55=ON

           SET PSIVREA="E"

           SET PSIVAL=$SELECT(STAT:"BCMA EXPIRED",1:"BCMA EXPIRE DENIED")

 +2        DO LOG^PSIVORAL

           QUIT 

UEA(STAT) ;

 +1        SET PSGAL("C")=$SELECT(STAT:25000,1:25100)

           DO ^PSGAL5

           QUIT 

IRA(STAT) ;

 +1        SET ON55=ON

           SET PSIVREA="E"

           SET PSIVAL=$SELECT(STAT:"BCMA REINSTATED",1:"BCMA REINSTATE DENIED")

 +2        DO LOG^PSIVORAL

 +3        FOR PSJF=.06,135,16

               SET X=$$GET1^DIQ(55.01,PSJIEN,PSJF,"I")

               IF X]""

                   SET XMY(X)=""

 +4        DO MSG(STAT)

 +5        QUIT 

URA(STAT) ;

 +1        SET PSGAL("C")=$SELECT(STAT:25200,1:25300)

           DO ^PSGAL5

 +2        FOR PSJF=16,18,20

               SET X=$$GET1^DIQ(55.06,PSJIEN,PSJF,"I")

               IF X]""

                   SET XMY(X)=""

 +3        DO MSG(STAT)

 +4        QUIT 

MSG(STAT) ;

 +1        SET XMDUZ="Inpatient Medications"

           SET XMSUB="Medication Order"_$SELECT(STAT:"",1:" not")_" reinstated."

           SET XMTEXT="PSJ("

           SET XMY(DUZ)=""

           SET XMY("G.PSJ-ORDERS REINSTATED@"_$GET(^XMB("NETNAME")))=""

 +2        SET PSJ(1,0)="Patient: "_$PIECE(^DPT(DFN,0),"^")

           SET PSJ(2,0)="The following order was"_$SELECT(STAT:"",1:" not")_" reinstated after a status change in BCMA."

 +3        SET PSJLINE=0

           IF ON["U"

               DO DSPLORDU^PSJLMUT1(DFN,ON)

 +4        IF ON["V"

               DO DSPLORDV^PSJLMUT1(DFN,ON)

 +5        SET CNT=2

           SET X=""

           FOR 

               SET X=$ORDER(PSJOC(ON,X))

               IF X=""

                   QUIT 

               SET CNT=CNT+1

               SET PSJ(CNT,0)=PSJOC(ON,X)

 +6        DO ^XMD

           IF $DATA(XMZ)

               SET DA=XMZ

               SET DIE=3.9

               SET DR="1.7///P;"

               DO ^DIE

 +7        QUIT