source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJ074.m@ 724

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

initial load of WorldVistAEHR

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