Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOSIGTX

PSOSIGTX.m

Go to the documentation of this file.
  1. 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
  1. ;External reference to PS(51 supported by DBIA 2224
  1. ;External reference to PS(51.1 supported by DBIA 2225
  1. ;
  1. EN(PSOSIGX) ;
  1. N VARIABLE
  1. Q
  1. SCH ;*282 Centralized Call
  1. D SCH^PSOSIG
  1. Q
  1. QTY(PSOQX) ;
  1. N QDOSE
  1. QTYCP ;CPRS qty call comes through here
  1. N PSQQUIT,QTSH,PSQ,PSQMIN,PSQMINZ,PSOQRND,PSOLOWER,PSOLOWX,PSOLOWXL,PSOLOWST
  1. K PSOFRQ S PSQQUIT=0
  1. 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
  1. ;Q:PSQQUIT!('QDOSE)
  1. I '$G(PSOCPRQT) Q:PSQQUIT
  1. Q:'$G(PSOQX("DAYS SUPPLY"))
  1. Q:'$G(QDOSE)
  1. G:QDOSE>1 COMP
  1. TOP ;One Dose for complex and/then
  1. N PSOQDUR
  1. Q:'$G(PSOQX("DOSE ORDERED",PSQDOSE))
  1. Q:'$G(PSOQX("DAYS SUPPLY"))&('$G(PSOQX("DURATION",PSQDOSE)))
  1. S PSOLOWER=0
  1. I $G(PSOQX("DURATION",PSQDOSE)) D
  1. .S PSOLOWX=$L(PSOQX("DURATION",PSQDOSE))
  1. .S PSOQDUR=$G(PSOQX("DURATION",PSQDOSE))
  1. .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)
  1. .S PSOLOWER=PSOLOWXL*(+$G(PSOQX("DURATION",PSQDOSE)))
  1. I $G(PSOLOWER),$G(PSOLOWER)>PSODSMXX Q
  1. S PSOLOWX=$G(PSODSMXX)
  1. Q:'$G(PSOLOWER)&('$G(PSOLOWX))
  1. S QTSH=$G(PSOQX("SCHEDULE",PSQDOSE)) D QTS Q:PSQQUIT!('$G(PSOFRQ))
  1. 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)
  1. Q:'$G(PSOLOWST)
  1. Q:PSOLOWST'>0
  1. S PSQMIN=+$G(PSOLOWST)
  1. S PSQMINZ=PSQMIN/PSOFRQ
  1. S PSOQRND=PSQMINZ*+$G(PSOQX("DOSE ORDERED",PSQDOSE)) Q:'PSOQRND
  1. S PSODSMXX=PSODSMXX-PSQMIN
  1. Q:PSODSMXX<0
  1. D ROUND G QEND
  1. Q
  1. COMP ;COMPLEX DOSE HERE - ANDS AND THENS
  1. ;N PSOQAND,PSQL,PSQMNL,PSQMNLX,PSODUTOT,PSODUDIF,PSODUMIS,PSODUREP,PSQ1,PSODUX,PSODUXX,PSODSMIN
  1. ;PSODUTOT = TOTAL OF ALL DURATIONS
  1. ;PSODUDIF = DIFF. OF DURATION VS DAYS SUPPLY
  1. ;PSODUMIS = # OF SEQUENCES MISSING A DURATION IF >1 CAN'T DEFAULT
  1. ;PSODUREP = SEQUENCE # THAT IS MISSING DURATION
  1. ;PSODSMIN = MINUTES OF DAYS SUPPLY
  1. ;PSODSAME = FLAG THAT TELL IF DURATIONS ARE THE SAME
  1. ;PSODURT = DURATION MINUTES FOR COMPARE
  1. ;S (PSODUTOT,PSODUDIF,PSODUMIS,PSODUREP,PSODSMIN,PSOQAND)=0
  1. ;F PSQL=1:1:QDOSE S:$G(PSOQX("CONJUNCTION",PSQL))["A" PSOQAND=1 Q:PSOQAND
  1. ;I $G(PSOQTHEN) G COMP^PSOSIGTX
  1. N PSODSMIN,PSODUDIF,PSODUMIS,PSODUREP,PSODUTOT,PSODUX,PSODUXX,PSQ1,PSQMNL,PSQMNLX
  1. N PSQHOLDX,PSQFLAG,PSQMINLP,PSQMINAR,PSODSMXX,PSOTFLAG,PSODSDEC,PSORNDXX,PSOATQUT,PSQDOSE,PSQDOSEX,PSOQZ,PSOQZX S (PSORNDXX,PSOATQUT,PSODSDEC,PSOTFLAG)=0,PSQDOSE=0,PSQDOSEX=QDOSE
  1. I '$D(PSOQX("CONJUNCTION",PSQDOSEX)) S PSOQX("CONJUNCTION",PSQDOSEX)="A",PSOTFLAG=1
  1. S (PSODSMIN,PSODSMXX)=1440*+$G(PSOQX("DAYS SUPPLY"))
  1. ;F S PSQDOSE=$O(PSOQX("CONJUNCTION",PSQDOSE)) Q:$G(PSOATQUT)!($G(PSQDOSE)="") I $G(PSOQX("CONJUNCTION",PSQDOSE))["T"!(PSQDOSE=PSQDOSEX) S PSOATQUT=1 D
  1. ;.;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)
  1. ;.;I '$G(PSOQZ) S PSOQZ=1
  1. ;.;I PSQDOSE-PSOQZ=0 D TOP S PSOQZ=PSQDOSE+1 Q
  1. D BOT
  1. ;.S PSOQZ=PSQDOSE+1
  1. ;
  1. ;If DAYS SUPPLY was edited by Pharmacy, don't re-calculate QTY automatically for Digitally Signed Pending Orders
  1. I $G(PSODSEDT),$G(QTYHLD),$G(PSOFDR),$P($G(OR0),"^",24) D Q
  1. . W !!,"The Quantity (",QTYHLD,") has not been changed."
  1. . W !,"Please review and update it if necessary.",!,$C(7)
  1. . N DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR W !
  1. . K PSOQX("QTY")
  1. ;
  1. ;SET LAST CONJUNCTION, MAKE SURE IT'S NOT PASSED IN FROM cprs
  1. I $G(PSOTFLAG) K PSOQX("CONJUNCTION",PSQDOSEX)
  1. I PSOATQUT K PSOQX("QTY") Q
  1. I $G(PSOQX("QTY")) D ROUNDF
  1. Q
  1. BOT ;
  1. N PSODUMSS,PSODSAME,PSODURT S (PSODUMSS,PSODSAME,PSODURT,PSODUMIS,PSOQRND,PSODUTOT)=0
  1. ;F PSQ1=PSOQZ:1:QDOSE D
  1. F PSQ1=1:1:QDOSE D
  1. .I '$G(PSOQX("DURATION",PSQ1)) S PSODUMIS=PSODUMIS+1,PSODUREP=PSQ1 Q
  1. .S PSODUX=$L(PSOQX("DURATION",PSQ1))
  1. .S PSODUMSS=1
  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)
  1. . ;441 MWA all "Ands" should pick largest duration...not add durations
  1. .N PREVCONJ,PSODIFF S PREVCONJ=$G(PSOQX("CONJUNCTION",PSQ1-1))
  1. .I PREVCONJ="A" D
  1. ..N PREVDUX,PREVDUXX
  1. ..S PREVDUX=$L($G(PSOQX("DURATION",PSQ1-1))),PREVDUX(1)=$G(PSOQX("DURATION",PSQ1-1))
  1. ..I '+PREVDUX!('+PREVDUX(1)) Q
  1. ..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)
  1. ..I (+PREVDUX(1)*PREVDUXX)>(PSODUXX*(+$G(PSOQX("DURATION",PSQ1)))) S PSQMINAR(PSQ1)=0 Q
  1. ..S PSODIFF=((PSODUXX*(+$G(PSOQX("DURATION",PSQ1))))-(+PREVDUX(1)*PREVDUXX))
  1. ..S PSODUTOT=PSODUTOT+PSODIFF,PSQMINAR(PSQ1)=PSODIFF
  1. .I PREVCONJ="T" S PSODIFF=(PSODUXX*(+$G(PSOQX("DURATION",PSQ1)))) S PSODUTOT=PSODUTOT+PSODIFF,PSQMINAR(PSQ1)=PSODIFF
  1. .I PREVCONJ="" S PSODUTOT=PSODUXX*(+$G(PSOQX("DURATION",PSQ1)))
  1. .I '$G(PSODSAME),$G(PSODURT),PSODURT'=(PSODUXX*(+$G(PSOQX("DURATION",PSQ1)))) S PSODSAME=1
  1. .S PSODURT=(PSODUXX*(+$G(PSOQX("DURATION",PSQ1))))
  1. ;I PSODUMIS,PSODSAME G QEND ; missing durations, and other durations are all not the same
  1. I '$G(PSOQX("DAYS SUPPLY")) G QEND ; missing Days Supply
  1. ;S PSODSMIN=1440*+$G(PSOQX("DAYS SUPPLY"))
  1. I PSODUMIS,PSODSAME G QEND ; Missing Durations, other are different
  1. I 'PSODUMIS,PSODSAME,$G(PSODUTOT)>PSODSMIN G QEND ; Every sequence has a duration, some are different, and the total is greater than Days Supply
  1. 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
  1. I $G(PSODUMIS),PSODUMSS S PSODUDIF=$G(PSODSMIN)-$G(PSODUTOT)
  1. ;K PSQMINAR
  1. ;F PSQ=PSOQZ:1:QDOSE D Q:$G(PSQQUIT)
  1. F PSQ=1:1:QDOSE D Q:$G(PSQQUIT)
  1. .I '$G(PSOQX("DOSE ORDERED",PSQ))!($G(PSOQX("SCHEDULE",PSQ))="") S PSQQUIT=1 Q
  1. .S QTSH=$G(PSOQX("SCHEDULE",PSQ)) D QTS S:'$G(PSOFRQ) PSQQUIT=1 Q:$G(PSQQUIT)
  1. .I $G(PSOQX("DURATION",PSQ)) S PSQMNL=$L(PSOQX("DURATION",PSQ)) D
  1. ..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)
  1. ..S PSQMIN=PSQMNLX*(+$G(PSOQX("DURATION",PSQ)))
  1. .;.I $G(PSQMIN) S PSQMINAR(PSQ)=PSQMIN
  1. .I '$G(PSOQX("DURATION",PSQ)) S PSQMIN=$S($G(PSODURT)&('$G(PSODSAME)):$G(PSODURT),1:$G(PSODSMXX)) I PSQMIN S PSQMINAR(PSQ)=PSQMIN
  1. .S PSQMINZ=PSQMIN/PSOFRQ
  1. .S PSOQRND=$S('$G(PSOQRND):PSQMINZ*+$G(PSOQX("DOSE ORDERED",PSQ)),1:$G(PSOQRND)+(PSQMINZ*+$G(PSOQX("DOSE ORDERED",PSQ))))
  1. .;S PSODSMXX=PSODSMXX-PSQMIN
  1. 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))
  1. I $G(PSQFLAG) S PSQMINLP="" F S PSQMINLP=$O(PSQMINAR(PSQMINLP)) Q:PSQMINLP="" I $G(PSQMINAR(PSQMINLP)) S PSODSMXX=PSODSMXX-PSQMINAR(PSQMINLP)
  1. 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
  1. K PSQMINAR,PSQFLAG
  1. I PSODSMXX<0 G QEND
  1. I $G(PSQQUIT) G QEND
  1. I $G(PSOQRND) D ROUND
  1. G QEND
  1. QTS ;*282 Centralized call
  1. D QTS^PSOSIG
  1. Q
  1. QEND ;
  1. K PSOFRQ
  1. Q
  1. ROUND ;
  1. Q:'$G(PSOQRND)
  1. S PSOQX("QTY")=$G(PSOQX("QTY"))+$G(PSOQRND)
  1. S PSOATQUT=0
  1. Q
  1. ROUNDF ;
  1. I PSOQX("QTY")'["." Q
  1. S PSOQX("QTY")=$P(PSOQX("QTY"),".")+1
  1. Q
  1. DAY(DATE) ;First 5 digits of FileMan date
  1. N X
  1. I DATE'?5N Q -1
  1. S X=$E(DATE,4,5) I X<1!(X>12) Q -1
  1. S X=DATE+1+(X=12*88)_"01"
  1. Q $E($$FMADD^XLFDT(X,-1),6,7)
  1. ;
  1. QTYX(PSOQX) ;
  1. N PSOQLP,PSOQLN,PSOQAR,PSOCPRQT,QDOSE,QDOSEX S PSOCPRQT=1 F PSOQLP=0:0 S PSOQLP=$O(PSOQX("DURATION",PSOQLP)) Q:'PSOQLP D
  1. .S PSOQAR("DURATION",PSOQLP)=$G(PSOQX("DURATION",PSOQLP))
  1. .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))
  1. S QDOSE=0 F QDOSEX=0:0 S QDOSEX=$O(PSOQX("DOSE ORDERED",QDOSEX)) Q:'QDOSEX S QDOSE=QDOSE+1
  1. I '$G(PSOQX("QTY")) D QTYCP G QPASS
  1. D QTYCP^PSOSIGDS
  1. QPASS F PSOQLP=0:0 S PSOQLP=$O(PSOQAR("DURATION",PSOQLP)) Q:'PSOQLP D
  1. .S PSOQX("DURATION",PSOQLP)=$G(PSOQAR("DURATION",PSOQLP))
  1. K PSOCPRQT
  1. Q
  1. DAYS(PSOQX) ;Entry point for Days Supply calc for PSO
  1. ;Kill days supply here
  1. Q:'$G(PSOQX("QTY"))
  1. D QTYOPS^PSOSIGDS
  1. Q