PSOSIGTX ;BIR/RTR - Utility to calculate quantity ;Sept 20, 2021@16:25
;;7.0;OUTPATIENT PHARMACY;**46,282,446,441**;DEC 1997;Build 208
;External reference to PS(51 supported by DBIA 2224
;External reference to PS(51.1 supported by DBIA 2225
;
EN(PSOSIGX) ;
N VARIABLE
Q
SCH ;*282 Centralized Call
D SCH^PSOSIG
Q
QTY(PSOQX) ;
N QDOSE
QTYCP ;CPRS qty call comes through here
N PSQQUIT,QTSH,PSQ,PSQMIN,PSQMINZ,PSOQRND,PSOLOWER,PSOLOWX,PSOLOWXL,PSOLOWST
K PSOFRQ S PSQQUIT=0
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
;Q:PSQQUIT!('QDOSE)
I '$G(PSOCPRQT) Q:PSQQUIT
Q:'$G(PSOQX("DAYS SUPPLY"))
Q:'$G(QDOSE)
G:QDOSE>1 COMP
TOP ;One Dose for complex and/then
N PSOQDUR
Q:'$G(PSOQX("DOSE ORDERED",PSQDOSE))
Q:'$G(PSOQX("DAYS SUPPLY"))&('$G(PSOQX("DURATION",PSQDOSE)))
S PSOLOWER=0
I $G(PSOQX("DURATION",PSQDOSE)) D
.S PSOLOWX=$L(PSOQX("DURATION",PSQDOSE))
.S PSOQDUR=$G(PSOQX("DURATION",PSQDOSE))
.S PSOLOWXL=$S($E(PSOQDUR,PSOLOWX)="M":1,$E(PSOQDUR,PSOLOWX)="H":60,$E(PSOQDUR,PSOLOWX)="S":.01666,$E(PSOQDUR,PSOLOWX)="W":10080,$E(PSOQDUR,PSOLOWX)="L":43200,1:1440)
.S PSOLOWER=PSOLOWXL*(+$G(PSOQX("DURATION",PSQDOSE)))
I $G(PSOLOWER),$G(PSOLOWER)>PSODSMXX Q
S PSOLOWX=$G(PSODSMXX)
Q:'$G(PSOLOWER)&('$G(PSOLOWX))
S QTSH=$G(PSOQX("SCHEDULE",PSQDOSE)) D QTS Q:PSQQUIT!('$G(PSOFRQ))
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)
Q:'$G(PSOLOWST)
Q:PSOLOWST'>0
S PSQMIN=+$G(PSOLOWST)
S PSQMINZ=PSQMIN/PSOFRQ
S PSOQRND=PSQMINZ*+$G(PSOQX("DOSE ORDERED",PSQDOSE)) Q:'PSOQRND
S PSODSMXX=PSODSMXX-PSQMIN
Q:PSODSMXX<0
D ROUND G QEND
Q
COMP ;COMPLEX DOSE HERE - ANDS AND THENS
;N PSOQAND,PSQL,PSQMNL,PSQMNLX,PSODUTOT,PSODUDIF,PSODUMIS,PSODUREP,PSQ1,PSODUX,PSODUXX,PSODSMIN
;PSODUTOT = TOTAL OF ALL DURATIONS
;PSODUDIF = DIFF. OF DURATION VS DAYS SUPPLY
;PSODUMIS = # OF SEQUENCES MISSING A DURATION IF >1 CAN'T DEFAULT
;PSODUREP = SEQUENCE # THAT IS MISSING DURATION
;PSODSMIN = MINUTES OF DAYS SUPPLY
;PSODSAME = FLAG THAT TELL IF DURATIONS ARE THE SAME
;PSODURT = DURATION MINUTES FOR COMPARE
;S (PSODUTOT,PSODUDIF,PSODUMIS,PSODUREP,PSODSMIN,PSOQAND)=0
;F PSQL=1:1:QDOSE S:$G(PSOQX("CONJUNCTION",PSQL))["A" PSOQAND=1 Q:PSOQAND
;I $G(PSOQTHEN) G COMP^PSOSIGTX
N PSODSMIN,PSODUDIF,PSODUMIS,PSODUREP,PSODUTOT,PSODUX,PSODUXX,PSQ1,PSQMNL,PSQMNLX
N PSQHOLDX,PSQFLAG,PSQMINLP,PSQMINAR,PSODSMXX,PSOTFLAG,PSODSDEC,PSORNDXX,PSOATQUT,PSQDOSE,PSQDOSEX,PSOQZ,PSOQZX S (PSORNDXX,PSOATQUT,PSODSDEC,PSOTFLAG)=0,PSQDOSE=0,PSQDOSEX=QDOSE
I '$D(PSOQX("CONJUNCTION",PSQDOSEX)) S PSOQX("CONJUNCTION",PSQDOSEX)="A",PSOTFLAG=1
S (PSODSMIN,PSODSMXX)=1440*+$G(PSOQX("DAYS SUPPLY"))
;F S PSQDOSE=$O(PSOQX("CONJUNCTION",PSQDOSE)) Q:$G(PSOATQUT)!($G(PSQDOSE)="") I $G(PSOQX("CONJUNCTION",PSQDOSE))["T"!(PSQDOSE=PSQDOSEX) S PSOATQUT=1 D
;.;I 1 DO TOP ELSE DO BELOW, SET BEGINNIG AND END COUNTERS, USE THOSE ON LOOPS BELOW, OR THE SINGLE NUMBER FOR UP TOP (CHANGE 1'S TO NUMBERS)
;.;I '$G(PSOQZ) S PSOQZ=1
;.;I PSQDOSE-PSOQZ=0 D TOP S PSOQZ=PSQDOSE+1 Q
D BOT
;.S PSOQZ=PSQDOSE+1
;
;If DAYS SUPPLY was edited by Pharmacy, don't re-calculate QTY automatically for Digitally Signed Pending Orders
I $G(PSODSEDT),$G(QTYHLD),$G(PSOFDR),$P($G(OR0),"^",24) D Q
. W !!,"The Quantity (",QTYHLD,") has not been changed."
. W !,"Please review and update it if necessary.",!,$C(7)
. N DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR W !
. K PSOQX("QTY")
;
;SET LAST CONJUNCTION, MAKE SURE IT'S NOT PASSED IN FROM cprs
I $G(PSOTFLAG) K PSOQX("CONJUNCTION",PSQDOSEX)
I PSOATQUT K PSOQX("QTY") Q
I $G(PSOQX("QTY")) D ROUNDF
Q
BOT ;
N PSODUMSS,PSODSAME,PSODURT S (PSODUMSS,PSODSAME,PSODURT,PSODUMIS,PSOQRND,PSODUTOT)=0
;F PSQ1=PSOQZ:1:QDOSE D
F PSQ1=1:1:QDOSE D
.I '$G(PSOQX("DURATION",PSQ1)) S PSODUMIS=PSODUMIS+1,PSODUREP=PSQ1 Q
.S PSODUX=$L(PSOQX("DURATION",PSQ1))
.S PSODUMSS=1
.S PSODUXX=$S($E(PSOQX("DURATION",PSQ1),PSODUX)="M":1,$E(PSOQX("DURATION",PSQ1),PSODUX)="H":60,$E(PSOQX("DURATION",PSQ1),PSODUX)="S":.01666,$E(PSOQX("DURATION",PSQ1),PSODUX)="W":10080,$E(PSOQX("DURATION",PSQ1),PSODUX)="L":43200,1:1440)
. ;441 MWA all "Ands" should pick largest duration...not add durations
.N PREVCONJ,PSODIFF S PREVCONJ=$G(PSOQX("CONJUNCTION",PSQ1-1))
.I PREVCONJ="A" D
..N PREVDUX,PREVDUXX
..S PREVDUX=$L($G(PSOQX("DURATION",PSQ1-1))),PREVDUX(1)=$G(PSOQX("DURATION",PSQ1-1))
..I '+PREVDUX!('+PREVDUX(1)) Q
..S PREVDUXX=$S($E(PREVDUX(1),PREVDUX)="M":1,$E(PREVDUX(1),PREVDUX)="H":60,$E(PREVDUX(1),PREVDUX)="S":.01666,$E(PREVDUX(1),PREVDUX)="W":10080,$E(PREVDUX(1),PREVDUX)="L":43200,1:1440)
..I (+PREVDUX(1)*PREVDUXX)>(PSODUXX*(+$G(PSOQX("DURATION",PSQ1)))) S PSQMINAR(PSQ1)=0 Q
..S PSODIFF=((PSODUXX*(+$G(PSOQX("DURATION",PSQ1))))-(+PREVDUX(1)*PREVDUXX))
..S PSODUTOT=PSODUTOT+PSODIFF,PSQMINAR(PSQ1)=PSODIFF
.I PREVCONJ="T" S PSODIFF=(PSODUXX*(+$G(PSOQX("DURATION",PSQ1)))) S PSODUTOT=PSODUTOT+PSODIFF,PSQMINAR(PSQ1)=PSODIFF
.I PREVCONJ="" S PSODUTOT=PSODUXX*(+$G(PSOQX("DURATION",PSQ1)))
.I '$G(PSODSAME),$G(PSODURT),PSODURT'=(PSODUXX*(+$G(PSOQX("DURATION",PSQ1)))) S PSODSAME=1
.S PSODURT=(PSODUXX*(+$G(PSOQX("DURATION",PSQ1))))
;I PSODUMIS,PSODSAME G QEND ; missing durations, and other durations are all not the same
I '$G(PSOQX("DAYS SUPPLY")) G QEND ; missing Days Supply
;S PSODSMIN=1440*+$G(PSOQX("DAYS SUPPLY"))
I PSODUMIS,PSODSAME G QEND ; Missing Durations, other are different
I 'PSODUMIS,PSODSAME,$G(PSODUTOT)>PSODSMIN G QEND ; Every sequence has a duration, some are different, and the total is greater than Days Supply
I 'PSODSAME,PSODURT>PSODSMIN G QEND ; All have a duration, and it's the same, but it's greater than Days Supply, or Missing Durations with other duration the same but greater than Days Supply
I $G(PSODUMIS),PSODUMSS S PSODUDIF=$G(PSODSMIN)-$G(PSODUTOT)
;K PSQMINAR
;F PSQ=PSOQZ:1:QDOSE D Q:$G(PSQQUIT)
F PSQ=1:1:QDOSE D Q:$G(PSQQUIT)
.I '$G(PSOQX("DOSE ORDERED",PSQ))!($G(PSOQX("SCHEDULE",PSQ))="") S PSQQUIT=1 Q
.S QTSH=$G(PSOQX("SCHEDULE",PSQ)) D QTS S:'$G(PSOFRQ) PSQQUIT=1 Q:$G(PSQQUIT)
.I $G(PSOQX("DURATION",PSQ)) S PSQMNL=$L(PSOQX("DURATION",PSQ)) D
..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)
..S PSQMIN=PSQMNLX*(+$G(PSOQX("DURATION",PSQ)))
.;.I $G(PSQMIN) S PSQMINAR(PSQ)=PSQMIN
.I '$G(PSOQX("DURATION",PSQ)) S PSQMIN=$S($G(PSODURT)&('$G(PSODSAME)):$G(PSODURT),1:$G(PSODSMXX)) I PSQMIN S PSQMINAR(PSQ)=PSQMIN
.S PSQMINZ=PSQMIN/PSOFRQ
.S PSOQRND=$S('$G(PSOQRND):PSQMINZ*+$G(PSOQX("DOSE ORDERED",PSQ)),1:$G(PSOQRND)+(PSQMINZ*+$G(PSOQX("DOSE ORDERED",PSQ))))
.;S PSODSMXX=PSODSMXX-PSQMIN
S (PSQFLAG,PSQHOLDX)=0 S PSQMINLP="" F S PSQMINLP=$O(PSQMINAR(PSQMINLP)) Q:PSQMINLP="" S:$G(PSQHOLDX)&($G(PSQHOLDX)'=$G(PSQMINAR(PSQMINLP))) PSQFLAG=1 S PSQHOLDX=$G(PSQMINAR(PSQMINLP))
I $G(PSQFLAG) S PSQMINLP="" F S PSQMINLP=$O(PSQMINAR(PSQMINLP)) Q:PSQMINLP="" I $G(PSQMINAR(PSQMINLP)) S PSODSMXX=PSODSMXX-PSQMINAR(PSQMINLP)
I '$G(PSQFLAG) S PSQMINLP="" F S PSQMINLP=$O(PSQMINAR(PSQMINLP)) Q:PSQMINLP=""!($G(PSQFLAG)) I $G(PSQMINAR(PSQMINLP)) S PSODSMXX=PSODSMXX-PSQMINAR(PSQMINLP),PSQFLAG=1
K PSQMINAR,PSQFLAG
I PSODSMXX<0 G QEND
I $G(PSQQUIT) G QEND
I $G(PSOQRND) D ROUND
G QEND
QTS ;*282 Centralized call
D QTS^PSOSIG
Q
QEND ;
K PSOFRQ
Q
ROUND ;
Q:'$G(PSOQRND)
S PSOQX("QTY")=$G(PSOQX("QTY"))+$G(PSOQRND)
S PSOATQUT=0
Q
ROUNDF ;
I PSOQX("QTY")'["." Q
S PSOQX("QTY")=$P(PSOQX("QTY"),".")+1
Q
DAY(DATE) ;First 5 digits of FileMan date
N X
I DATE'?5N Q -1
S X=$E(DATE,4,5) I X<1!(X>12) Q -1
S X=DATE+1+(X=12*88)_"01"
Q $E($$FMADD^XLFDT(X,-1),6,7)
;
QTYX(PSOQX) ;
N PSOQLP,PSOQLN,PSOQAR,PSOCPRQT,QDOSE,QDOSEX S PSOCPRQT=1 F PSOQLP=0:0 S PSOQLP=$O(PSOQX("DURATION",PSOQLP)) Q:'PSOQLP D
.S PSOQAR("DURATION",PSOQLP)=$G(PSOQX("DURATION",PSOQLP))
.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))
S QDOSE=0 F QDOSEX=0:0 S QDOSEX=$O(PSOQX("DOSE ORDERED",QDOSEX)) Q:'QDOSEX S QDOSE=QDOSE+1
I '$G(PSOQX("QTY")) D QTYCP G QPASS
D QTYCP^PSOSIGDS
QPASS F PSOQLP=0:0 S PSOQLP=$O(PSOQAR("DURATION",PSOQLP)) Q:'PSOQLP D
.S PSOQX("DURATION",PSOQLP)=$G(PSOQAR("DURATION",PSOQLP))
K PSOCPRQT
Q
DAYS(PSOQX) ;Entry point for Days Supply calc for PSO
;Kill days supply here
Q:'$G(PSOQX("QTY"))
D QTYOPS^PSOSIGDS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSIGTX 8832 printed Nov 22, 2024@17:44:54 Page 2
PSOSIGTX ;BIR/RTR - Utility to calculate quantity ;Sept 20, 2021@16:25
+1 ;;7.0;OUTPATIENT PHARMACY;**46,282,446,441**;DEC 1997;Build 208
+2 ;External reference to PS(51 supported by DBIA 2224
+3 ;External reference to PS(51.1 supported by DBIA 2225
+4 ;
EN(PSOSIGX) ;
+1 NEW VARIABLE
+2 QUIT
SCH ;*282 Centralized Call
+1 DO SCH^PSOSIG
+2 QUIT
QTY(PSOQX) ;
+1 NEW QDOSE
QTYCP ;CPRS qty call comes through here
+1 NEW PSQQUIT,QTSH,PSQ,PSQMIN,PSQMINZ,PSOQRND,PSOLOWER,PSOLOWX,PSOLOWXL,PSOLOWST
+2 KILL PSOFRQ
SET PSQQUIT=0
+3 IF '$GET(PSOCPRQT)
SET QDOSE=0
FOR PSQ=0:0
SET PSQ=$ORDER(PSOQX("DOSE",PSQ))
if 'PSQ
QUIT
SET QDOSE=PSQ
if '$GET(PSOQX("DOSE ORDERED",PSQ))
SET PSQQUIT=1
+4 ;Q:PSQQUIT!('QDOSE)
+5 IF '$GET(PSOCPRQT)
if PSQQUIT
QUIT
+6 if '$GET(PSOQX("DAYS SUPPLY"))
QUIT
+7 if '$GET(QDOSE)
QUIT
+8 if QDOSE>1
GOTO COMP
TOP ;One Dose for complex and/then
+1 NEW PSOQDUR
+2 if '$GET(PSOQX("DOSE ORDERED",PSQDOSE))
QUIT
+3 if '$GET(PSOQX("DAYS SUPPLY"))&('$GET(PSOQX("DURATION",PSQDOSE)))
QUIT
+4 SET PSOLOWER=0
+5 IF $GET(PSOQX("DURATION",PSQDOSE))
Begin DoDot:1
+6 SET PSOLOWX=$LENGTH(PSOQX("DURATION",PSQDOSE))
+7 SET PSOQDUR=$GET(PSOQX("DURATION",PSQDOSE))
+8 SET PSOLOWXL=$SELECT($EXTRACT(PSOQDUR,PSOLOWX)="M":1,$EXTRACT(PSOQDUR,PSOLOWX)="H":60,$EXTRACT(PSOQDUR,PSOLOWX)="S":.01666,$EXTRACT(PSOQDUR,PSOLOWX)="W":10080,$EXTRACT(PSOQDUR,PSOLOWX)="L":43200,1:1440)
+9 SET PSOLOWER=PSOLOWXL*(+$GET(PSOQX("DURATION",PSQDOSE)))
End DoDot:1
+10 IF $GET(PSOLOWER)
IF $GET(PSOLOWER)>PSODSMXX
QUIT
+11 SET PSOLOWX=$GET(PSODSMXX)
+12 if '$GET(PSOLOWER)&('$GET(PSOLOWX))
QUIT
+13 SET QTSH=$GET(PSOQX("SCHEDULE",PSQDOSE))
DO QTS
if PSQQUIT!('$GET(PSOFRQ))
QUIT
+14 SET PSOLOWST=$SELECT('$GET(PSOLOWER):$GET(PSOLOWX),'$GET(PSOLOWX):$GET(PSOLOWER),$GET(PSOLOWER)>$GET(PSOLOWX):$GET(PSOLOWX),$GET(PSOLOWX)>$GET(PSOLOWER):$GET(PSOLOWER),$GET(PSOLOWX)=$GET(PSOLOWER):$GET(PSOLOWER),1:0)
+15 if '$GET(PSOLOWST)
QUIT
+16 if PSOLOWST'>0
QUIT
+17 SET PSQMIN=+$GET(PSOLOWST)
+18 SET PSQMINZ=PSQMIN/PSOFRQ
+19 SET PSOQRND=PSQMINZ*+$GET(PSOQX("DOSE ORDERED",PSQDOSE))
if 'PSOQRND
QUIT
+20 SET PSODSMXX=PSODSMXX-PSQMIN
+21 if PSODSMXX<0
QUIT
+22 DO ROUND
GOTO QEND
+23 QUIT
COMP ;COMPLEX DOSE HERE - ANDS AND THENS
+1 ;N PSOQAND,PSQL,PSQMNL,PSQMNLX,PSODUTOT,PSODUDIF,PSODUMIS,PSODUREP,PSQ1,PSODUX,PSODUXX,PSODSMIN
+2 ;PSODUTOT = TOTAL OF ALL DURATIONS
+3 ;PSODUDIF = DIFF. OF DURATION VS DAYS SUPPLY
+4 ;PSODUMIS = # OF SEQUENCES MISSING A DURATION IF >1 CAN'T DEFAULT
+5 ;PSODUREP = SEQUENCE # THAT IS MISSING DURATION
+6 ;PSODSMIN = MINUTES OF DAYS SUPPLY
+7 ;PSODSAME = FLAG THAT TELL IF DURATIONS ARE THE SAME
+8 ;PSODURT = DURATION MINUTES FOR COMPARE
+9 ;S (PSODUTOT,PSODUDIF,PSODUMIS,PSODUREP,PSODSMIN,PSOQAND)=0
+10 ;F PSQL=1:1:QDOSE S:$G(PSOQX("CONJUNCTION",PSQL))["A" PSOQAND=1 Q:PSOQAND
+11 ;I $G(PSOQTHEN) G COMP^PSOSIGTX
+12 NEW PSODSMIN,PSODUDIF,PSODUMIS,PSODUREP,PSODUTOT,PSODUX,PSODUXX,PSQ1,PSQMNL,PSQMNLX
+13 NEW PSQHOLDX,PSQFLAG,PSQMINLP,PSQMINAR,PSODSMXX,PSOTFLAG,PSODSDEC,PSORNDXX,PSOATQUT,PSQDOSE,PSQDOSEX,PSOQZ,PSOQZX
SET (PSORNDXX,PSOATQUT,PSODSDEC,PSOTFLAG)=0
SET PSQDOSE=0
SET PSQDOSEX=QDOSE
+14 IF '$DATA(PSOQX("CONJUNCTION",PSQDOSEX))
SET PSOQX("CONJUNCTION",PSQDOSEX)="A"
SET PSOTFLAG=1
+15 SET (PSODSMIN,PSODSMXX)=1440*+$GET(PSOQX("DAYS SUPPLY"))
+16 ;F S PSQDOSE=$O(PSOQX("CONJUNCTION",PSQDOSE)) Q:$G(PSOATQUT)!($G(PSQDOSE)="") I $G(PSOQX("CONJUNCTION",PSQDOSE))["T"!(PSQDOSE=PSQDOSEX) S PSOATQUT=1 D
+17 ;.;I 1 DO TOP ELSE DO BELOW, SET BEGINNIG AND END COUNTERS, USE THOSE ON LOOPS BELOW, OR THE SINGLE NUMBER FOR UP TOP (CHANGE 1'S TO NUMBERS)
+18 ;.;I '$G(PSOQZ) S PSOQZ=1
+19 ;.;I PSQDOSE-PSOQZ=0 D TOP S PSOQZ=PSQDOSE+1 Q
+20 DO BOT
+21 ;.S PSOQZ=PSQDOSE+1
+22 ;
+23 ;If DAYS SUPPLY was edited by Pharmacy, don't re-calculate QTY automatically for Digitally Signed Pending Orders
+24 IF $GET(PSODSEDT)
IF $GET(QTYHLD)
IF $GET(PSOFDR)
IF $PIECE($GET(OR0),"^",24)
Begin DoDot:1
+25 WRITE !!,"The Quantity (",QTYHLD,") has not been changed."
+26 WRITE !,"Please review and update it if necessary.",!,$CHAR(7)
+27 NEW DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
WRITE !
+28 KILL PSOQX("QTY")
End DoDot:1
QUIT
+29 ;
+30 ;SET LAST CONJUNCTION, MAKE SURE IT'S NOT PASSED IN FROM cprs
+31 IF $GET(PSOTFLAG)
KILL PSOQX("CONJUNCTION",PSQDOSEX)
+32 IF PSOATQUT
KILL PSOQX("QTY")
QUIT
+33 IF $GET(PSOQX("QTY"))
DO ROUNDF
+34 QUIT
BOT ;
+1 NEW PSODUMSS,PSODSAME,PSODURT
SET (PSODUMSS,PSODSAME,PSODURT,PSODUMIS,PSOQRND,PSODUTOT)=0
+2 ;F PSQ1=PSOQZ:1:QDOSE D
+3 FOR PSQ1=1:1:QDOSE
Begin DoDot:1
+4 IF '$GET(PSOQX("DURATION",PSQ1))
SET PSODUMIS=PSODUMIS+1
SET PSODUREP=PSQ1
QUIT
+5 SET PSODUX=$LENGTH(PSOQX("DURATION",PSQ1))
+6 SET PSODUMSS=1
+7 SET PSODUXX=$SELECT($EXTRACT(PSOQX("DURATION",PSQ1),PSODUX)="M":1,$EXTRACT(PSOQX("DURATION",PSQ1),PSODUX)="H":60,...
... $EXTRACT(PSOQX("DURATION",PSQ1),PSODUX)="S":.01666,$EXTRACT(PSOQX("DURATION",PSQ1),PSODUX)="W":10080,$EXTRACT(PSOQX("DURATION",PSQ1),PSODUX)="L":43200,1:1440)
+8 ;441 MWA all "Ands" should pick largest duration...not add durations
+9 NEW PREVCONJ,PSODIFF
SET PREVCONJ=$GET(PSOQX("CONJUNCTION",PSQ1-1))
+10 IF PREVCONJ="A"
Begin DoDot:2
+11 NEW PREVDUX,PREVDUXX
+12 SET PREVDUX=$LENGTH($GET(PSOQX("DURATION",PSQ1-1)))
SET PREVDUX(1)=$GET(PSOQX("DURATION",PSQ1-1))
+13 IF '+PREVDUX!('+PREVDUX(1))
QUIT
+14 SET PREVDUXX=$SELECT($EXTRACT(PREVDUX(1),PREVDUX)="M":1,$EXTRACT(PREVDUX(1),PREVDUX)="H":60,$EXTRACT(PREVDUX(1),PREVDUX)="S":.01666,$EXTRACT(PREVDUX(1),PREVDUX)="W":10080,$EXTRACT(PREVDUX(1),PREVDUX)="L":43200,1:1440)
+15 IF (+PREVDUX(1)*PREVDUXX)>(PSODUXX*(+$GET(PSOQX("DURATION",PSQ1))))
SET PSQMINAR(PSQ1)=0
QUIT
+16 SET PSODIFF=((PSODUXX*(+$GET(PSOQX("DURATION",PSQ1))))-(+PREVDUX(1)*PREVDUXX))
+17 SET PSODUTOT=PSODUTOT+PSODIFF
SET PSQMINAR(PSQ1)=PSODIFF
End DoDot:2
+18 IF PREVCONJ="T"
SET PSODIFF=(PSODUXX*(+$GET(PSOQX("DURATION",PSQ1))))
SET PSODUTOT=PSODUTOT+PSODIFF
SET PSQMINAR(PSQ1)=PSODIFF
+19 IF PREVCONJ=""
SET PSODUTOT=PSODUXX*(+$GET(PSOQX("DURATION",PSQ1)))
+20 IF '$GET(PSODSAME)
IF $GET(PSODURT)
IF PSODURT'=(PSODUXX*(+$GET(PSOQX("DURATION",PSQ1))))
SET PSODSAME=1
+21 SET PSODURT=(PSODUXX*(+$GET(PSOQX("DURATION",PSQ1))))
End DoDot:1
+22 ;I PSODUMIS,PSODSAME G QEND ; missing durations, and other durations are all not the same
+23 ; missing Days Supply
IF '$GET(PSOQX("DAYS SUPPLY"))
GOTO QEND
+24 ;S PSODSMIN=1440*+$G(PSOQX("DAYS SUPPLY"))
+25 ; Missing Durations, other are different
IF PSODUMIS
IF PSODSAME
GOTO QEND
+26 ; Every sequence has a duration, some are different, and the total is greater than Days Supply
IF 'PSODUMIS
IF PSODSAME
IF $GET(PSODUTOT)>PSODSMIN
GOTO QEND
+27 ; All have a duration, and it's the same, but it's greater than Days Supply, or Missing Durations with other duration the same but greater than Days Supply
IF 'PSODSAME
IF PSODURT>PSODSMIN
GOTO QEND
+28 IF $GET(PSODUMIS)
IF PSODUMSS
SET PSODUDIF=$GET(PSODSMIN)-$GET(PSODUTOT)
+29 ;K PSQMINAR
+30 ;F PSQ=PSOQZ:1:QDOSE D Q:$G(PSQQUIT)
+31 FOR PSQ=1:1:QDOSE
Begin DoDot:1
+32 IF '$GET(PSOQX("DOSE ORDERED",PSQ))!($GET(PSOQX("SCHEDULE",PSQ))="")
SET PSQQUIT=1
QUIT
+33 SET QTSH=$GET(PSOQX("SCHEDULE",PSQ))
DO QTS
if '$GET(PSOFRQ)
SET PSQQUIT=1
if $GET(PSQQUIT)
QUIT
+34 IF $GET(PSOQX("DURATION",PSQ))
SET PSQMNL=$LENGTH(PSOQX("DURATION",PSQ))
Begin DoDot:2
+35 SET PSQMNLX=$SELECT($EXTRACT(PSOQX("DURATION",PSQ),PSQMNL)="M":1,$EXTRACT(PSOQX("DURATION",PSQ),PSQMNL)="H":60,$EXTRACT(PSOQX("DURATION",PSQ),PSQMNL)="S":.01666,...
... $EXTRACT(PSOQX("DURATION",PSQ),PSQMNL)="W":10080,$EXTRACT(PSOQX("DURATION",PSQ),PSQMNL)="L":43200,1:1440)
+36 SET PSQMIN=PSQMNLX*(+$GET(PSOQX("DURATION",PSQ)))
End DoDot:2
+37 ;.I $G(PSQMIN) S PSQMINAR(PSQ)=PSQMIN
+38 IF '$GET(PSOQX("DURATION",PSQ))
SET PSQMIN=$SELECT($GET(PSODURT)&('$GET(PSODSAME)):$GET(PSODURT),1:$GET(PSODSMXX))
IF PSQMIN
SET PSQMINAR(PSQ)=PSQMIN
+39 SET PSQMINZ=PSQMIN/PSOFRQ
+40 SET PSOQRND=$SELECT('$GET(PSOQRND):PSQMINZ*+$GET(PSOQX("DOSE ORDERED",PSQ)),1:$GET(PSOQRND)+(PSQMINZ*+$GET(PSOQX("DOSE ORDERED",PSQ))))
+41 ;S PSODSMXX=PSODSMXX-PSQMIN
End DoDot:1
if $GET(PSQQUIT)
QUIT
+42 SET (PSQFLAG,PSQHOLDX)=0
SET PSQMINLP=""
FOR
SET PSQMINLP=$ORDER(PSQMINAR(PSQMINLP))
if PSQMINLP=""
QUIT
if $GET(PSQHOLDX)&($GET(PSQHOLDX)'=$GET(PSQMINAR(PSQMINLP)))
SET PSQFLAG=1
SET PSQHOLDX=$GET(PSQMINAR(PSQMINLP))
+43 IF $GET(PSQFLAG)
SET PSQMINLP=""
FOR
SET PSQMINLP=$ORDER(PSQMINAR(PSQMINLP))
if PSQMINLP=""
QUIT
IF $GET(PSQMINAR(PSQMINLP))
SET PSODSMXX=PSODSMXX-PSQMINAR(PSQMINLP)
+44 IF '$GET(PSQFLAG)
SET PSQMINLP=""
FOR
SET PSQMINLP=$ORDER(PSQMINAR(PSQMINLP))
if PSQMINLP=""!($GET(PSQFLAG))
QUIT
IF $GET(PSQMINAR(PSQMINLP))
SET PSODSMXX=PSODSMXX-PSQMINAR(PSQMINLP)
SET PSQFLAG=1
+45 KILL PSQMINAR,PSQFLAG
+46 IF PSODSMXX<0
GOTO QEND
+47 IF $GET(PSQQUIT)
GOTO QEND
+48 IF $GET(PSOQRND)
DO ROUND
+49 GOTO QEND
QTS ;*282 Centralized call
+1 DO QTS^PSOSIG
+2 QUIT
QEND ;
+1 KILL PSOFRQ
+2 QUIT
ROUND ;
+1 if '$GET(PSOQRND)
QUIT
+2 SET PSOQX("QTY")=$GET(PSOQX("QTY"))+$GET(PSOQRND)
+3 SET PSOATQUT=0
+4 QUIT
ROUNDF ;
+1 IF PSOQX("QTY")'["."
QUIT
+2 SET PSOQX("QTY")=$PIECE(PSOQX("QTY"),".")+1
+3 QUIT
DAY(DATE) ;First 5 digits of FileMan date
+1 NEW X
+2 IF DATE'?5N
QUIT -1
+3 SET X=$EXTRACT(DATE,4,5)
IF X<1!(X>12)
QUIT -1
+4 SET X=DATE+1+(X=12*88)_"01"
+5 QUIT $EXTRACT($$FMADD^XLFDT(X,-1),6,7)
+6 ;
QTYX(PSOQX) ;
+1 NEW PSOQLP,PSOQLN,PSOQAR,PSOCPRQT,QDOSE,QDOSEX
SET PSOCPRQT=1
FOR PSOQLP=0:0
SET PSOQLP=$ORDER(PSOQX("DURATION",PSOQLP))
if 'PSOQLP
QUIT
Begin DoDot:1
+2 SET PSOQAR("DURATION",PSOQLP)=$GET(PSOQX("DURATION",PSOQLP))
+3 IF $EXTRACT(PSOQX("DURATION",PSOQLP))?1A
SET PSOQLN=$LENGTH(PSOQX("DURATION",PSOQLP))
SET PSOQX("DURATION",PSOQLP)=$EXTRACT(PSOQX("DURATION",PSOQLP),2,PSOQLN)_$EXTRACT(PSOQX("DURATION",PSOQLP))
End DoDot:1
+4 SET QDOSE=0
FOR QDOSEX=0:0
SET QDOSEX=$ORDER(PSOQX("DOSE ORDERED",QDOSEX))
if 'QDOSEX
QUIT
SET QDOSE=QDOSE+1
+5 IF '$GET(PSOQX("QTY"))
DO QTYCP
GOTO QPASS
+6 DO QTYCP^PSOSIGDS
QPASS FOR PSOQLP=0:0
SET PSOQLP=$ORDER(PSOQAR("DURATION",PSOQLP))
if 'PSOQLP
QUIT
Begin DoDot:1
+1 SET PSOQX("DURATION",PSOQLP)=$GET(PSOQAR("DURATION",PSOQLP))
End DoDot:1
+2 KILL PSOCPRQT
+3 QUIT
DAYS(PSOQX) ;Entry point for Days Supply calc for PSO
+1 ;Kill days supply here
+2 if '$GET(PSOQX("QTY"))
QUIT
+3 DO QTYOPS^PSOSIGDS
+4 QUIT
