source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJBCMA4.m@ 1742

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