source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJ078A.m@ 1061

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

initial load of FOIAVistA 6/30/08 version

File size: 8.4 KB
Line 
1PSJ078A ;BIR/JCH-Check for stop date problems ;28-NOV-01
2 ;;5.0; INPATIENT MEDICATIONS ;**78**;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^PSJ078A",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,PSJSTOP,PSJNVDT,CREAT,EXPR,OCNT,PSJND0,PSJND2,START
25 N PSJSTRT
26 D NOW^%DTC S PSJSTART=$E(%,1,12),CREAT=$E(%,1,7)
27 S EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0),OCNT=0
28 K ^XTMP("PSJ"),^XTMP("PSJ XREF")
29 ;
30 ;process data nodes
31 S PSJPDFN=0 F S PSJPDFN=$O(^PS(55,PSJPDFN)) Q:'PSJPDFN D
32 . F TYP="IV",5 D
33 .. S ORD=0 F S ORD=$O(^PS(55,PSJPDFN,TYP,ORD)) Q:'ORD D
34 ... Q:$TR($P($G(^PS(55,PSJPDFN,TYP,ORD,0)),"^",2,8),"^")=""
35 ... I TYP="IV" D
36 .... S PSJND0=$G(^PS(55,PSJPDFN,"IV",ORD,0))
37 .... S PSJSTRT=$P(PSJND0,"^",2),PSJSTOP=$P(PSJND0,"^",3)
38 .... S PSJNVDT=$P($G(^PS(55,PSJPDFN,"IV",ORD,4)),"^",2)
39 ... I TYP=5 D
40 .... S ND2=$G(^PS(55,PSJPDFN,TYP,ORD,2)),PSJSTRT=$P(ND2,"^",2)
41 .... S PSJSTOP=$P(ND2,"^",4)
42 .... S PSJNVDT=$P($G(^PS(55,PSJPDFN,5,ORD,4)),"^",2)
43 ... I PSJSTOP=""!($P(PSJSTOP,".",2)="")!(PSJSTOP'=+PSJSTOP)!($L(PSJSTOP)<5) D Q
44 .... S ^XTMP("PSJ",PSJPDFN,TYP,ORD)=PSJSTRT,OCNT=OCNT+1
45 ... I PSJSTRT=""!($P(PSJSTRT,".",2)="")!(PSJSTRT'=+PSJSTRT)!($L(PSJSTRT)<5) D Q
46 .... S ^XTMP("PSJ",PSJPDFN,TYP,ORD)=PSJSTRT,OCNT=OCNT+1
47 ... I PSJNVDT]"",PSJNVDT'=+PSJNVDT D
48 .... S ^XTMP("PSJ",PSJPDFN,TYP,ORD)=PSJNVDT,OCNT=OCNT+1
49 S:$D(^XTMP("PSJ")) ^XTMP("PSJ",0)=EXPR_"^"_CREAT
50 D SENDMSG
51 I $D(^XTMP("PSJ")) D CLEAN
52 D XREFS^PSJ078B
53 ;
54DONE ;
55 K DAYS,MINS,HOURS,PSG,PSJSTART,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,ZTDESC,ZTDTH,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTSK S ZTREQ="@"
56 Q
57 ;
58SENDMSG ;Send mail message when check is complete.
59 K PSG,XMY S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="PSJ*5*78 INPATIENT MEDS STOP DATE ORDER CHECK COMPLETED",XMTEXT="PSG(",XMY(DUZ)="" D NOW^%DTC S Y=% X ^DD("DD")
60 S PSG(1,0)=" The check of existing Pharmacy orders for use with Inpatient",PSG(2,0)="Medications 5.0 completed as of "_Y_"."
61 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)
62 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)_"."
63 S PSG(6,0)=OCNT_" pharmacy orders were found with invalid stop dates."
64 D ^XMD
65 Q
66 ;
67CLEAN ;
68 N PSJPDFN,PSJORD,PSJND,PSJND2,PSJSTRT,PSJLOG,Y,PSJOSTP
69 N PSJFOL,AD,AEN,BEG,END,DFN,PO,FSTOP,FSTRT,PCNT,FOLL0,PREV2,RFO
70 N OPSJSTP,OPSJSTRT,TYP,OI,OINAME,BLANK,PSGTMP
71 S PSJPDFN=0,BEG=1,END=0,PCNT=6,$P(BLANK," ",40)="",AEN=0
72 F S PSJPDFN=$O(^XTMP("PSJ",PSJPDFN)) Q:'PSJPDFN D
73 . F TYP="IV",5 D
74 .. S DFN=PSJPDFN K VADM D DEM^VADPT
75 .. S PSJORD=0
76 .. F S PSJORD=$O(^XTMP("PSJ",PSJPDFN,TYP,PSJORD)) Q:'PSJORD D
77 ... S PSJND=$G(^PS(55,PSJPDFN,$S(TYP=5:5,1:"IV"),PSJORD,0))
78 ... S PSJND4=$G(^PS(55,PSJPDFN,$S(TYP=5:5,1:"IV"),PSJORD,4))
79 ... I $TR(PSJND,"^","")="" Q
80 ... N PSJST,PSJPREV,PSJSTP,PSJSTRT,PSJFOL,OPSJSTP,OPSJSTRT
81 ... K OINAME,FSTRT,FSTOP,STRTCHG,STOPCHG,FOLL2,FOLSTRT,PREVFO,PREV0
82 ... K OI,FOLL0
83 ... I TYP=5 D
84 .... S PSJST=$P(PSJND,"^",7) ;Schedule Type for UD(different than IV)
85 .... S PSJFOL=+$P(PSJND,"^",26)
86 .... S PSJPREV=+$P(PSJND,"^",25),PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2))
87 .... S (PSJSTP,OPSJSTP)=$P(PSJND2,"^",4)
88 .... S (PSJSTRT,OPSJSTRT)=$P(PSJND2,"^",2)
89 .... S PSJNVDT=$P(PSJND4,"^",2)
90 .... S OI=$P($G(^PS(55,PSJPDFN,5,PSJORD,.2)),"^")
91 .... S OINAME=$S(OI:$P($G(^PS(50.7,OI,0)),"^"),1:"OI NOT FOUND")
92 .... I PSJFOL D
93 ..... S FOLL0=$G(^PS(55,PSJPDFN,5,PSJFOL,0)),FOLPO=$P(FOLL0,"^",25)
94 ..... S FOLL2=$G(^PS(55,PSJPDFN,5,PSJFOL,2)),FOLSTRT=$P(FOLL2,"^",2)
95 .... I PSJPREV D
96 ..... S PSJOSTP=$P($G(^PS(55,PSJPDFN,5,PSJPREV,2)),"^",4)
97 ..... S PREV0=$G(^PS(55,PSJPDFN,5,PSJPREV,0)),PREVFO=$P(PREV0,"^",26)
98 ..... S PREVRFO=$P(PREV0,"^",27)
99 ... I TYP="IV" D
100 .... S PSJST=$P(PSJND,"^",4),(PSJSTRT,OPSJSTRT)=$P(PSJND,"^",2)
101 .... S (PSJSTP,OPSJSTP)=$P(PSJND,"^",3)
102 .... S OI=$P($G(^PS(55,PSJPDFN,"IV",PSJORD,.2)),"^")
103 .... S OINAME=$S(OI:$P($G(^PS(50.7,OI,0)),"^"),1:"")
104 .... S PSJND2=$G(^PS(55,PSJPDFN,"IV",PSJORD,2))
105 .... S PSJNVDT=$P(PSJND4,"^",2)
106 .... S AD=$O(^PS(55,PSJPDFN,"IV",PSJORD,"AD",0))
107 .... I OINAME="",AD]"" S AEN=$P($G(^PS(55,PSJPDFN,"IV",PSJORD,"AD",AD,0)),"^") D
108 ..... S OINAME=$P($G(^PS(52.6,+AEN,0)),"^")
109 ..... S:OINAME="" OINAME="OI NOT FOUND"
110 .... S PSJPREV=+$P(PSJND2,"^",5),PSJFOL=$P(PSJND2,"^",6)
111 .... I PSJFOL S FOLL0=$G(^PS(55,PSJPDFN,"IV",+PSJFOL,0)) D
112 ..... S FOLL2=$G(^PS(55,PSJPDFN,"IV",+PSJFOL,2))
113 ..... S FOLPO=$P(FOLL2,"^",5),FOLSTRT=$P(FOLL0,"^",2)
114 .... I PSJPREV S PREV2=$G(^PS(55,PSJPDFN,"IV",PSJPREV,2)) D
115 ..... S PSJOSTP=$P($G(^PS(55,PSJPDFN,"IV",PSJPREV,0)),"^",3)
116 ..... S PREVFO=$P(PREV2,"^",6),PREVRFO=$P(PREV2,"^",9)
117 ... ;
118 ... ;If there's a null start date, check if the previous order was
119 ... ; renewed to cause this order to be created and if the stop date
120 ... ; is there, use it
121 ... ;If there's a null stop date, check if this order has a following
122 ... ; order, and if the start date is there, use it
123 ... ;Check to be sure the dates (even if acquired from a previous or
124 ... ; following order) has a time on it; if not, make it midnight
125 ... ;Check for trailing zeroes by forcing numeric
126 ... ;Check for any other odd format with length < 5
127 ... I PSJSTRT="",$G(PSJOSTP) I (+$G(PREVFO)=+PSJORD) D
128 .... S PSJSTRT=+PSJOSTP,STRTCHG=1
129 ... I PSJSTRT'[".",$L(PSJSTRT)>7 S PSJSTRT=$E(PSJSTRT,1,7),STRTCHG=1
130 ... I PSJSTRT,$P(PSJSTRT,".",2)="" S $P(PSJSTRT,".",2)=1,STRTCHG=1
131 ... I PSJSTRT,(PSJSTRT'=+PSJSTRT) S PSJSTRT=+PSJSTRT,STRTCHG=1
132 ... I PSJSTP="",$G(FOLSTRT) I (+$G(FOLPO)=PSJORD) D
133 .... S PSJSTP=FOLSTRT,STOPCHG=1
134 ... I PSJSTP'[".",$L(PSJSTP)>7 S PSJSTP=$E(PSJSTP,1,7),STOPCHG=1
135 ... I PSJSTP,$P(PSJSTP,".",2)="" S $P(PSJSTP,".",2)=24,STOPCHG=1
136 ... I PSJSTP,(PSJSTP'=+PSJSTP) S PSJSTP=+PSJSTP,STOPCHG=1
137 ... ; Prepare message with results
138 ... I 'PSJSTRT!'PSJSTP!($G(STOPCHG))!($G(STRTCHG)) D
139 .... S PCNT=PCNT+1,PSGTMP=$E(VADM(1),1,25)_$E(BLANK,1,27-$L(VADM(1)))
140 .... S PSGTMP=PSGTMP_$P(VADM(2),"^")
141 .... S PSG(PCNT,0)=PSGTMP_" "_$S(TYP=5:"Unit Dose",1:"IV")
142 .... S Y=PSJSTRT X ^DD("DD") S FSTRT=Y,Y=PSJSTP X ^DD("DD") S FSTOP=Y
143 .... I $G(STOPCHG)!$G(STRTCHG) D
144 ..... S OINAME=$G(OINAME),FSTRT=$G(FSTRT),FSTOP=$G(FSTOP),PCNT=PCNT+1
145 ..... S PSG(PCNT,0)=" "_$E(OINAME,1,20)_$E(BLANK,1,22-$L(OINAME))
146 ..... S PSG(PCNT,0)=PSG(PCNT,0)_"Start: "_FSTRT_" Stop: "_FSTOP
147 ..... I $G(STOPCHG),PSJST="" S PCNT=PCNT+1 D
148 ...... S PSG(PCNT,0)=" Missing "_$S(TYP=5:"Schedule Type",1:"IV Type")
149 ...... S PSG(PCNT,0)=PSG(PCNT,0)_" DATE(S) NOT CORRECTED. "
150 ...... S PSG(PCNT,0)=PSG(PCNT,0)_" Order: "_PSJORD
151 .... I 'PSJSTRT!'PSJSTP S PCNT=PCNT+1 D
152 ..... I $G(STOPCHG)!$G(STRTCHG) S OINAME=""
153 ..... S PSGTMP=" "_$E(OINAME,1,20)_$E(BLANK,1,22-$L(OINAME))_" Can't determine "_$S('PSJSTRT:"start date",1:"")
154 ..... S PSGTMP=PSGTMP_$S('PSJSTRT&('PSJSTP):" or ",1:"")_$S('PSJSTP:"stop date",1:"")_". Order: "_PSJORD
155 ..... S PSG(PCNT,0)=PSGTMP
156 ... ;
157 ... ; Update ^PS(55 and indices
158 ... I TYP=5 D:$G(STRTCHG) UDSTART^PSJ078B D:$G(STOPCHG) UDSTOP^PSJ078B
159 ... I TYP="IV" D:$G(STRTCHG) IVSTART^PSJ078B D:$G(STOPCHG) IVSTOP^PSJ078B
160 ... S END=END+1
161 ... I '(END#500) D CLEANMSG(BEG,END) K PSG S PCNT=2,BEG=END+1
162 D CLEANMSG(BEG,END) Q
163 ;
164CLEANMSG(BEG,END) ;
165 K XMY S XMDUZ="MEDICATIONS,INPATIENT"
166 S XMSUB="PSJ*5*78 INPATIENT MEDS STOP DATE ORDER ("_BEG_"-"_END_") CLEANUP COMPLETED"
167 S XMTEXT="PSG(",XMY(DUZ)="" D NOW^%DTC S Y=% X ^DD("DD")
168 S PSG(1,0)=" The cleanup of Inpatient Medication orders ("_BEG_"-"_END_") with invalid dates ",PSG(2,0)="completed as of "_Y_"."
169 D ^XMD
170 Q
Note: See TracBrowser for help on using the repository browser.