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

Last change on this file since 1806 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1PSJBCMA4 ;BIR/JLC-BCMA ORDER UPDATE FOR INPATIENT MEDS ;18 JUN 01
2 ;;5.0; INPATIENT MEDICATIONS ;**63,66,58,104**;16 DEC 97
3 ;
4 ;Reference to ^DPT is supported by DBIA 10035
5 ;Reference to ^PS(55 is supported by DBIA 2191
6 ;Reference to ^XMB is supported by DBIA 1131
7 ;Reference to ^%DTC is supported by DBIA 10000
8 ;Reference to ^DIE is supported by DBIA 10018
9 ;Reference to ^DIQ is supported by DBIA 2056
10 ;Reference to ^XMD is supported by DBIA 10070
11 ;
12ENE(DFN,ON) ;
13 N PSJIEN,PSJSTOP,PSJSTAT,PSJSTOP,PSJNOW,DA,DR,DIE,PSIVACT,ON55,PSIVREA,PSIVAL,PSIVALT,PSJSCH,X
14 I $G(DFN)=""!($G(ON)="") Q
15 D NOW^%DTC S PSJNOW=%
16 I ON["V" D Q
17 . I '$D(^PS(55,DFN,"IV",+ON)) Q
18 . S X=$G(^PS(55,DFN,"IV",+ON,0))
19 . S PSJSTART=$P(X,"^",2),PSJSTOP=$P(X,"^",3),PSJSCH=$P(X,"^",9),PSJSTAT=$P(X,"^",17)
20 . I $P($G(^PS(55,DFN,"IV",+ON,.2)),"^",4)="D" Q
21 . S DIE="^PS(55,"_DFN_",""IV"",",DA=+ON,DA(1)=DFN
22 . I PSJSTAT'="A" D IEA(0) Q
23 . I PSJSTOP'>PSJNOW D IEA(0) Q
24 . I $$ONE^PSJBCMA(DFN,ON,PSJSCH,PSJSTART,PSJSTOP)'="O" D IEA(0) Q
25 . S PSIVACT=1,DR="116////"_PSJSTOP_";.03////"_PSJNOW_";100////E;147////1" D ^DIE
26 . D IEA(1),EN1^PSJHL2(DFN,"SC",ON,"BCMA EXPIRED")
27 I ON["U" D Q
28 . I '$D(^PS(55,DFN,5,+ON)) Q
29 . S X=$G(^PS(55,DFN,5,+ON,2)),PSJSCH=$P(X,"^"),PSJSTART=$P(X,"^",2),PSJSTOP=$P(X,"^",4)
30 . S PSJIEN=+ON_","_DFN_",",PSJSTAT=$$GET1^DIQ(55.06,PSJIEN,28,"I")
31 . I $P($G(^PS(55,DFN,5,+ON,.2)),"^",4)="D" Q
32 . S DIE="^PS(55,"_DFN_",5,",DA=+ON,DA(1)=DFN
33 . I PSJSTAT'="A" D UEA(0) Q
34 . I PSJSTOP'>PSJNOW D UEA(0) Q
35 . I $$ONE^PSJBCMA(DFN,ON,PSJSCH,PSJSTART,PSJSTOP)'="O" D UEA(0) Q
36 . S DR="25////"_PSJSTOP_";34////"_PSJNOW_";28////E;123////1" D ^DIE
37 . D UEA(1),EN1^PSJHL2(DFN,"SC",ON,"BCMA EXPIRED")
38 Q
39ENR(DFN,ON) ;
40 N PSJIEN,PSJORIG,PSJSTAT,PSJSTOP,PSJNOW,DA,DR,DIE,PSIVACT,PSJF,X,PSJ,XMY,XMDUZ,XMSUB,XMTEXT
41 I $G(DFN)=""!($G(ON)="") Q
42 D NOW^%DTC S PSJNOW=%
43 I ON["V" D Q
44 . I '$D(^PS(55,DFN,"IV",+ON)) Q
45 . S PSJIEN=+ON_","_DFN_",",PSJBCMA=$$GET1^DIQ(55.01,PSJIEN,147,"I"),PSJORIG=$$GET1^DIQ(55.01,PSJIEN,116,"I")
46 . S DIE="^PS(55,"_DFN_",""IV"",",DA=+ON,DA(1)=DFN
47 . I PSJBCMA'=1!(PSJORIG'>PSJNOW) D IRA(0) Q
48 . S PSIVACT=1,DR="116////;.03////"_PSJORIG_";100////A;147////0" D ^DIE
49 . D IRA(1),EN1^PSJHL2(DFN,"SC",ON,"BCMA REINSTATED")
50 I ON["U" D Q
51 . I '$D(^PS(55,DFN,5,+ON)) Q
52 . S PSJIEN=+ON_","_DFN_",",PSJBCMA=$$GET1^DIQ(55.06,PSJIEN,123,"I"),PSJORIG=$$GET1^DIQ(55.06,PSJIEN,25,"I")
53 . S DIE="^PS(55,"_DFN_",5,",DA=+ON,DA(1)=DFN
54 . I PSJBCMA'=1!(PSJORIG'>PSJNOW) D URA(0) Q
55 . S DR="25////;34////"_PSJORIG_";28////A;123////0" D ^DIE
56 . D URA(1),EN1^PSJHL2(DFN,"SC",ON,"BCMA REINSTATED")
57 Q
58IEA(STAT) ;
59 S ON55=ON,PSIVREA="E",PSIVAL=$S(STAT:"BCMA EXPIRED",1:"BCMA EXPIRE DENIED")
60 D LOG^PSIVORAL Q
61UEA(STAT) ;
62 S PSGAL("C")=$S(STAT:25000,1:25100) D ^PSGAL5 Q
63IRA(STAT) ;
64 S ON55=ON,PSIVREA="E",PSIVAL=$S(STAT:"BCMA REINSTATED",1:"BCMA REINSTATE DENIED")
65 D LOG^PSIVORAL
66 F PSJF=.06,135,16 S X=$$GET1^DIQ(55.01,PSJIEN,PSJF,"I") I X]"" S XMY(X)=""
67 D MSG(STAT)
68 Q
69URA(STAT) ;
70 S PSGAL("C")=$S(STAT:25200,1:25300) D ^PSGAL5
71 F PSJF=16,18,20 S X=$$GET1^DIQ(55.06,PSJIEN,PSJF,"I") I X]"" S XMY(X)=""
72 D MSG(STAT)
73 Q
74MSG(STAT) ;
75 S XMDUZ="Inpatient Medications",XMSUB="Medication Order"_$S(STAT:"",1:" not")_" reinstated.",XMTEXT="PSJ(",XMY(DUZ)="",XMY("G.PSJ-ORDERS REINSTATED@"_$G(^XMB("NETNAME")))=""
76 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."
77 S PSJLINE=0 I ON["U" D DSPLORDU^PSJLMUT1(DFN,ON)
78 I ON["V" D DSPLORDV^PSJLMUT1(DFN,ON)
79 S CNT=2,X="" F S X=$O(PSJOC(ON,X)) Q:X="" S CNT=CNT+1,PSJ(CNT,0)=PSJOC(ON,X)
80 D ^XMD I $D(XMZ) S DA=XMZ,DIE=3.9,DR="1.7///P;" D ^DIE
81 Q
Note: See TracBrowser for help on using the repository browser.