source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJ0066.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1PSJ0066 ;BIR/JLC - Check for null start dates/times ; 28-NOV-01
2 ;;5.0; INPATIENT MEDICATIONS ;**66**;16 DEC 97
3 ;
4 ;Reference to ^DD is supported by DBIA# 10017.
5 ;Reference to ^PS(50.7 is supported by DBIA# 2180.
6 ;Reference to ^PS(52.6 is supported by DBIA# 1231.
7 ;Reference to ^PS(55 is supported by DBIA# 2191.
8 ;Reference to ^%DTC is supported by DBIA# 10000.
9 ;Reference to ^%ZTLOAD is supported by DBIA# 10063.
10 ;Reference to ^VADPT is supported by DBIA# 10061.
11 ;Reference to ^XLFDT is supported by DBIA# 10103.
12 ;Reference to ^XMD is supported by DBIA# 10070.
13 ;
14ENNV ; Begin check of existing orders
15 I $G(DUZ)="" W !,"Your DUZ is not defined. It must be defined to run this routine." Q
16 K ZTSAVE,ZTSK S ZTRTN="ENQN^PSJ0066",ZTDESC="Inpatient Orders Check (INPATIENT MEDS)",ZTIO="" D ^%ZTLOAD
17 W !!,"The check of existing Pharmacy orders is",$S($D(ZTSK):"",1:" NOT")," queued",!
18 I $D(ZTSK) D
19 . W " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED. IF"
20 . W !,"ERRORS ARE DETECTED, YOU WILL RECEIVE A SECOND MESSAGE INDICATING CLEANUP"
21 . W !,"HAS COMPLETED."
22 Q
23ENQN ; Check of existing Pharmacy orders.
24 N PSJBEG,PSJPDFN,PSJORD,PSJSTRT,CREAT,EXPR,OCNT,PSJND0,PSJND2,START
25 D NOW^%DTC S PSJSTART=$E(%,1,12),CREAT=$E(%,1,7),EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0),OCNT=0
26 K ^XTMP("PSJ")
27 ;process the stop date crossreference to find orders
28 ;with stop dates no more than 30 days old
29 S %H=$H-31_",86400" D YMD^%DTC S START=X
30 S PSJBEG=START
31 F S PSJBEG=$O(^PS(55,"AUD",PSJBEG)) Q:'PSJBEG D
32 . S PSJPDFN=0
33 . F S PSJPDFN=$O(^PS(55,"AUD",PSJBEG,PSJPDFN)) Q:'PSJPDFN D
34 .. S PSJORD=0
35 .. F S PSJORD=$O(^PS(55,"AUD",PSJBEG,PSJPDFN,PSJORD)) Q:'PSJORD D
36 ... S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2)),PSJSTRT=$P(PSJND2,"^",2)
37 ... I PSJSTRT=""!($P(PSJSTRT,".",2)="") S ^XTMP("PSJ",PSJPDFN,"U",PSJORD)=PSJSTRT,OCNT=OCNT+1
38 S PSJBEG=START
39 F S PSJBEG=$O(^PS(55,"AIV",PSJBEG)) Q:'PSJBEG D
40 . S PSJPDFN=0
41 . F S PSJPDFN=$O(^PS(55,"AIV",PSJBEG,PSJPDFN)) Q:'PSJPDFN D
42 .. S PSJORD=0
43 .. F S PSJORD=$O(^PS(55,"AIV",PSJBEG,PSJPDFN,PSJORD)) Q:'PSJORD D
44 ... S PSJND0=$G(^PS(55,PSJPDFN,"IV",PSJORD,0)),PSJSTRT=$P(PSJND0,"^",2)
45 ... I PSJSTRT=""!($P(PSJSTRT,".",2)="") S ^XTMP("PSJ",PSJPDFN,"I",PSJORD)=PSJSTRT,OCNT=OCNT+1
46 S:$D(^XTMP("PSJ")) ^XTMP("PSJ",0)=EXPR_"^"_CREAT
47 D SENDMSG
48 I $D(^XTMP("PSJ")) D CLEAN
49DONE ;
50 K DAYS,MINS,HOURS,PSG,PSJSTART,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,ZTDESC,ZTDTH,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTSK S ZTREQ="@"
51 Q
52SENDMSG ;Send mail message when check is complete.
53 K PSG,XMY S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="INPATIENT MEDS ORDER CHECK COMPLETED",XMTEXT="PSG(",XMY(DUZ)="" D NOW^%DTC S Y=% X ^DD("DD")
54 S PSG(1,0)=" The check of existing Pharmacy orders for use with Inpatient",PSG(2,0)="Medications 5.0 completed as of "_Y_"."
55 S X=$$FMDIFF^XLFDT(%,PSJSTART,3) S:$L(X," ")>1 DAYS=+$P(X," "),X=$P(X," ",2) S HOURS=+$P(X,":"),MINS=+$P(X,":",2)
56 S PSG(3,0)=" ",PSG(4,0)="This process checked orders for patients in "_$S($G(DAYS):DAYS_" day"_$E("s",DAYS'=1)_", ",1:"")_HOURS_" hour"_$E("s",HOURS'=1),PSG(5,0)="and "_MINS_" minute"_$E("s",MINS'=1)_"."
57 S PSG(6,0)=OCNT_" pharmacy orders were found with invalid start dates."
58 D ^XMD
59 Q
60 ;
61CLEAN ;
62 N PSJPDFN,PSJORD,PSJND,PSJND2,PSJST,PSJSTRT,PSJSTP,PSJLOG,Y,PSJOSTP,PSJPREV,AD,AIEN,BEG,END,DFN,FO,FSTOP,FSTRT,PCNT,PREV0,PREV2,RFO,OPSJSTRT,TYP,OI,OINAME,BLANK
63 S PSJPDFN=0,BEG=1,END=0,PCNT=2,$P(BLANK," ",40)=""
64 F S PSJPDFN=$O(^XTMP("PSJ",PSJPDFN)) Q:'PSJPDFN S PSJORD=0 F TYP="U","I" D
65 . S DFN=PSJPDFN K VADM D DEM^VADPT
66 . F S PSJORD=$O(^XTMP("PSJ",PSJPDFN,TYP,PSJORD)) Q:'PSJORD D
67 .. I '$D(^PS(55,PSJPDFN,$S(TYP="U":5,1:"IV"),PSJORD)) Q
68 .. K OINAME,FSTRT,FSTOP
69 .. I TYP="U" D
70 ... S PSJND=$G(^PS(55,PSJPDFN,5,PSJORD,0)),PSJST=$P(PSJND,"^",7),PSJPREV=+$P(PSJND,"^",25)
71 ... S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2)),(PSJSTRT,OPSJSTRT)=$P(PSJND2,"^",2)
72 ... S OI=$P($G(^PS(55,PSJPDFN,5,PSJORD,.2)),"^"),OINAME=$P($G(^PS(50.7,OI,0)),"^")
73 ... S PREV0=$G(^PS(55,PSJPDFN,5,PSJPREV,0)),FO=$P(PREV0,"^",26),RFO=$P(PREV0,"^",27)
74 ... S PSJOSTP=$P($G(^PS(55,PSJPDFN,5,PSJPREV,2)),"^",4)
75 .. I TYP="I" D
76 ... S PSJND=$G(^PS(55,PSJPDFN,"IV",PSJORD,0)),(PSJSTRT,OPSJSTRT)=$P(PSJND,"^",2),PSJST=$P(PSJND,"^",17)
77 ... S PSJND2=$G(^PS(55,PSJPDFN,"IV",PSJORD,2)),PSJPREV=+$P(PSJND2,"^",5)
78 ... S AD=$O(^PS(55,PSJPDFN,"IV",PSJORD,"AD",0)) I AD]"" S AIEN=$P($G(^(AD,0)),"^"),OINAME=$P(^PS(52.6,AIEN,0),"^")
79 ... S PREV2=$G(^PS(55,PSJPDFN,"IV",PSJPREV,2)),FO=$P(PREV2,"^",6),RFO=$P(PREV2,"^",9)
80 ... S PSJOSTP=$P($G(^PS(55,PSJPDFN,"IV",PSJPREV,0)),"^",3)
81 .. ;if there's a null start date, check if the previous order was
82 .. ;renewed to cause this order to be created and if the stop date
83 .. ;is there, use it
84 .. I PSJSTRT="",PSJPREV D
85 ... I +FO'=+PSJORD!(RFO'="R") Q
86 ... I TYP="U" D
87 .... S $P(^PS(55,PSJPDFN,5,PSJORD,2),"^",2)=+PSJOSTP
88 .... I OPSJSTRT]"" K ^PS(55,"AUDS",OPSJSTRT,PSJPDFN,PSJORD)
89 .... S ^PS(55,"AUDS",+PSJOSTP,PSJPDFN,PSJORD)=""
90 ... I TYP="I" D
91 .... S $P(^PS(55,PSJPDFN,"IV",PSJORD,0),"^",2)=+PSJOSTP
92 .... I OPSJSTRT]"" K ^PS(55,"AIVS",OPSJSTRT,PSJPDFN,PSJORD)
93 .... S ^PS(55,"AIVS",+PSJOSTP,PSJPDFN,PSJORD)=""
94 .. ;check to be sure the start date on the order exists
95 .. ;if it doesn't, can't proceed with the correction
96 .. ;this is a new condition
97 .. I TYP="U" S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2)),(PSJSTRT,OPSJSTRT)=$P(PSJND2,"^",2) I PSJSTRT'[".",$L(PSJSTRT)>7 S PSJSTRT=$E(PSJSTRT,1,7)
98 .. I TYP="I" S PSJND=$G(^PS(55,PSJPDFN,"IV",PSJORD,0)),(PSJSTRT,OPSJSTRT)=$P(PSJND,"^",2) I PSJSTRT'[".",$L(PSJSTRT)>7 S PSJSTRT=$E(PSJSTRT,1,7)
99 .. I PSJSTRT="" D Q
100 ... S PCNT=PCNT+1,PSG(PCNT,0)=$E(VADM(1),1,30)_$E(BLANK,1,32-$L(VADM(1)))_$P(VADM(2),"^")_" "_$S(TYP="U":"Unit Dose",1:"IV")
101 ... S PCNT=PCNT+1,PSG(PCNT,0)="can't determine start date. Order: "_PSJORD
102 .. ;check to be sure the start date (even if
103 .. ;acquired from a previous order) has a time on it
104 .. ;if not, make it midnight
105 .. I $P(PSJSTRT,".",2)="" S $P(PSJSTRT,".",2)=24
106 .. I TYP="U" D
107 ... S $P(^PS(55,PSJPDFN,5,PSJORD,2),"^",2)=+PSJSTRT
108 ... K ^PS(55,"AUDS",OPSJSTRT,PSJPDFN,PSJORD)
109 ... S ^PS(55,"AUDS",+PSJSTRT,PSJPDFN,PSJORD)=""
110 .. I TYP="I" D
111 ... S $P(^PS(55,PSJPDFN,"IV",PSJORD,0),"^",2)=+PSJSTRT
112 ... K ^PS(55,"AIVS",OPSJSTRT,PSJPDFN,PSJORD)
113 ... S ^PS(55,"AIVS",+PSJSTRT,PSJPDFN,PSJORD)=""
114 .. I TYP="U" S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2)),PSJSTRT=$P(PSJND2,"^",2),PSJSTP=$P(PSJND2,"^",3)
115 .. I TYP="I" S PSJND=$G(^PS(55,PSJPDFN,"IV",PSJORD,0)),(PSJSTRT,OPSJSTRT)=$P(PSJND,"^",2),PSJSTP=$P(PSJND,"^",3)
116 .. S Y=PSJSTRT X ^DD("DD") S FSTRT=Y
117 .. S Y=PSJSTP X ^DD("DD") S FSTOP=Y
118 .. S PCNT=PCNT+1,PSG(PCNT,0)=$E(VADM(1),1,25)_$E(BLANK,1,27-$L(VADM(1)))_$P(VADM(2),"^")_" "_$S(TYP="U":"Unit Dose",1:"IV")
119 .. S OINAME=$G(OINAME),FSTRT=$G(FSTRT),FSTOP=$G(FSTOP)
120 .. S PCNT=PCNT+1,PSG(PCNT,0)=" "_$E(OINAME,1,25)_$E(BLANK,1,28-$L(OINAME))_"Start: "_FSTRT_" Stop: "_FSTOP
121 .. S END=END+1 I '(END#500) D CLEANMSG(BEG,END) K PSG S PCNT=2,BEG=END+1
122 D CLEANMSG(BEG,END) Q
123CLEANMSG(BEG,END) K XMY S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="INPATIENT MEDS ORDER ("_BEG_"-"_END_") CLEANUP COMPLETED",XMTEXT="PSG(",XMY(DUZ)="" D NOW^%DTC S Y=% X ^DD("DD")
124 S PSG(1,0)=" The cleanup of Inpatient Medication orders ("_BEG_"-"_END_") with invalid dates ",PSG(2,0)="completed as of "_Y_"."
125 D ^XMD
126 Q
Note: See TracBrowser for help on using the repository browser.