- PSOSIGDS ;BIR/RTR - Utility to calculate Days Supply ;May 04, 2021@09:52:11
- ;;7.0;OUTPATIENT PHARMACY;**46,222,391,282,444,612,441**;DEC 1997;Build 208
- ;External reference to PS(51 supported by DBIA 2224
- ;External reference to PS(51.1 supported by DBIA 2225
- ;External reference to PS(55 supported by DBIA 2228
- ;External reference to PSDRUG( supported by DBIA 221
- ;External reference to YSCL(603.01 supported by DBIA 2697
- ;External reference to PSNDF(50.68 supported by DBIA 3735
- ;External reference $$MXDAYSUP^PSSUTIL1 supported by DBIA 6229
- ;
- EN(PSOSIGX) ;
- N VARIABLE
- Q
- SCH ;*282 Centralized Call
- D SCH^PSOSIG
- Q
- QTY(PSOQX) ;
- Q
- QTYOPS ;
- N QDOSE
- QTYCP ;CPRS days supply call comes through here
- N PSOZMIN,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(QDOSE)
- G:QDOSE>1 COMP
- Q:'$G(PSOQX("DOSE ORDERED",1))
- S PSOLOWER=0
- I $G(PSOQX("DURATION",1)) D
- .S PSOLOWX=$L(PSOQX("DURATION",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)
- .S PSOLOWER=PSOLOWXL*(+$G(PSOQX("DURATION",1)))
- S QTSH=$G(PSOQX("SCHEDULE",1)) D QTS Q:PSQQUIT!('$G(PSOFRQ))
- S PSQMIN=$S($G(PSOLOWER):$G(PSOLOWER),1:0) ; PSQMIN=Minutes based in duration, or 0 if no duration
- ;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
- ;if no duration, just figure out using QTY # of days, then compare that against Rx patient status
- S PSOZMIN=0
- S PSOZMIN=PSOQX("QTY")/PSOQX("DOSE ORDERED",1)
- S PSOZMIN=PSOZMIN*PSOFRQ
- I $G(PSOLOWER) S PSOZMIN=$S(PSOLOWER<PSOZMIN:PSOLOWER,1:PSOZMIN)
- S PSOZMIN=PSOZMIN/1440
- D ROUND G QEND
- Q
- COMP ;COMPLEX DOSE HERE
- N PSQMNL,PSQMNLX,PSODUTOT,PSOLEFT,PSOZMIN,PSODUPTT,PSODUDIF,PSODUMIS,PSODUREP,PSQ1,PSODUX,PSODUXX,PSODSMIN,PSOFRQZ,PSOQUTOT
- N PSOQLD,PSOQLDA,PSOQLDT,PSOQLDX
- ;PSODUTOT = TOTAL OF ALL DURATIONS
- ;PSODUPTT = TOTAL OF DISPENSE UNITS PER DOSE
- ;PSODUDIF = DIFF. OF DURATION VS DAYS SUPPLY
- ;PSOQUTOT=QTY
- ;PSODUMIS = # OF SEQUENCES MISSING A DURATION IF >1 CAN'T DEFAULT
- ;PSODUREP = SEQUENCE # THAT IS MISSING DURATION
- ;PSODSMIN = MINUTES OF DAYS SUPPLY
- S (PSODUTOT,PSODUDIF,PSODUMIS,PSODUREP,PSODSMIN,PSOQLDA,PSOQLDT,PSOQLDX)=0
- ;next lines, add complex dose days supply calculation with ANDs
- 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
- I $G(PSOQLDA)!($G(PSOQLDX)) G QEND
- S PSOQUTOT=+$G(PSOQX("QTY"))
- F PSQ1=1:1:QDOSE D Q:PSODUMIS>1
- .I '$G(PSOQX("DURATION",PSQ1)) S PSODUMIS=PSODUMIS+1,PSODUREP=PSQ1 Q
- G:PSODUMIS>1 QEND ; More than 1 sequence missing a duration
- 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)))
- ..S PSODUTOT=PSODUTOT+(PSQMNLX*(+$G(PSOQX("DURATION",PSQ))))
- .I '$G(PSOQX("DURATION",PSQ)) S PSOFRQZ=PSOFRQ Q
- .S PSQMINZ=PSQMIN/PSOFRQ
- .S PSODUPTT=$S($G(PSODUPTT):$G(PSODUPTT),1:0)+(PSQMINZ*+$G(PSOQX("DOSE ORDERED",PSQ)))
- I $G(PSQQUIT) G QEND
- I $G(PSOQUTOT)<0 G QEND
- I '$G(PSODUMIS),$G(PSODUPTT)>$G(PSOQUTOT) G QEND
- I '$G(PSODUMIS) S PSOZMIN=+$G(PSODUTOT)/1440 D ROUND G QEND
- I PSODUPTT'<PSOQUTOT!('$G(PSOFRQZ)) G QEND
- S PSODUPTT=PSOQUTOT-PSODUPTT S PSOLEFT=(PSODUPTT/+$G(PSOQX("DOSE ORDERED",PSODUREP)))*(+$G(PSOFRQZ))
- S PSODUTOT=PSODUTOT+PSOLEFT S PSOZMIN=PSODUTOT/1440 D ROUND
- G QEND
- QTS ;*282 Centralized Call
- D QTS^PSOSIG
- Q
- QEND ;
- K PSOFRQ
- Q
- ROUND ;
- Q:'$G(PSOZMIN)
- I PSOZMIN'["." S PSOQX("DAYS SUPPLY")=PSOZMIN G RXP
- S PSOQX("DAYS SUPPLY")=$P(PSOZMIN,".")+1
- RXP ;Compare against Rx Patient Status
- Q:'$G(PSOQX("PATIENT"))
- N PSO55,PSO553
- S PSO55=$P($G(^PS(55,PSOQX("PATIENT"),"PS")),"^") I 'PSO55 G CLOZ
- S PSO553=$P($G(^PS(53,PSO55,0)),"^",3) I 'PSO553 G CLOZ
- I PSO553<$G(PSOQX("DAYS SUPPLY")) S PSOQX("DAYS SUPPLY")=PSO553
- CLOZ ;check for clozapine
- N PSOCLPAT,PSOCLMAX
- Q:'$G(PSOQX("DRUG"))
- I $P($G(^PSDRUG(PSOQX("DRUG"),"CLOZ1")),"^")="PSOCLO1" D
- .S PSOCLPAT=$O(^YSCL(603.01,"C",PSOQX("PATIENT"),0)) Q:'PSOCLPAT
- .S PSOCLPAT=$P($G(^YSCL(603.01,PSOCLPAT,0)),"^",3)
- .;BEGIN - JCH - PSO*7.0*612 - Local override defaults to 4 Day Supply
- .I $P($G(^YSCL(603.01,PSOCLPAT,0)),"^")?1U6N S PSOCLPAT="Z"
- .S PSOCLMAX=$S(PSOCLPAT="M":28,PSOCLPAT="B":14,PSOCLPAT="W":7,PSOCLPAT="Z":4,1:0)
- .;END - JCH - PSO*7.0*612
- .I PSOCLMAX,PSOCLMAX<$G(PSOQX("DAYS SUPPLY")) S PSOQX("DAYS SUPPLY")=PSOCLMAX
- 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
- D QTYCP
- F PSOQLP=0:0 S PSOQLP=$O(PSOQAR("DURATION",PSOQLP)) Q:'PSOQLP D
- .S PSOQX("DURATION",PSOQLP)=$G(PSOQAR("DURATION",PSOQLP))
- K PSOCPRQT
- Q
- DSUP(PSOQX) ;Default Days Supply for CPRS, without QTY (just patient and drug)
- ;Should we add to accept # of refills?
- ;If no Drug, should we base on Orderable Item *441 MWA yes we should!!!
- N CS,DR,OI,MXDS,DRMXDS,OIISCLOZ S CS=0,MXDS=90,DR=$G(PSOQX("DRUG")),OIISCLOZ=0
- I DR S CS=$$CSDS(DR),MXDS=$$MXDAYSUP^PSSUTIL1(DR)
- ;441 added OI check for clozapine
- I 'DR S OI=$G(PSOQX("OI")) D:OI
- .N IDT,PAC S DR=0 F S DR=$O(^PSDRUG("ASP",OI,DR)) Q:'DR Q:OIISCLOZ D
- ..S:($P($G(^PSDRUG(DR,"CLOZ1")),"^")="PSOCLO1") OIISCLOZ=1
- ..S DRMXDS=$$MXDAYSUP^PSSUTIL1(DR) I DRMXDS>MXDS S MXDS=DRMXDS
- ..I CS Q
- ..S IDT=$P($G(^PSDRUG(DR,"I")),"^"),PAC=$P($G(^(2)),"^",3)
- ..I IDT,IDT<DT Q
- ..I PAC'["O" Q
- ..S CS=$$CSDS(DR)
- S PSOQX("DAYS SUPPLY")=$S(CS:30,1:90)
- I PSOQX("DAYS SUPPLY")>MXDS S PSOQX("DAYS SUPPLY")=MXDS
- Q:'$G(PSOQX("PATIENT"))
- N PSO55,PSO553
- S PSO55=$P($G(^PS(55,PSOQX("PATIENT"),"PS")),"^") I 'PSO55 G DSUPDG
- S PSO553=$P($G(^PS(53,PSO55,0)),"^",3) I 'PSO553 G DSUPDG
- I PSO553<$G(PSOQX("DAYS SUPPLY")) S PSOQX("DAYS SUPPLY")=PSO553
- DSUPDG ;
- N PSOCLPAT,PSOCLMAX,YSCLPSN
- Q:'DR
- I ($P($G(^PSDRUG(DR,"CLOZ1")),"^")="PSOCLO1")!(OIISCLOZ) D
- .;BEGIN: JCH - PSO*7*612
- .N PSOCZPTS,PSOERR,PSODFN
- .S PSODFN=+$G(PSOQX("PATIENT"))
- .S YSCLPSN=$$GET1^DIQ(55,PSODFN,53,"I") Q:YSCLPSN="" ; Get current Clozapine number associated with patient's Clozapine registration
- .D FIND^DIC(603.01,"","","QX",PSODFN,"","C","I $P($G(^(0)),""^"")=$G(YSCLPSN)","","PSOCZPTS","PSOERR")
- .S PSOCLPAT=$G(PSOCZPTS("DILIST",2,1))
- .;END: JCH - PSO*7*612
- .S PSOCLPAT=$P($G(^YSCL(603.01,PSOCLPAT,0)),"^",3)
- .;BEGIN: JCH - PSO*7*612 - default Days Supply to 4 when registered to Local Override clozapine #
- .S:YSCLPSN?1U6N PSOCLPAT="Z"
- .S PSOCLMAX=$S(PSOCLPAT="M":28,PSOCLPAT="B":14,PSOCLPAT="W":7,PSOCLPAT="Z":4,1:0)
- .;END: JCH - PSO*7*612
- .I PSOCLMAX,PSOCLMAX<$G(PSOQX("DAYS SUPPLY")) S PSOQX("DAYS SUPPLY")=PSOCLMAX
- Q
- MAX(PSOQX) ;
- G EN^PSOSIGMX
- Q
- ;
- CSDS(DR) ;
- Q:'DR 0
- I $P($G(^PSDRUG(DR,"ND")),"^",3) S CS=+$P($G(^PSNDF(50.68,$P(^("ND"),"^",3),7)),"^")
- 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)
- I CS=1!(CS=2)!(CS=3)!(CS=4)!(CS=5) Q 1
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSIGDS 8341 printed Jan 18, 2025@03:36 Page 2
- 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
- +2 ;External reference to PS(51 supported by DBIA 2224
- +3 ;External reference to PS(51.1 supported by DBIA 2225
- +4 ;External reference to PS(55 supported by DBIA 2228
- +5 ;External reference to PSDRUG( supported by DBIA 221
- +6 ;External reference to YSCL(603.01 supported by DBIA 2697
- +7 ;External reference to PSNDF(50.68 supported by DBIA 3735
- +8 ;External reference $$MXDAYSUP^PSSUTIL1 supported by DBIA 6229
- +9 ;
- EN(PSOSIGX) ;
- +1 NEW VARIABLE
- +2 QUIT
- SCH ;*282 Centralized Call
- +1 DO SCH^PSOSIG
- +2 QUIT
- QTY(PSOQX) ;
- +1 QUIT
- QTYOPS ;
- +1 NEW QDOSE
- QTYCP ;CPRS days supply call comes through here
- +1 NEW PSOZMIN,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(QDOSE)
- QUIT
- +7 if QDOSE>1
- GOTO COMP
- +8 if '$GET(PSOQX("DOSE ORDERED",1))
- QUIT
- +9 SET PSOLOWER=0
- +10 IF $GET(PSOQX("DURATION",1))
- Begin DoDot:1
- +11 SET PSOLOWX=$LENGTH(PSOQX("DURATION",1))
- +12 SET PSOLOWXL=$SELECT($EXTRACT(PSOQX("DURATION",1),PSOLOWX)="M":1,$EXTRACT(PSOQX("DURATION",1),PSOLOWX)="H":60,$EXTRACT(PSOQX("DURATION",1),PSOLOWX)="S":.01666,...
- ... $EXTRACT(PSOQX("DURATION",1),PSOLOWX)="W":10080,$EXTRACT(PSOQX("DURATION",1),PSOLOWX)="L":43200,1:1440)
- +13 SET PSOLOWER=PSOLOWXL*(+$GET(PSOQX("DURATION",1)))
- End DoDot:1
- +14 SET QTSH=$GET(PSOQX("SCHEDULE",1))
- DO QTS
- if PSQQUIT!('$GET(PSOFRQ))
- QUIT
- +15 ; PSQMIN=Minutes based in duration, or 0 if no duration
- SET PSQMIN=$SELECT($GET(PSOLOWER):$GET(PSOLOWER),1:0)
- +16 ;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
- +17 ;if no duration, just figure out using QTY # of days, then compare that against Rx patient status
- +18 SET PSOZMIN=0
- +19 SET PSOZMIN=PSOQX("QTY")/PSOQX("DOSE ORDERED",1)
- +20 SET PSOZMIN=PSOZMIN*PSOFRQ
- +21 IF $GET(PSOLOWER)
- SET PSOZMIN=$SELECT(PSOLOWER<PSOZMIN:PSOLOWER,1:PSOZMIN)
- +22 SET PSOZMIN=PSOZMIN/1440
- +23 DO ROUND
- GOTO QEND
- +24 QUIT
- COMP ;COMPLEX DOSE HERE
- +1 NEW PSQMNL,PSQMNLX,PSODUTOT,PSOLEFT,PSOZMIN,PSODUPTT,PSODUDIF,PSODUMIS,PSODUREP,PSQ1,PSODUX,PSODUXX,PSODSMIN,PSOFRQZ,PSOQUTOT
- +2 NEW PSOQLD,PSOQLDA,PSOQLDT,PSOQLDX
- +3 ;PSODUTOT = TOTAL OF ALL DURATIONS
- +4 ;PSODUPTT = TOTAL OF DISPENSE UNITS PER DOSE
- +5 ;PSODUDIF = DIFF. OF DURATION VS DAYS SUPPLY
- +6 ;PSOQUTOT=QTY
- +7 ;PSODUMIS = # OF SEQUENCES MISSING A DURATION IF >1 CAN'T DEFAULT
- +8 ;PSODUREP = SEQUENCE # THAT IS MISSING DURATION
- +9 ;PSODSMIN = MINUTES OF DAYS SUPPLY
- +10 SET (PSODUTOT,PSODUDIF,PSODUMIS,PSODUREP,PSODSMIN,PSOQLDA,PSOQLDT,PSOQLDX)=0
- +11 ;next lines, add complex dose days supply calculation with ANDs
- +12 FOR PSOQLD=1:1:QDOSE
- if $GET(PSOQX("CONJUNCTION",PSOQLD))["A"
- SET PSOQLDA=1
- if $GET(PSOQX("CONJUNCTION",PSOQLD))["T"
- SET PSOQLDT=1
- if $GET(PSOQX("CONJUNCTION",PSOQLD))["X"
- SET PSOQLDX=1
- +13 IF $GET(PSOQLDA)!($GET(PSOQLDX))
- GOTO QEND
- +14 SET PSOQUTOT=+$GET(PSOQX("QTY"))
- +15 FOR PSQ1=1:1:QDOSE
- Begin DoDot:1
- +16 IF '$GET(PSOQX("DURATION",PSQ1))
- SET PSODUMIS=PSODUMIS+1
- SET PSODUREP=PSQ1
- QUIT
- End DoDot:1
- if PSODUMIS>1
- QUIT
- +17 ; More than 1 sequence missing a duration
- if PSODUMIS>1
- GOTO QEND
- +18 FOR PSQ=1:1:QDOSE
- Begin DoDot:1
- +19 IF '$GET(PSOQX("DOSE ORDERED",PSQ))!($GET(PSOQX("SCHEDULE",PSQ))="")
- SET PSQQUIT=1
- QUIT
- +20 SET QTSH=$GET(PSOQX("SCHEDULE",PSQ))
- DO QTS
- if '$GET(PSOFRQ)
- SET PSQQUIT=1
- if $GET(PSQQUIT)
- QUIT
- +21 IF $GET(PSOQX("DURATION",PSQ))
- SET PSQMNL=$LENGTH(PSOQX("DURATION",PSQ))
- Begin DoDot:2
- +22 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)
- +23 SET PSQMIN=PSQMNLX*(+$GET(PSOQX("DURATION",PSQ)))
- +24 SET PSODUTOT=PSODUTOT+(PSQMNLX*(+$GET(PSOQX("DURATION",PSQ))))
- End DoDot:2
- +25 IF '$GET(PSOQX("DURATION",PSQ))
- SET PSOFRQZ=PSOFRQ
- QUIT
- +26 SET PSQMINZ=PSQMIN/PSOFRQ
- +27 SET PSODUPTT=$SELECT($GET(PSODUPTT):$GET(PSODUPTT),1:0)+(PSQMINZ*+$GET(PSOQX("DOSE ORDERED",PSQ)))
- End DoDot:1
- if $GET(PSQQUIT)
- QUIT
- +28 IF $GET(PSQQUIT)
- GOTO QEND
- +29 IF $GET(PSOQUTOT)<0
- GOTO QEND
- +30 IF '$GET(PSODUMIS)
- IF $GET(PSODUPTT)>$GET(PSOQUTOT)
- GOTO QEND
- +31 IF '$GET(PSODUMIS)
- SET PSOZMIN=+$GET(PSODUTOT)/1440
- DO ROUND
- GOTO QEND
- +32 IF PSODUPTT'<PSOQUTOT!('$GET(PSOFRQZ))
- GOTO QEND
- +33 SET PSODUPTT=PSOQUTOT-PSODUPTT
- SET PSOLEFT=(PSODUPTT/+$GET(PSOQX("DOSE ORDERED",PSODUREP)))*(+$GET(PSOFRQZ))
- +34 SET PSODUTOT=PSODUTOT+PSOLEFT
- SET PSOZMIN=PSODUTOT/1440
- DO ROUND
- +35 GOTO QEND
- QTS ;*282 Centralized Call
- +1 DO QTS^PSOSIG
- +2 QUIT
- QEND ;
- +1 KILL PSOFRQ
- +2 QUIT
- ROUND ;
- +1 if '$GET(PSOZMIN)
- QUIT
- +2 IF PSOZMIN'["."
- SET PSOQX("DAYS SUPPLY")=PSOZMIN
- GOTO RXP
- +3 SET PSOQX("DAYS SUPPLY")=$PIECE(PSOZMIN,".")+1
- RXP ;Compare against Rx Patient Status
- +1 if '$GET(PSOQX("PATIENT"))
- QUIT
- +2 NEW PSO55,PSO553
- +3 SET PSO55=$PIECE($GET(^PS(55,PSOQX("PATIENT"),"PS")),"^")
- IF 'PSO55
- GOTO CLOZ
- +4 SET PSO553=$PIECE($GET(^PS(53,PSO55,0)),"^",3)
- IF 'PSO553
- GOTO CLOZ
- +5 IF PSO553<$GET(PSOQX("DAYS SUPPLY"))
- SET PSOQX("DAYS SUPPLY")=PSO553
- CLOZ ;check for clozapine
- +1 NEW PSOCLPAT,PSOCLMAX
- +2 if '$GET(PSOQX("DRUG"))
- QUIT
- +3 IF $PIECE($GET(^PSDRUG(PSOQX("DRUG"),"CLOZ1")),"^")="PSOCLO1"
- Begin DoDot:1
- +4 SET PSOCLPAT=$ORDER(^YSCL(603.01,"C",PSOQX("PATIENT"),0))
- if 'PSOCLPAT
- QUIT
- +5 SET PSOCLPAT=$PIECE($GET(^YSCL(603.01,PSOCLPAT,0)),"^",3)
- +6 ;BEGIN - JCH - PSO*7.0*612 - Local override defaults to 4 Day Supply
- +7 IF $PIECE($GET(^YSCL(603.01,PSOCLPAT,0)),"^")?1U6N
- SET PSOCLPAT="Z"
- +8 SET PSOCLMAX=$SELECT(PSOCLPAT="M":28,PSOCLPAT="B":14,PSOCLPAT="W":7,PSOCLPAT="Z":4,1:0)
- +9 ;END - JCH - PSO*7.0*612
- +10 IF PSOCLMAX
- IF PSOCLMAX<$GET(PSOQX("DAYS SUPPLY"))
- SET PSOQX("DAYS SUPPLY")=PSOCLMAX
- End DoDot:1
- +11 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 DO QTYCP
- +6 FOR PSOQLP=0:0
- SET PSOQLP=$ORDER(PSOQAR("DURATION",PSOQLP))
- if 'PSOQLP
- QUIT
- Begin DoDot:1
- +7 SET PSOQX("DURATION",PSOQLP)=$GET(PSOQAR("DURATION",PSOQLP))
- End DoDot:1
- +8 KILL PSOCPRQT
- +9 QUIT
- DSUP(PSOQX) ;Default Days Supply for CPRS, without QTY (just patient and drug)
- +1 ;Should we add to accept # of refills?
- +2 ;If no Drug, should we base on Orderable Item *441 MWA yes we should!!!
- +3 NEW CS,DR,OI,MXDS,DRMXDS,OIISCLOZ
- SET CS=0
- SET MXDS=90
- SET DR=$GET(PSOQX("DRUG"))
- SET OIISCLOZ=0
- +4 IF DR
- SET CS=$$CSDS(DR)
- SET MXDS=$$MXDAYSUP^PSSUTIL1(DR)
- +5 ;441 added OI check for clozapine
- +6 IF 'DR
- SET OI=$GET(PSOQX("OI"))
- if OI
- Begin DoDot:1
- +7 NEW IDT,PAC
- SET DR=0
- FOR
- SET DR=$ORDER(^PSDRUG("ASP",OI,DR))
- if 'DR
- QUIT
- if OIISCLOZ
- QUIT
- Begin DoDot:2
- +8 if ($PIECE($GET(^PSDRUG(DR,"CLOZ1")),"^")="PSOCLO1")
- SET OIISCLOZ=1
- +9 SET DRMXDS=$$MXDAYSUP^PSSUTIL1(DR)
- IF DRMXDS>MXDS
- SET MXDS=DRMXDS
- +10 IF CS
- QUIT
- +11 SET IDT=$PIECE($GET(^PSDRUG(DR,"I")),"^")
- SET PAC=$PIECE($GET(^(2)),"^",3)
- +12 IF IDT
- IF IDT<DT
- QUIT
- +13 IF PAC'["O"
- QUIT
- +14 SET CS=$$CSDS(DR)
- End DoDot:2
- End DoDot:1
- +15 SET PSOQX("DAYS SUPPLY")=$SELECT(CS:30,1:90)
- +16 IF PSOQX("DAYS SUPPLY")>MXDS
- SET PSOQX("DAYS SUPPLY")=MXDS
- +17 if '$GET(PSOQX("PATIENT"))
- QUIT
- +18 NEW PSO55,PSO553
- +19 SET PSO55=$PIECE($GET(^PS(55,PSOQX("PATIENT"),"PS")),"^")
- IF 'PSO55
- GOTO DSUPDG
- +20 SET PSO553=$PIECE($GET(^PS(53,PSO55,0)),"^",3)
- IF 'PSO553
- GOTO DSUPDG
- +21 IF PSO553<$GET(PSOQX("DAYS SUPPLY"))
- SET PSOQX("DAYS SUPPLY")=PSO553
- DSUPDG ;
- +1 NEW PSOCLPAT,PSOCLMAX,YSCLPSN
- +2 if 'DR
- QUIT
- +3 IF ($PIECE($GET(^PSDRUG(DR,"CLOZ1")),"^")="PSOCLO1")!(OIISCLOZ)
- Begin DoDot:1
- +4 ;BEGIN: JCH - PSO*7*612
- +5 NEW PSOCZPTS,PSOERR,PSODFN
- +6 SET PSODFN=+$GET(PSOQX("PATIENT"))
- +7 ; Get current Clozapine number associated with patient's Clozapine registration
- SET YSCLPSN=$$GET1^DIQ(55,PSODFN,53,"I")
- if YSCLPSN=""
- QUIT
- +8 DO FIND^DIC(603.01,"","","QX",PSODFN,"","C","I $P($G(^(0)),""^"")=$G(YSCLPSN)","","PSOCZPTS","PSOERR")
- +9 SET PSOCLPAT=$GET(PSOCZPTS("DILIST",2,1))
- +10 ;END: JCH - PSO*7*612
- +11 SET PSOCLPAT=$PIECE($GET(^YSCL(603.01,PSOCLPAT,0)),"^",3)
- +12 ;BEGIN: JCH - PSO*7*612 - default Days Supply to 4 when registered to Local Override clozapine #
- +13 if YSCLPSN?1U6N
- SET PSOCLPAT="Z"
- +14 SET PSOCLMAX=$SELECT(PSOCLPAT="M":28,PSOCLPAT="B":14,PSOCLPAT="W":7,PSOCLPAT="Z":4,1:0)
- +15 ;END: JCH - PSO*7*612
- +16 IF PSOCLMAX
- IF PSOCLMAX<$GET(PSOQX("DAYS SUPPLY"))
- SET PSOQX("DAYS SUPPLY")=PSOCLMAX
- End DoDot:1
- +17 QUIT
- MAX(PSOQX) ;
- +1 GOTO EN^PSOSIGMX
- +2 QUIT
- +3 ;
- CSDS(DR) ;
- +1 if 'DR
- QUIT 0
- +2 IF $PIECE($GET(^PSDRUG(DR,"ND")),"^",3)
- SET CS=+$PIECE($GET(^PSNDF(50.68,$PIECE(^("ND"),"^",3),7)),"^")
- +3 IF '$TEST
- SET CS=$PIECE($GET(^PSDRUG(DR,0)),"^",3)
- SET CS=$SELECT(CS[1:1,CS[2:2,CS[3:3,CS[4:4,CS[5:5,1:0)
- +4 IF CS=1!(CS=2)!(CS=3)!(CS=4)!(CS=5)
- QUIT 1
- +5 QUIT 0