| 1 | PSOSIGDS ;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 | ;
|
|---|
| 9 | EN(PSOSIGX) ;
|
|---|
| 10 | N VARIABLE
|
|---|
| 11 | Q
|
|---|
| 12 | SCH ;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
|
|---|
| 29 | QTY(PSOQX) ;
|
|---|
| 30 | Q
|
|---|
| 31 | QTYOPS ;
|
|---|
| 32 | N QDOSE
|
|---|
| 33 | QTYCP ;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
|
|---|
| 66 | COMP ;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
|
|---|
| 102 | QTS ;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
|
|---|
| 124 | QEND ;
|
|---|
| 125 | K PSOFRQ
|
|---|
| 126 | Q
|
|---|
| 127 | ROUND ;
|
|---|
| 128 | Q:'$G(PSOZMIN)
|
|---|
| 129 | I PSOZMIN'["." S PSOQX("DAYS SUPPLY")=PSOZMIN G RXP
|
|---|
| 130 | S PSOQX("DAYS SUPPLY")=$P(PSOZMIN,".")+1
|
|---|
| 131 | RXP ;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
|
|---|
| 137 | CLOZ ;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
|
|---|
| 146 | DAY(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 | ;
|
|---|
| 153 | QTYX(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
|
|---|
| 163 | DSUP(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
|
|---|
| 172 | DSUPDG ;
|
|---|
| 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
|
|---|
| 181 | MAX(PSOQX) ;
|
|---|
| 182 | G EN^PSOSIGMX
|
|---|
| 183 | Q
|
|---|
