PSOSIGMX ;BIR/RTR - Utility routine to calculate Max Refills for CPRS ;Aug 05, 2022@11:52:26
;;7.0;OUTPATIENT PHARMACY;**46,78,108,131,222,206,444,612,441**;DEC 1997;Build 208
;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 PS(50.7 supported by DBIA 2223
;
;PSOQX("PATIENT")=patient DFN
;PSOQX("DAYS SUPPLY")=Days Supply ->Optional ??
;PSOQX("DRUG")=File 50 ien ->Optional
;PSOQX("ITEM")=File 50.7 ien -> we may not use this
;PSOQX("DISCHARGE")=1 if the order is for a Discharge
;PSOQX("TITRATION")=1 if the order is for Titration
;
;PSOQX("MAX")=Returned max refills allowed
;
EN ;
S PSOQX("MAX")=11
N DFN,VAROOT,PSOWRF,PSOMXAUT,PSOMXAUX,PSOCDEA,PSOCSX,PSOMXRX,PSOMX1,PSODYX,PSODYX1,PSOMXPAT,PSOMXSTA,MXRFLS
S PSOMXAUT=0
S PSOMXAUX=+$P($G(^PS(55,+$G(PSOQX("PATIENT")),"PS")),"^")
I PSOMXAUX,$P($G(^PS(53,+$G(PSOMXAUX),0)),"^")["AUTH ABS" S VAROOT="PSOWRF",DFN=$G(PSOQX("PATIENT")) D IN5^VADPT I '$G(PSOWRF(5)) S PSOMXAUT=1
S PSOMXSTA=$S($G(PSOQX("DISCHARGE")):0,$G(PSOMXAUT):0,1:+$P($G(^PS(55,+$G(PSOQX("PATIENT")),"PS")),"^")) I PSOMXSTA S PSOMXRX=$P($G(^PS(53,PSOMXSTA,0)),"^",4)
I 'PSOMXSTA S PSOMXRX=11
K PSOCDEA S PSOCSX=0
S PSONODD=0 I '$G(PSOQX("DRUG")),$G(PSOQX("ITEM")) D S PSONODD=1
. N A,B,PSOCDEA,DEA,PSOAPP,PSOINA,%,%H,%I,X,PSOFIRST
. S DEA=99,(A,PSOFIRST)=""
. F S A=$O(^PS(50.7,"A50",PSOQX("ITEM"),A)) Q:'A D
.. S PSOCDEA=$P($G(^PSDRUG(A,0)),"^",3),PSOAPP=$P($G(^(2)),"^",3),PSOINA=$G(^("I"))
.. I PSOAPP'["O" Q
.. D NOW^%DTC I PSOINA]"",PSOINA'>% Q
.. I PSOFIRST="" S PSOFIRST=A
.. I PSOCDEA?1N.E,PSOCDEA<DEA S DEA=PSOCDEA,PSOQX("DRUG")=A
. I $G(PSOQX("DRUG"))="" S PSOQX("DRUG")=PSOFIRST
I $G(PSOQX("DRUG")) D
.S PSOCDEA=$P($G(^PSDRUG(PSOQX("DRUG"),0)),"^",3)
.I PSOCDEA["2"!(PSOCDEA["3")!(PSOCDEA["4")!(PSOCDEA["5") S PSOCSX=1
I $G(PSOQX("DRUG")),$G(PSOQX("TITRATION")),(PSOCDEA[3)!(PSOCDEA[4)!(PSOCDEA[5) S PSOQX("MAX")=0 Q ;P441
;
S PSOQX("MAX")=$$MAXNUMRF^PSOUTIL($G(PSOQX("DRUG")),$G(PSOQX("DAYS SUPPLY")),PSOMXAUX,.CLOZPAT)
;
I $P($G(^PSDRUG(+$G(PSOQX("DRUG")),"CLOZ1")),"^")="PSOCLO1" D Q
.; BEGIN - JCH: PSO*7*612
.S PSOMXPAT=$$GETREGYS^PSOCLUTL(+$G(PSOQX("PATIENT"))) I 'PSOMXPAT S PSOQX("MAX")=0 Q
.; END - JCH: PSO*7*612
.S PSOMXPAT=$P($G(^YSCL(603.01,PSOMXPAT,0)),"^",3)
.I $D(PSOQX("DAYS SUPPLY")) S PSOQX("MAX")=$S(PSOMXPAT="M"&($G(PSOQX("DAYS SUPPLY"))=7):3,PSOMXPAT="M"&($G(PSOQX("DAYS SUPPLY"))=14):1,PSOMXPAT="B"&($G(PSOQX("DAYS SUPPLY"))=7):1,1:0) Q
.S PSOQX("MAX")=$S(PSOMXPAT="M":3,PSOMXPAT="B":1,1:0)
I $G(PSOQX("DRUG")) I PSOCDEA["A"&(PSOCDEA'["B")!(PSOCDEA["F")!(PSOCDEA[1)!(PSOCDEA[2) S PSOQX("MAX")=0
I PSONODD S PSOQX("DRUG")=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSIGMX 2820 printed Oct 16, 2024@18:35:32 Page 2
PSOSIGMX ;BIR/RTR - Utility routine to calculate Max Refills for CPRS ;Aug 05, 2022@11:52:26
+1 ;;7.0;OUTPATIENT PHARMACY;**46,78,108,131,222,206,444,612,441**;DEC 1997;Build 208
+2 ;External reference to PS(55 supported by DBIA 2228
+3 ;External reference to PSDRUG( supported by DBIA 221
+4 ;External reference to YSCL(603.01 supported by DBIA 2697
+5 ;External reference to PS(50.7 supported by DBIA 2223
+6 ;
+7 ;PSOQX("PATIENT")=patient DFN
+8 ;PSOQX("DAYS SUPPLY")=Days Supply ->Optional ??
+9 ;PSOQX("DRUG")=File 50 ien ->Optional
+10 ;PSOQX("ITEM")=File 50.7 ien -> we may not use this
+11 ;PSOQX("DISCHARGE")=1 if the order is for a Discharge
+12 ;PSOQX("TITRATION")=1 if the order is for Titration
+13 ;
+14 ;PSOQX("MAX")=Returned max refills allowed
+15 ;
EN ;
+1 SET PSOQX("MAX")=11
+2 NEW DFN,VAROOT,PSOWRF,PSOMXAUT,PSOMXAUX,PSOCDEA,PSOCSX,PSOMXRX,PSOMX1,PSODYX,PSODYX1,PSOMXPAT,PSOMXSTA,MXRFLS
+3 SET PSOMXAUT=0
+4 SET PSOMXAUX=+$PIECE($GET(^PS(55,+$GET(PSOQX("PATIENT")),"PS")),"^")
+5 IF PSOMXAUX
IF $PIECE($GET(^PS(53,+$GET(PSOMXAUX),0)),"^")["AUTH ABS"
SET VAROOT="PSOWRF"
SET DFN=$GET(PSOQX("PATIENT"))
DO IN5^VADPT
IF '$GET(PSOWRF(5))
SET PSOMXAUT=1
+6 SET PSOMXSTA=$SELECT($GET(PSOQX("DISCHARGE")):0,$GET(PSOMXAUT):0,1:+$PIECE($GET(^PS(55,+$GET(PSOQX("PATIENT")),"PS")),"^"))
IF PSOMXSTA
SET PSOMXRX=$PIECE($GET(^PS(53,PSOMXSTA,0)),"^",4)
+7 IF 'PSOMXSTA
SET PSOMXRX=11
+8 KILL PSOCDEA
SET PSOCSX=0
+9 SET PSONODD=0
IF '$GET(PSOQX("DRUG"))
IF $GET(PSOQX("ITEM"))
Begin DoDot:1
+10 NEW A,B,PSOCDEA,DEA,PSOAPP,PSOINA,%,%H,%I,X,PSOFIRST
+11 SET DEA=99
SET (A,PSOFIRST)=""
+12 FOR
SET A=$ORDER(^PS(50.7,"A50",PSOQX("ITEM"),A))
if 'A
QUIT
Begin DoDot:2
+13 SET PSOCDEA=$PIECE($GET(^PSDRUG(A,0)),"^",3)
SET PSOAPP=$PIECE($GET(^(2)),"^",3)
SET PSOINA=$GET(^("I"))
+14 IF PSOAPP'["O"
QUIT
+15 DO NOW^%DTC
IF PSOINA]""
IF PSOINA'>%
QUIT
+16 IF PSOFIRST=""
SET PSOFIRST=A
+17 IF PSOCDEA?1N.E
IF PSOCDEA<DEA
SET DEA=PSOCDEA
SET PSOQX("DRUG")=A
End DoDot:2
+18 IF $GET(PSOQX("DRUG"))=""
SET PSOQX("DRUG")=PSOFIRST
End DoDot:1
SET PSONODD=1
+19 IF $GET(PSOQX("DRUG"))
Begin DoDot:1
+20 SET PSOCDEA=$PIECE($GET(^PSDRUG(PSOQX("DRUG"),0)),"^",3)
+21 IF PSOCDEA["2"!(PSOCDEA["3")!(PSOCDEA["4")!(PSOCDEA["5")
SET PSOCSX=1
End DoDot:1
+22 ;P441
IF $GET(PSOQX("DRUG"))
IF $GET(PSOQX("TITRATION"))
IF (PSOCDEA[3)!(PSOCDEA[4)!(PSOCDEA[5)
SET PSOQX("MAX")=0
QUIT
+23 ;
+24 SET PSOQX("MAX")=$$MAXNUMRF^PSOUTIL($GET(PSOQX("DRUG")),$GET(PSOQX("DAYS SUPPLY")),PSOMXAUX,.CLOZPAT)
+25 ;
+26 IF $PIECE($GET(^PSDRUG(+$GET(PSOQX("DRUG")),"CLOZ1")),"^")="PSOCLO1"
Begin DoDot:1
+27 ; BEGIN - JCH: PSO*7*612
+28 SET PSOMXPAT=$$GETREGYS^PSOCLUTL(+$GET(PSOQX("PATIENT")))
IF 'PSOMXPAT
SET PSOQX("MAX")=0
QUIT
+29 ; END - JCH: PSO*7*612
+30 SET PSOMXPAT=$PIECE($GET(^YSCL(603.01,PSOMXPAT,0)),"^",3)
+31 IF $DATA(PSOQX("DAYS SUPPLY"))
SET PSOQX("MAX")=$SELECT(PSOMXPAT="M"&($GET(PSOQX("DAYS SUPPLY"))=7):3,PSOMXPAT="M"&($GET(PSOQX("DAYS SUPPLY"))=14):1,PSOMXPAT="B"&($GET(PSOQX("DAYS SUPPLY"))=7):1,1:0)
QUIT
+32 SET PSOQX("MAX")=$SELECT(PSOMXPAT="M":3,PSOMXPAT="B":1,1:0)
End DoDot:1
QUIT
+33 IF $GET(PSOQX("DRUG"))
IF PSOCDEA["A"&(PSOCDEA'["B")!(PSOCDEA["F")!(PSOCDEA[1)!(PSOCDEA[2)
SET PSOQX("MAX")=0
+34 IF PSONODD
SET PSOQX("DRUG")=0
+35 QUIT
