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

PSOSIGDS.m

Go to the documentation of this file.
  1. PSOSIGDS ;BIR/RTR - Utility to calculate Days Supply ;May 04, 2021@09:52:11
  1. ;;7.0;OUTPATIENT PHARMACY;**46,222,391,282,444,612,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. ;External reference to PS(55 supported by DBIA 2228
  1. ;External reference to PSDRUG( supported by DBIA 221
  1. ;External reference to YSCL(603.01 supported by DBIA 2697
  1. ;External reference to PSNDF(50.68 supported by DBIA 3735
  1. ;External reference $$MXDAYSUP^PSSUTIL1 supported by DBIA 6229
  1. ;
  1. EN(PSOSIGX) ;
  1. N VARIABLE
  1. Q
  1. SCH ;*282 Centralized Call
  1. D SCH^PSOSIG
  1. Q
  1. QTY(PSOQX) ;
  1. Q
  1. QTYOPS ;
  1. N QDOSE
  1. QTYCP ;CPRS days supply call comes through here
  1. N PSOZMIN,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(QDOSE)
  1. G:QDOSE>1 COMP
  1. Q:'$G(PSOQX("DOSE ORDERED",1))
  1. S PSOLOWER=0
  1. I $G(PSOQX("DURATION",1)) D
  1. .S PSOLOWX=$L(PSOQX("DURATION",1))
  1. .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)
  1. .S PSOLOWER=PSOLOWXL*(+$G(PSOQX("DURATION",1)))
  1. S QTSH=$G(PSOQX("SCHEDULE",1)) D QTS Q:PSQQUIT!('$G(PSOFRQ))
  1. S PSQMIN=$S($G(PSOLOWER):$G(PSOLOWER),1:0) ; PSQMIN=Minutes based in duration, or 0 if no duration
  1. ;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
  1. ;if no duration, just figure out using QTY # of days, then compare that against Rx patient status
  1. S PSOZMIN=0
  1. S PSOZMIN=PSOQX("QTY")/PSOQX("DOSE ORDERED",1)
  1. S PSOZMIN=PSOZMIN*PSOFRQ
  1. I $G(PSOLOWER) S PSOZMIN=$S(PSOLOWER<PSOZMIN:PSOLOWER,1:PSOZMIN)
  1. S PSOZMIN=PSOZMIN/1440
  1. D ROUND G QEND
  1. Q
  1. COMP ;COMPLEX DOSE HERE
  1. N PSQMNL,PSQMNLX,PSODUTOT,PSOLEFT,PSOZMIN,PSODUPTT,PSODUDIF,PSODUMIS,PSODUREP,PSQ1,PSODUX,PSODUXX,PSODSMIN,PSOFRQZ,PSOQUTOT
  1. N PSOQLD,PSOQLDA,PSOQLDT,PSOQLDX
  1. ;PSODUTOT = TOTAL OF ALL DURATIONS
  1. ;PSODUPTT = TOTAL OF DISPENSE UNITS PER DOSE
  1. ;PSODUDIF = DIFF. OF DURATION VS DAYS SUPPLY
  1. ;PSOQUTOT=QTY
  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. S (PSODUTOT,PSODUDIF,PSODUMIS,PSODUREP,PSODSMIN,PSOQLDA,PSOQLDT,PSOQLDX)=0
  1. ;next lines, add complex dose days supply calculation with ANDs
  1. 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
  1. I $G(PSOQLDA)!($G(PSOQLDX)) G QEND
  1. S PSOQUTOT=+$G(PSOQX("QTY"))
  1. F PSQ1=1:1:QDOSE D Q:PSODUMIS>1
  1. .I '$G(PSOQX("DURATION",PSQ1)) S PSODUMIS=PSODUMIS+1,PSODUREP=PSQ1 Q
  1. G:PSODUMIS>1 QEND ; More than 1 sequence missing a duration
  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. ..S PSODUTOT=PSODUTOT+(PSQMNLX*(+$G(PSOQX("DURATION",PSQ))))
  1. .I '$G(PSOQX("DURATION",PSQ)) S PSOFRQZ=PSOFRQ Q
  1. .S PSQMINZ=PSQMIN/PSOFRQ
  1. .S PSODUPTT=$S($G(PSODUPTT):$G(PSODUPTT),1:0)+(PSQMINZ*+$G(PSOQX("DOSE ORDERED",PSQ)))
  1. I $G(PSQQUIT) G QEND
  1. I $G(PSOQUTOT)<0 G QEND
  1. I '$G(PSODUMIS),$G(PSODUPTT)>$G(PSOQUTOT) G QEND
  1. I '$G(PSODUMIS) S PSOZMIN=+$G(PSODUTOT)/1440 D ROUND G QEND
  1. I PSODUPTT'<PSOQUTOT!('$G(PSOFRQZ)) G QEND
  1. S PSODUPTT=PSOQUTOT-PSODUPTT S PSOLEFT=(PSODUPTT/+$G(PSOQX("DOSE ORDERED",PSODUREP)))*(+$G(PSOFRQZ))
  1. S PSODUTOT=PSODUTOT+PSOLEFT S PSOZMIN=PSODUTOT/1440 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(PSOZMIN)
  1. I PSOZMIN'["." S PSOQX("DAYS SUPPLY")=PSOZMIN G RXP
  1. S PSOQX("DAYS SUPPLY")=$P(PSOZMIN,".")+1
  1. RXP ;Compare against Rx Patient Status
  1. Q:'$G(PSOQX("PATIENT"))
  1. N PSO55,PSO553
  1. S PSO55=$P($G(^PS(55,PSOQX("PATIENT"),"PS")),"^") I 'PSO55 G CLOZ
  1. S PSO553=$P($G(^PS(53,PSO55,0)),"^",3) I 'PSO553 G CLOZ
  1. I PSO553<$G(PSOQX("DAYS SUPPLY")) S PSOQX("DAYS SUPPLY")=PSO553
  1. CLOZ ;check for clozapine
  1. N PSOCLPAT,PSOCLMAX
  1. Q:'$G(PSOQX("DRUG"))
  1. I $P($G(^PSDRUG(PSOQX("DRUG"),"CLOZ1")),"^")="PSOCLO1" D
  1. .S PSOCLPAT=$O(^YSCL(603.01,"C",PSOQX("PATIENT"),0)) Q:'PSOCLPAT
  1. .S PSOCLPAT=$P($G(^YSCL(603.01,PSOCLPAT,0)),"^",3)
  1. .;BEGIN - JCH - PSO*7.0*612 - Local override defaults to 4 Day Supply
  1. .I $P($G(^YSCL(603.01,PSOCLPAT,0)),"^")?1U6N S PSOCLPAT="Z"
  1. .S PSOCLMAX=$S(PSOCLPAT="M":28,PSOCLPAT="B":14,PSOCLPAT="W":7,PSOCLPAT="Z":4,1:0)
  1. .;END - JCH - PSO*7.0*612
  1. .I PSOCLMAX,PSOCLMAX<$G(PSOQX("DAYS SUPPLY")) S PSOQX("DAYS SUPPLY")=PSOCLMAX
  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. D QTYCP
  1. 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. DSUP(PSOQX) ;Default Days Supply for CPRS, without QTY (just patient and drug)
  1. ;Should we add to accept # of refills?
  1. ;If no Drug, should we base on Orderable Item *441 MWA yes we should!!!
  1. N CS,DR,OI,MXDS,DRMXDS,OIISCLOZ S CS=0,MXDS=90,DR=$G(PSOQX("DRUG")),OIISCLOZ=0
  1. I DR S CS=$$CSDS(DR),MXDS=$$MXDAYSUP^PSSUTIL1(DR)
  1. ;441 added OI check for clozapine
  1. I 'DR S OI=$G(PSOQX("OI")) D:OI
  1. .N IDT,PAC S DR=0 F S DR=$O(^PSDRUG("ASP",OI,DR)) Q:'DR Q:OIISCLOZ D
  1. ..S:($P($G(^PSDRUG(DR,"CLOZ1")),"^")="PSOCLO1") OIISCLOZ=1
  1. ..S DRMXDS=$$MXDAYSUP^PSSUTIL1(DR) I DRMXDS>MXDS S MXDS=DRMXDS
  1. ..I CS Q
  1. ..S IDT=$P($G(^PSDRUG(DR,"I")),"^"),PAC=$P($G(^(2)),"^",3)
  1. ..I IDT,IDT<DT Q
  1. ..I PAC'["O" Q
  1. ..S CS=$$CSDS(DR)
  1. S PSOQX("DAYS SUPPLY")=$S(CS:30,1:90)
  1. I PSOQX("DAYS SUPPLY")>MXDS S PSOQX("DAYS SUPPLY")=MXDS
  1. Q:'$G(PSOQX("PATIENT"))
  1. N PSO55,PSO553
  1. S PSO55=$P($G(^PS(55,PSOQX("PATIENT"),"PS")),"^") I 'PSO55 G DSUPDG
  1. S PSO553=$P($G(^PS(53,PSO55,0)),"^",3) I 'PSO553 G DSUPDG
  1. I PSO553<$G(PSOQX("DAYS SUPPLY")) S PSOQX("DAYS SUPPLY")=PSO553
  1. DSUPDG ;
  1. N PSOCLPAT,PSOCLMAX,YSCLPSN
  1. Q:'DR
  1. I ($P($G(^PSDRUG(DR,"CLOZ1")),"^")="PSOCLO1")!(OIISCLOZ) D
  1. .;BEGIN: JCH - PSO*7*612
  1. .N PSOCZPTS,PSOERR,PSODFN
  1. .S PSODFN=+$G(PSOQX("PATIENT"))
  1. .S YSCLPSN=$$GET1^DIQ(55,PSODFN,53,"I") Q:YSCLPSN="" ; Get current Clozapine number associated with patient's Clozapine registration
  1. .D FIND^DIC(603.01,"","","QX",PSODFN,"","C","I $P($G(^(0)),""^"")=$G(YSCLPSN)","","PSOCZPTS","PSOERR")
  1. .S PSOCLPAT=$G(PSOCZPTS("DILIST",2,1))
  1. .;END: JCH - PSO*7*612
  1. .S PSOCLPAT=$P($G(^YSCL(603.01,PSOCLPAT,0)),"^",3)
  1. .;BEGIN: JCH - PSO*7*612 - default Days Supply to 4 when registered to Local Override clozapine #
  1. .S:YSCLPSN?1U6N PSOCLPAT="Z"
  1. .S PSOCLMAX=$S(PSOCLPAT="M":28,PSOCLPAT="B":14,PSOCLPAT="W":7,PSOCLPAT="Z":4,1:0)
  1. .;END: JCH - PSO*7*612
  1. .I PSOCLMAX,PSOCLMAX<$G(PSOQX("DAYS SUPPLY")) S PSOQX("DAYS SUPPLY")=PSOCLMAX
  1. Q
  1. MAX(PSOQX) ;
  1. G EN^PSOSIGMX
  1. Q
  1. ;
  1. CSDS(DR) ;
  1. Q:'DR 0
  1. I $P($G(^PSDRUG(DR,"ND")),"^",3) S CS=+$P($G(^PSNDF(50.68,$P(^("ND"),"^",3),7)),"^")
  1. E S CS=$P($G(^PSDRUG(DR,0)),"^",3),CS=$S(CS[1:1,CS[2:2,CS[3:3,CS[4:4,CS[5:5,1:0)
  1. I CS=1!(CS=2)!(CS=3)!(CS=4)!(CS=5) Q 1
  1. Q 0