close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOSIGDS.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOSIGDS.m@ 1464

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

initial load of WorldVistAEHR
File size: 8.7 KB
RevLine 
1PSOSIGDS ;BIR/RTR-Utility to calculate Days Supply ;6/04/00
2 ;;7.0;OUTPATIENT PHARMACY;**46,222**;DEC 1997;Build 12
3 ;External reference to PS(51 supported by DBIA 2224
4 ;External reference to PS(51.1 supported by DBIA 2225
5 ;External reference to PS(55 supported by DBIA 2228
6 ;External reference to PSDRUG( supported by DBIA 221
7 ;External reference to YSCL(603.01 supported by DBIA 2697
8 ;
9EN(PSOSIGX) ;
10 N VARIABLE
11 Q
12SCH ;SCH = schedule entered SCHEX = expanded schedule
13 N SQFLAG,SCLOOP,SCLP,SCLPS,SCLHOLD,SCIN,SODL,SST
14 K SCHEX S SQFLAG=0
15 I $G(SCH)="" S SCHEX="" Q
16 F SCLOOP=0:0 S SCLOOP=$O(^PS(51.1,"B",SCH,SCLOOP)) Q:'SCLOOP!(SQFLAG) I $P($G(^PS(51.1,SCLOOP,0)),"^",8)'="" S SCHEX=$P($G(^(0)),"^",8),SQFLAG=1
17 Q:SQFLAG
18 I $P($G(^PS(51,"A",SCH)),"^")'="" S SCHEX=$P(^(SCH),"^") Q
19 S SCLOOP=0 F SCLP=1:1:$L(SCH) S SCLPS=$E(SCH,SCLP) I SCLPS=" " S SCLOOP=SCLOOP+1
20 I SCLOOP=0 S SCHEX=SCH Q
21 S SCLOOP=SCLOOP+1
22 K SCLHOLD F SCIN=1:1:SCLOOP S (SODL,SCLHOLD(SCIN))=$P(SCH," ",SCIN) D
23 .Q:$G(SODL)=""
24 .S SQFLAG=0 F SST=0:0 S SST=$O(^PS(51.1,"B",SODL,SST)) Q:'SST!($G(SQFLAG)) I $P($G(^PS(51.1,SST,0)),"^",8)'="" S SCLHOLD(SCIN)=$P($G(^(0)),"^",8),SQFLAG=1
25 .Q:$G(SQFLAG)
26 .I $P($G(^PS(51,"A",SODL)),"^")'="" S SCLHOLD(SCIN)=$P(^(SODL),"^")
27 S SCHEX="",SQFLAG=0 F SST=1:1:SCLOOP S SCHEX=SCHEX_$S($G(SQFLAG):" ",1:"")_$G(SCLHOLD(SST)),SQFLAG=1
28 Q
29QTY(PSOQX) ;
30 Q
31QTYOPS ;
32 N QDOSE
33QTYCP ;CPRS days supply call comes through here
34 N PSOZMIN,PSQQUIT,QTSH,PSQ,PSQMIN,PSQMINZ,PSOQRND,PSOLOWER,PSOLOWX,PSOLOWXL,PSOLOWST
35 K PSOFRQ S PSQQUIT=0
36 I '$G(PSOCPRQT) S QDOSE=0 F PSQ=0:0 S PSQ=$O(PSOQX("DOSE",PSQ)) Q:'PSQ S QDOSE=PSQ S:'$G(PSOQX("DOSE ORDERED",PSQ)) PSQQUIT=1
37 ;Q:PSQQUIT!('QDOSE)
38 I '$G(PSOCPRQT) Q:PSQQUIT
39 Q:'$G(QDOSE)
40 G:QDOSE>1 COMP
41 Q:'$G(PSOQX("DOSE ORDERED",1))
42 ;Q:'$G(PSOQX("DAYS SUPPLY"))&('$G(PSOQX("DURATION",1)))
43 S PSOLOWER=0
44 I $G(PSOQX("DURATION",1)) D
45 .S PSOLOWX=$L(PSOQX("DURATION",1))
46 .S PSOLOWXL=$S($E(PSOQX("DURATION",1),PSOLOWX)="M":1,$E(PSOQX("DURATION",1),PSOLOWX)="H":60,$E(PSOQX("DURATION",1),PSOLOWX)="S":.01666,$E(PSOQX("DURATION",1),PSOLOWX)="W":10080,$E(PSOQX("DURATION",1),PSOLOWX)="L":43200,1:1440)
47 .S PSOLOWER=PSOLOWXL*(+$G(PSOQX("DURATION",1)))
48 ;S PSOLOWX=0 I +$G(PSOQX("DAYS SUPPLY")) S PSOLOWX=1440*+$G(PSOQX("DAYS SUPPLY"))
49 ;Q:'$G(PSOLOWER)&('$G(PSOLOWX))
50 S QTSH=$G(PSOQX("SCHEDULE",1)) D QTS Q:PSQQUIT!('$G(PSOFRQ))
51 ;S PSOLOWST=$S('$G(PSOLOWER):$G(PSOLOWX),'$G(PSOLOWX):$G(PSOLOWER),$G(PSOLOWER)>$G(PSOLOWX):$G(PSOLOWX),$G(PSOLOWX)>$G(PSOLOWER):$G(PSOLOWER),$G(PSOLOWX)=$G(PSOLOWER):$G(PSOLOWER),1:0)
52 ;Q:'$G(PSOLOWST)
53 ;S PSQMIN=+$G(PSOLOWST)
54 S PSQMIN=$S($G(PSOLOWER):$G(PSOLOWER),1:0) ; PSQMIN=Minutes based in duration, or 0 if no duration
55 ;If Duration, determine using QTY how many days, regardless of duration, then use what is lower, that # of days or the duration, ROund that up, and check against Rx patient status
56 ;if no duration, just figure out using QTY # of days, then compare that against Rx patient status
57 S PSOZMIN=0
58 S PSOZMIN=PSOQX("QTY")/PSOQX("DOSE ORDERED",1)
59 S PSOZMIN=PSOZMIN*PSOFRQ
60 I $G(PSOLOWER) S PSOZMIN=$S(PSOLOWER<PSOZMIN:PSOLOWER,1:PSOZMIN)
61 S PSOZMIN=PSOZMIN/1440
62 ;S PSQMINZ=PSQMIN/PSOFRQ
63 ;S PSOQRND=PSQMINZ*+$G(PSOQX("DOSE ORDERED",1)) Q:'PSOQRND
64 D ROUND G QEND
65 Q
66COMP ;COMPLEX DOSE HERE
67 N PSQMNL,PSQMNLX,PSODUTOT,PSOLEFT,PSOZMIN,PSODUPTT,PSODUDIF,PSODUMIS,PSODUREP,PSQ1,PSODUX,PSODUXX,PSODSMIN,PSOFRQZ,PSOQUTOT
68 N PSOQLD,PSOQLDA,PSOQLDT,PSOQLDX
69 ;PSODUTOT = TOTAL OF ALL DURATIONS
70 ;PSODUPTT = TOTAL OF DISPENSE UNITS PER DOSE
71 ;PSODUDIF = DIFF. OF DURATION VS DAYS SUPPLY
72 ;PSOQUTOT=QTY
73 ;PSODUMIS = # OF SEQUENCES MISSING A DURATION IF >1 CAN'T DEFAULT
74 ;PSODUREP = SEQUENCE # THAT IS MISSING DURATION
75 ;PSODSMIN = MINUTES OF DAYS SUPPLY
76 S (PSODUTOT,PSODUDIF,PSODUMIS,PSODUREP,PSODSMIN,PSOQLDA,PSOQLDT,PSOQLDX)=0
77 ;next lines, add complex dose days supply calculation with ANDs
78 F PSOQLD=1:1:QDOSE S:$G(PSOQX("CONJUNCTION",PSOQLD))["A" PSOQLDA=1 S:$G(PSOQX("CONJUNCTION",PSOQLD))["T" PSOQLDT=1 S:$G(PSOQX("CONJUNCTION",PSOQLD))["X" PSOQLDX=1
79 I $G(PSOQLDA)!($G(PSOQLDX)) G QEND
80 S PSOQUTOT=+$G(PSOQX("QTY"))
81 F PSQ1=1:1:QDOSE D Q:PSODUMIS>1
82 .I '$G(PSOQX("DURATION",PSQ1)) S PSODUMIS=PSODUMIS+1,PSODUREP=PSQ1 Q
83 G:PSODUMIS>1 QEND ; More than 1 sequence missing a duration
84 F PSQ=1:1:QDOSE D Q:$G(PSQQUIT)
85 .I '$G(PSOQX("DOSE ORDERED",PSQ))!($G(PSOQX("SCHEDULE",PSQ))="") S PSQQUIT=1 Q
86 .S QTSH=$G(PSOQX("SCHEDULE",PSQ)) D QTS S:'$G(PSOFRQ) PSQQUIT=1 Q:$G(PSQQUIT)
87 .I $G(PSOQX("DURATION",PSQ)) S PSQMNL=$L(PSOQX("DURATION",PSQ)) D
88 ..S PSQMNLX=$S($E(PSOQX("DURATION",PSQ),PSQMNL)="M":1,$E(PSOQX("DURATION",PSQ),PSQMNL)="H":60,$E(PSOQX("DURATION",PSQ),PSQMNL)="S":.01666,$E(PSOQX("DURATION",PSQ),PSQMNL)="W":10080,$E(PSOQX("DURATION",PSQ),PSQMNL)="L":43200,1:1440)
89 ..S PSQMIN=PSQMNLX*(+$G(PSOQX("DURATION",PSQ)))
90 ..S PSODUTOT=PSODUTOT+(PSQMNLX*(+$G(PSOQX("DURATION",PSQ))))
91 .I '$G(PSOQX("DURATION",PSQ)) S PSOFRQZ=PSOFRQ Q
92 .S PSQMINZ=PSQMIN/PSOFRQ
93 .S PSODUPTT=$S($G(PSODUPTT):$G(PSODUPTT),1:0)+(PSQMINZ*+$G(PSOQX("DOSE ORDERED",PSQ)))
94 I $G(PSQQUIT) G QEND
95 I $G(PSOQUTOT)<0 G QEND
96 I '$G(PSODUMIS),$G(PSODUPTT)>$G(PSOQUTOT) G QEND
97 I '$G(PSODUMIS) S PSOZMIN=+$G(PSODUTOT)/1440 D ROUND G QEND
98 I PSODUPTT'<PSOQUTOT!('$G(PSOFRQZ)) G QEND
99 S PSODUPTT=PSOQUTOT-PSODUPTT S PSOLEFT=(PSODUPTT/+$G(PSOQX("DOSE ORDERED",PSODUREP)))*(+$G(PSOFRQZ))
100 S PSODUTOT=PSODUTOT+PSOLEFT S PSOZMIN=PSODUTOT/1440 D ROUND
101 G QEND
102QTS ;Find frequency
103 ;QTSH = SHCEDULE
104 ;either return PSOFRQ for frequency or PSSQUIT for no frequency
105 N SQTFLAG,SQQT,ZZQT,ZZQ,ZZQQ,ZQHOLD,QGLFLAG,PZQT,ZDL,ZZQX
106 K PSOFRQ
107 S (QGLFLAG,ZZQX)=0
108 I $G(QTSH)="" S PSQQUIT=1 Q
109 S SQTFLAG=0 F SQQT=0:0 S SQQT=$O(^PS(51.1,"B",QTSH,SQQT)) Q:'SQQT!($G(SQTFLAG)) I $P($G(^PS(51.1,SQQT,0)),"^",3) S PSOFRQ=$P($G(^(0)),"^",3),SQTFLAG=1
110 Q:SQTFLAG
111 F SQQT=0:0 S SQQT=$O(^PS(51,"B",QTSH,SQQT)) Q:'SQQT!($G(SQTFLAG)) I $P($G(^PS(51,SQQT,0)),"^",8) S PSOFRQ=$P($G(^(0)),"^",8),SQTFLAG=1
112 Q:SQTFLAG
113 S ZZQT=0 F ZZQ=1:1:$L(QTSH) S ZZQQ=$E(QTSH,ZZQ) I ZZQQ=" " S ZZQT=ZZQT+1
114 I 'ZZQT S PSQQUIT=1 Q
115 S ZZQT=ZZQT+1
116 K ZQHOLD S QGLFLAG=0 F PZQT=1:1:ZZQT S (ZDL,ZQHOLD)=$P(QTSH," ",PZQT) D
117 .Q:$G(ZDL)=""
118 .S ZZQX=0 F SQQT=0:0 S SQQT=$O(^PS(51.1,"B",ZDL,SQQT)) Q:'SQQT!($G(ZZQX)) I $P($G(^PS(51.1,SQQT,0)),"^",3) S PSOFRQ=$P($G(^(0)),"^",3),ZZQX=1,QGLFLAG=QGLFLAG+1
119 .Q:ZZQX
120 .S ZZQX=0 F SQQT=0:0 S SQQT=$O(^PS(51,"B",ZDL,SQQT)) Q:'SQQT!($G(ZZQX)) I $P($G(^PS(51,SQQT,0)),"^",8) S PSOFRQ=$P($G(^(0)),"^",8),ZZQX=1,QGLFLAG=QGLFLAG+1
121 I $G(QGLFLAG)>1 K PSOFRQ
122 I '$G(PSOFRQ) S PSQQUIT=1
123 Q
124QEND ;
125 K PSOFRQ
126 Q
127ROUND ;
128 Q:'$G(PSOZMIN)
129 I PSOZMIN'["." S PSOQX("DAYS SUPPLY")=PSOZMIN G RXP
130 S PSOQX("DAYS SUPPLY")=$P(PSOZMIN,".")+1
131RXP ;Compare against Rx Patient Status
132 Q:'$G(PSOQX("PATIENT"))
133 N PSO55,PSO553
134 S PSO55=$P($G(^PS(55,PSOQX("PATIENT"),"PS")),"^") I 'PSO55 G CLOZ
135 S PSO553=$P($G(^PS(53,PSO55,0)),"^",3) I 'PSO553 G CLOZ
136 I PSO553<$G(PSOQX("DAYS SUPPLY")) S PSOQX("DAYS SUPPLY")=PSO553
137CLOZ ;check for clozapine
138 N PSOCLPAT,PSOCLMAX
139 Q:'$G(PSOQX("DRUG"))
140 I $P($G(^PSDRUG(PSOQX("DRUG"),"CLOZ1")),"^")="PSOCLO1" D
141 .S PSOCLPAT=$O(^YSCL(603.01,"C",PSOQX("PATIENT"),0)) Q:'PSOCLPAT
142 .S PSOCLPAT=$P($G(^YSCL(603.01,PSOCLPAT,0)),"^",3)
143 .S PSOCLMAX=$S(PSOCLPAT="M":28,PSOCLPAT="B":14,PSOCLPAT="W":7,1:0)
144 .I PSOCLMAX,PSOCLMAX<$G(PSOQX("DAYS SUPPLY")) S PSOQX("DAYS SUPPLY")=PSOCLMAX
145 Q
146DAY(DATE) ;First 5 digits of FileMan date
147 N X
148 I DATE'?5N Q -1
149 S X=$E(DATE,4,5) I X<1!(X>12) Q -1
150 S X=DATE+1+(X=12*88)_"01"
151 Q $E($$FMADD^XLFDT(X,-1),6,7)
152 ;
153QTYX(PSOQX) ;
154 N PSOQLP,PSOQLN,PSOQAR,PSOCPRQT,QDOSE,QDOSEX S PSOCPRQT=1 F PSOQLP=0:0 S PSOQLP=$O(PSOQX("DURATION",PSOQLP)) Q:'PSOQLP D
155 .S PSOQAR("DURATION",PSOQLP)=$G(PSOQX("DURATION",PSOQLP))
156 .I $E(PSOQX("DURATION",PSOQLP))?1A S PSOQLN=$L(PSOQX("DURATION",PSOQLP)) S PSOQX("DURATION",PSOQLP)=$E(PSOQX("DURATION",PSOQLP),2,PSOQLN)_$E(PSOQX("DURATION",PSOQLP))
157 S QDOSE=0 F QDOSEX=0:0 S QDOSEX=$O(PSOQX("DOSE ORDERED",QDOSEX)) Q:'QDOSEX S QDOSE=QDOSE+1
158 D QTYCP
159 F PSOQLP=0:0 S PSOQLP=$O(PSOQAR("DURATION",PSOQLP)) Q:'PSOQLP D
160 .S PSOQX("DURATION",PSOQLP)=$G(PSOQAR("DURATION",PSOQLP))
161 K PSOCPRQT
162 Q
163DSUP(PSOQX) ;Max Days Supply for CPRS, without QTY (just patient and drug)
164 ;Should we add to accept # of refills?
165 ;If no Drug, should we base on Orderable Item
166 S PSOQX("DAYS SUPPLY")=90
167 Q:'$G(PSOQX("PATIENT"))
168 N PSO55,PSO553
169 S PSO55=$P($G(^PS(55,PSOQX("PATIENT"),"PS")),"^") I 'PSO55 G DSUPDG
170 S PSO553=$P($G(^PS(53,PSO55,0)),"^",3) I 'PSO553 G DSUPDG
171 I PSO553<$G(PSOQX("DAYS SUPPLY")) S PSOQX("DAYS SUPPLY")=PSO553
172DSUPDG ;
173 N PSOCLPAT,PSOCLMAX
174 Q:'$G(PSOQX("DRUG"))
175 I $P($G(^PSDRUG(PSOQX("DRUG"),"CLOZ1")),"^")="PSOCLO1" D
176 .S PSOCLPAT=$O(^YSCL(603.01,"C",PSOQX("PATIENT"),0)) Q:'PSOCLPAT
177 .S PSOCLPAT=$P($G(^YSCL(603.01,PSOCLPAT,0)),"^",3)
178 .S PSOCLMAX=$S(PSOCLPAT="M":28,PSOCLPAT="B":14,$P($G(^(0)),"^",3)="W":7,1:0)
179 .I PSOCLMAX,PSOCLMAX<$G(PSOQX("DAYS SUPPLY")) S PSOQX("DAYS SUPPLY")=PSOCLMAX
180 Q
181MAX(PSOQX) ;
182 G EN^PSOSIGMX
183 Q
Note: See TracBrowser for help on using the repository browser.