- PSOSIGMX ;BIR/RTR-Utility routine to calculate Max Refills for CPRS ;29-May-2012 15:15;PLS
- ;;7.0;OUTPATIENT PHARMACY;**46,78,108,131,1008,222,206,1015**;DEC 1997;Build 62
- ;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("MAX")=Returned max refills allowed
- ;
- ; Modified - IHS/CIA/PLS - 09/03/04 - Line EN+27
- ; IHS/MSC/PLS - 01/28/09 - Changes for max refills to 15
- ; - 03/20/12 - Change for refills to 15
- EN ;
- S PSOQX("MAX")=11
- S PSOQX("MAX")=15 ;IHS/MSC/PLS - 01/28/09
- N DFN,VAROOT,PSOWRF,PSOMXAUT,PSOMXAUX,PSOCDEA,PSOCSX,PSOMXRX,PSOMX1,PSODYX,PSODYX1,PSOMXPAT,PSOMXSTA
- 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
- I 'PSOMXSTA S PSOMXRX=15 ;IHS/MSC/PLS - 01/28/09
- 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 PSOCSX D
- .S PSOQX("MAX")=$S((PSOCDEA[1)!(PSOCDEA[2):0,1:5),PSOMX1=$S($G(PSOMXRX)>PSOQX("MAX"):PSOQX("MAX"),1:$G(PSOMXRX)),PSOQX("MAX")=$S(PSOMX1=5:PSOQX("MAX"),1:PSOMX1)
- .S PSOQX("MAX")=$S('PSOQX("MAX"):0,$G(PSOQX("DAYS SUPPLY"))=90:1,1:PSOQX("MAX")),PSODYX=$G(PSOQX("DAYS SUPPLY")),PSODYX1=$S(PSODYX<60:5,PSODYX'<60&(PSODYX'>89):2,PSODYX=90:1,1:0) S PSOQX("MAX")=$S(PSOQX("MAX")'>PSODYX1:PSOQX("MAX"),1:PSODYX1)
- I 'PSOCSX!('$G(PSOQX("DRUG"))) D
- .;S PSOQX("MAX")=11,PSOMX1=$S($G(PSOMXRX)>PSOQX("MAX"):PSOQX("MAX"),1:$G(PSOMXRX)),PSOQX("MAX")=$S(PSOMX1=11:PSOQX("MAX"),1:PSOMX1)
- .S PSOQX("MAX")=15,PSOMX1=$S($G(PSOMXRX)>PSOQX("MAX"):PSOQX("MAX"),1:$G(PSOMXRX)),PSOQX("MAX")=$S(PSOMX1=15:PSOQX("MAX"),1:PSOMX1) ;IHS/MSC/PLS - 01/28/09
- .; IHS/CIA/PLS - 09/03/04 - Adjust max days supply from VA (90) to IHS (365)
- .;S PSODYX=$G(PSOQX("DAYS SUPPLY")),PSODYX1=$S(PSODYX<60:11,PSODYX'<60&(PSODYX'>89):5,PSODYX=90:3,1:0) S PSOQX("MAX")=$S(PSOQX("MAX")'>PSODYX1:PSOQX("MAX"),1:PSODYX1)
- .;S PSODYX=$G(PSOQX("DAYS SUPPLY")),PSODYX1=$S(PSODYX<60:11,PSODYX<90:5,PSODYX=90:3,PSODYX<168:2,PSODYX<365:1,1:0) S PSOQX("MAX")=$S(PSOQX("MAX")'>PSODYX1:PSOQX("MAX"),1:PSODYX1)
- .S PSODYX=$G(PSOQX("DAYS SUPPLY")),PSODYX1=$S(PSODYX<60:15,PSODYX<90:5,PSODYX=90:3,PSODYX<168:2,PSODYX<365:1,1:0) S PSOQX("MAX")=$S(PSOQX("MAX")'>PSODYX1:PSOQX("MAX"),1:PSODYX1) ;p1014
- I $P($G(^PSDRUG(+$G(PSOQX("DRUG")),"CLOZ1")),"^")="PSOCLO1" D Q
- .S PSOMXPAT=$O(^YSCL(603.01,"C",+$G(PSOQX("PATIENT")),0)) I 'PSOMXPAT S PSOQX("MAX")=0 Q
- .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"))<8):3,PSOMXPAT="M"&($G(PSOQX("DAYS SUPPLY"))<15):1,PSOMXPAT="B"&($G(PSOQX("DAYS SUPPLY"))<8):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
- PSOSIGMX ;BIR/RTR-Utility routine to calculate Max Refills for CPRS ;29-May-2012 15:15;PLS
- +1 ;;7.0;OUTPATIENT PHARMACY;**46,78,108,131,1008,222,206,1015**;DEC 1997;Build 62
- +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 ;
- +13 ;PSOQX("MAX")=Returned max refills allowed
- +14 ;
- +15 ; Modified - IHS/CIA/PLS - 09/03/04 - Line EN+27
- +16 ; IHS/MSC/PLS - 01/28/09 - Changes for max refills to 15
- +17 ; - 03/20/12 - Change for refills to 15
- EN ;
- +1 SET PSOQX("MAX")=11
- +2 ;IHS/MSC/PLS - 01/28/09
- SET PSOQX("MAX")=15
- +3 NEW DFN,VAROOT,PSOWRF,PSOMXAUT,PSOMXAUX,PSOCDEA,PSOCSX,PSOMXRX,PSOMX1,PSODYX,PSODYX1,PSOMXPAT,PSOMXSTA
- +4 SET PSOMXAUT=0
- +5 SET PSOMXAUX=+$PIECE($GET(^PS(55,+$GET(PSOQX("PATIENT")),"PS")),"^")
- +6 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
- +7 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)
- +8 ;I 'PSOMXSTA S PSOMXRX=11
- +9 ;IHS/MSC/PLS - 01/28/09
- IF 'PSOMXSTA
- SET PSOMXRX=15
- +10 KILL PSOCDEA
- SET PSOCSX=0
- +11 SET PSONODD=0
- IF '$GET(PSOQX("DRUG"))
- IF $GET(PSOQX("ITEM"))
- Begin DoDot:1
- +12 NEW A,B,PSOCDEA,DEA,PSOAPP,PSOINA,%,%H,%I,X,PSOFIRST
- +13 SET DEA=99
- SET (A,PSOFIRST)=""
- +14 FOR
- SET A=$ORDER(^PS(50.7,"A50",PSOQX("ITEM"),A))
- IF 'A
- QUIT
- Begin DoDot:2
- +15 SET PSOCDEA=$PIECE($GET(^PSDRUG(A,0)),"^",3)
- SET PSOAPP=$PIECE($GET(^(2)),"^",3)
- SET PSOINA=$GET(^("I"))
- +16 IF PSOAPP'["O"
- QUIT
- +17 DO NOW^%DTC
- IF PSOINA]""
- IF PSOINA'>%
- QUIT
- +18 IF PSOFIRST=""
- SET PSOFIRST=A
- +19 IF PSOCDEA?1N.E
- IF PSOCDEA<DEA
- SET DEA=PSOCDEA
- SET PSOQX("DRUG")=A
- End DoDot:2
- +20 IF $GET(PSOQX("DRUG"))=""
- SET PSOQX("DRUG")=PSOFIRST
- End DoDot:1
- SET PSONODD=1
- +21 IF $GET(PSOQX("DRUG"))
- Begin DoDot:1
- +22 SET PSOCDEA=$PIECE($GET(^PSDRUG(PSOQX("DRUG"),0)),"^",3)
- +23 IF PSOCDEA["2"!(PSOCDEA["3")!(PSOCDEA["4")!(PSOCDEA["5")
- SET PSOCSX=1
- End DoDot:1
- +24 IF PSOCSX
- Begin DoDot:1
- +25 SET PSOQX("MAX")=$SELECT((PSOCDEA[1)!(PSOCDEA[2):0,1:5)
- SET PSOMX1=$SELECT($GET(PSOMXRX)>PSOQX("MAX"):PSOQX("MAX"),1:$GET(PSOMXRX))
- SET PSOQX("MAX")=$SELECT(PSOMX1=5:PSOQX("MAX"),1:PSOMX1)
- +26 SET PSOQX("MAX")=$SELECT('PSOQX("MAX"):0,$GET(PSOQX("DAYS SUPPLY"))=90:1,1:PSOQX("MAX"))
- SET PSODYX=$GET(PSOQX("DAYS SUPPLY"))
- SET PSODYX1=$SELECT(PSODYX<60:5,PSODYX'<60&(PSODYX'>89):2,PSODYX=90:1,1:0)
- SET PSOQX("MAX")=$SELECT(PSOQX("MAX")'>PSODYX1:PSOQX("MAX"),1:PSODYX1)
- End DoDot:1
- +27 IF 'PSOCSX!('$GET(PSOQX("DRUG")))
- Begin DoDot:1
- +28 ;S PSOQX("MAX")=11,PSOMX1=$S($G(PSOMXRX)>PSOQX("MAX"):PSOQX("MAX"),1:$G(PSOMXRX)),PSOQX("MAX")=$S(PSOMX1=11:PSOQX("MAX"),1:PSOMX1)
- +29 ;IHS/MSC/PLS - 01/28/09
- SET PSOQX("MAX")=15
- SET PSOMX1=$SELECT($GET(PSOMXRX)>PSOQX("MAX"):PSOQX("MAX"),1:$GET(PSOMXRX))
- SET PSOQX("MAX")=$SELECT(PSOMX1=15:PSOQX("MAX"),1:PSOMX1)
- +30 ; IHS/CIA/PLS - 09/03/04 - Adjust max days supply from VA (90) to IHS (365)
- +31 ;S PSODYX=$G(PSOQX("DAYS SUPPLY")),PSODYX1=$S(PSODYX<60:11,PSODYX'<60&(PSODYX'>89):5,PSODYX=90:3,1:0) S PSOQX("MAX")=$S(PSOQX("MAX")'>PSODYX1:PSOQX("MAX"),1:PSODYX1)
- +32 ;S PSODYX=$G(PSOQX("DAYS SUPPLY")),PSODYX1=$S(PSODYX<60:11,PSODYX<90:5,PSODYX=90:3,PSODYX<168:2,PSODYX<365:1,1:0) S PSOQX("MAX")=$S(PSOQX("MAX")'>PSODYX1:PSOQX("MAX"),1:PSODYX1)
- +33 ;p1014
- SET PSODYX=$GET(PSOQX("DAYS SUPPLY"))
- SET PSODYX1=$SELECT(PSODYX<60:15,PSODYX<90:5,PSODYX=90:3,PSODYX<168:2,PSODYX<365:1,1:0)
- SET PSOQX("MAX")=$SELECT(PSOQX("MAX")'>PSODYX1:PSOQX("MAX"),1:PSODYX1)
- End DoDot:1
- +34 IF $PIECE($GET(^PSDRUG(+$GET(PSOQX("DRUG")),"CLOZ1")),"^")="PSOCLO1"
- Begin DoDot:1
- +35 SET PSOMXPAT=$ORDER(^YSCL(603.01,"C",+$GET(PSOQX("PATIENT")),0))
- IF 'PSOMXPAT
- SET PSOQX("MAX")=0
- QUIT
- +36 SET PSOMXPAT=$PIECE($GET(^YSCL(603.01,PSOMXPAT,0)),"^",3)
- +37 IF $DATA(PSOQX("DAYS SUPPLY"))
- SET PSOQX("MAX")=$SELECT(PSOMXPAT="M"&($GET(PSOQX("DAYS SUPPLY"))<8):3,PSOMXPAT="M"&($GET(PSOQX("DAYS SUPPLY"))<15):1,PSOMXPAT="B"&($GET(PSOQX("DAYS SUPPLY"))<8):1,1:0)
- QUIT
- +38 SET PSOQX("MAX")=$SELECT(PSOMXPAT="M":3,PSOMXPAT="B":1,1:0)
- End DoDot:1
- QUIT
- +39 IF $GET(PSOQX("DRUG"))
- IF PSOCDEA["A"&(PSOCDEA'["B")!(PSOCDEA["F")!(PSOCDEA[1)!(PSOCDEA[2)
- SET PSOQX("MAX")=0
- +40 IF PSONODD
- SET PSOQX("DRUG")=0
- +41 QUIT
