- PSOMGCOM ;BHAM ISC/JMB,SAB - management compile/recompile routine ;9/13/05 8:54am
- ;;7.0;OUTPATIENT PHARMACY;**20,28,174,221,444**;DEC 1997;Build 34
- ;External Ref. to ELIG^VADPT is supp. by DBIA# 10061
- ;External Ref. to ^PSDRUG( is supp. by DBIA# 221
- COM1 D:DA=0 ORI D:DA>0 REF Q:'$D(^PSRX(REC,1,DA,0))&(DA>0) D STA
- Q
- ORI Q:'$D(^PSRX(REC,0)) S RX0=^PSRX(REC,0),DV=$S($P($G(^PSRX(REC,2)),"^",9):$P(^PSRX(REC,2),"^",9),1:$O(^PS(59,0)))
- S NEW(DV)=NEW(DV)+1 S:$P(RX0,"^",11)="W" WIND(DV)=WIND(DV)+1 S:$P(RX0,"^",11)="M" MAIL(DV)=MAIL(DV)+1 S DATE=$P(^PSRX(REC,0),"^",2)-.01
- S COST=$P(RX0,"^",7)*$S(+$P(RX0,"^",17):$P(RX0,"^",17),1:+$P($G(^PSDRUG(+$P(RX0,"^",6),660)),"^",6))
- ;W !!!!,REC," ",$$GET1^DIQ(52,REC,.01)," ",$$GET1^DIQ(52,REC,8)
- D DAYS Q
- DAYS ;
- S TFIL=TFIL+1,TDAYS(DV)=$G(TDAYS(DV))+DAYS-(DAYS#30),TFCT=TFCT+COST,EQCOST(DV)=EQCOST(DV)+COST
- ; - Adding up Equivalent Fills (30-Day count) for each Division
- S EQFL(DV)=EQFL(DV)+$$MIN^XLFMTH((DAYS\30)+((DAYS#30)>0),12)
- ;
- ; - Adding up Specific Fills for each Division
- I DAYS<31 S QTY30(DV)=QTY30(DV)+1 Q
- I DAYS>30&(DAYS<61) S QTY60(DV)=QTY60(DV)+1 Q
- I DAYS>60&(DAYS<91) S QTY90(DV)=QTY90(DV)+1 Q
- I DAYS>90 S QTYOVR90(DV)=QTYOVR90(DV)+1 Q
- Q
- ;
- REF Q:'$D(^PSRX(REC,1,DA,0)) S RXF=^PSRX(REC,1,DA,0),DV=$S($P(RXF,"^",9):$P(RXF,"^",9),1:$O(^PS(59,0))),REF(DV)=REF(DV)+1 S:$P(RXF,"^",2)="W" WIND(DV)=WIND(DV)+1 S:$P(RXF,"^",2)="M" MAIL(DV)=MAIL(DV)+1 S DATE=$P(^PSRX(REC,1,DA,0),"^")-.01
- S COST=$P(RXF,"^",4)*$S($P(RXF,"^",11):$P(RXF,"^",11),1:+$P($G(^PSDRUG(+$P(^PSRX(REC,0),"^",6),660)),"^",6)) D DAYS
- Q
- CLE F DV=0:0 S DV=$O(^PS(59,DV)) Q:'+DV D
- .S METHAD(DV)=$S($D(^PS(59,DV,5)):$P(^PS(59,DV,5),"^",2),1:0)
- .S (CATA(DV),CATC(DV),OTH(DV),CAT(DV),CATCOST(DV),QTY30(DV),QTY60(DV),QTY90(DV),QTYOVR90(DV),TDAYS(DV),EQFL(DV),EQCOST(DV))=0
- .S (METH(DV),METHCOST(DV),PCPP(DV),PP(DV),PPCOST(DV),PREQ(DV),FEE(DV),FCOST(DV),STAFF(DV),STCOST(DV),NEW(DV),REF(DV),WIND(DV),MAIL(DV),INV(DV))=0
- S (TFIL,TFTY,TFCT)=0 Q
- STA S:$P($G(^PSDRUG(+$P(^PSRX(REC,0),"^",6),0)),"^",3)["I" INV(DV)=INV(DV)+1
- I $D(METHAD(DV)),DRUG=METHAD(DV) S METH(DV)=METH(DV)+1,METHCOST(DV)=METHCOST(DV)+COST
- E K PCAT D CAT
- I $P($G(^VA(200,+$G(PHYS),"PS")),"^",6)=4 S FEE(DV)=FEE(DV)+1,FCOST(DV)=FCOST(DV)+COST
- E S STAFF(DV)=STAFF(DV)+1,STCOST(DV)=STCOST(DV)+COST
- I '$D(^TMP($J,DV,DFN)) S ^TMP($J,DV,DFN)=$G(PCAT),PREQ(DV)=PREQ(DV)+1
- Q
- CAT I '$D(^TMP($J,DV,DFN)) D ELIG^VADPT S PCAT=$P($G(VAEL(9)),"^"),CATCOST(DV)=CATCOST(DV)+COST S:PCAT="A" CATA(DV)=CATA(DV)+1 S:PCAT="C" CATC(DV)=CATC(DV)+1 S:PCAT'="A"&(PCAT'="C") OTH(DV)=OTH(DV)+1 Q
- S PCAT=$G(^TMP($J,DV,DFN)),CATCOST(DV)=CATCOST(DV)+COST S:PCAT="A" CATA(DV)=CATA(DV)+1 S:PCAT="C" CATC(DV)=CATC(DV)+1 S:PCAT'="A"&(PCAT'="C") OTH(DV)=OTH(DV)+1
- Q
- BUILD ;SET GLOBAL NODE
- F DV=0:0 S DV=$O(^PS(59,DV)) Q:'+DV D BLD
- Q
- BLD ;
- S CAT(DV)=CATA(DV)+CATC(DV)+OTH(DV)
- S RXPREQ(DV)=$FN($S(CAT(DV)=0!(PREQ(DV)=0):0,1:CAT(DV)/PREQ(DV)),"",1)
- S EQPREQ(DV)=$FN($S(EQFL(DV)=0!(PREQ(DV)=0):0,1:EQFL(DV)/PREQ(DV)),"",0)
- S NODE1=EQFL(DV)_"^"_METH(DV)_"^"_(NEW(DV)+REF(DV))_"^"_(EQFL(DV)+METH(DV))_"^"_PREQ(DV)_"^"_RXPREQ(DV)_"^"_EQPREQ(DV)_"^"_INV(DV)
- S ^PS(59.12,PDATE,1,DV,0)=DV_"^"_CATA(DV)_"^"_CATC(DV)_"^"_OTH(DV)_"^"_CAT(DV)_"^"_QTY30(DV)_"^"_QTY60(DV)_"^"_QTY90(DV)_"^"_QTYOVR90(DV)_"^"_NODE1
- ;
- S COSTPST(DV)=$FN($S(STCOST(DV)=0!(STAFF(DV)=0):0,1:STCOST(DV)/STAFF(DV)),"",2)
- S ^PS(59.12,PDATE,2,DV,0)=DV_"^^"_FEE(DV)_"^"_STAFF(DV)_"^"_(FEE(DV)+STAFF(DV))_"^"_NEW(DV)_"^"_REF(DV)_"^"_(NEW(DV)+REF(DV))_"^"_WIND(DV)_"^"_MAIL(DV)_"^"_(WIND(DV)+MAIL(DV))_"^^"_PP(DV)_"^"_PCPP(DV)
- ;
- S AVGFEE(DV)=$FN($S(FCOST(DV)=0!(FEE(DV)=0):0,1:FCOST(DV)/FEE(DV)),"",2)
- S AVGST(DV)=$FN($S(STCOST(DV)=0!(STAFF(DV)=0):0,1:STCOST(DV)/STAFF(DV)),"",2)
- S AVGCAT(DV)=$FN($S(CATCOST(DV)=0!(CAT(DV)=0):0,1:CATCOST(DV)/CAT(DV)),"",2)
- S AVGEQFL(DV)=$FN($S(EQCOST(DV)=0!(EQFL(DV)=0):0,1:(EQCOST(DV)-METHCOST(DV)/EQFL(DV))),"",2)
- S AVGMETH(DV)=$FN($S(METHCOST(DV)=0!(METH(DV)=0):0,1:METHCOST(DV)/METH(DV)),"",2)
- S ^PS(59.12,PDATE,3,DV,0)=DV_"^"_AVGST(DV)_"^"_AVGFEE(DV)_"^"_AVGCAT(DV)_"^"_AVGEQFL(DV)_"^"_AVGMETH(DV)_"^"_$FN((CATCOST(DV)+METHCOST(DV)),"",2)_"^"_$FN(METHCOST(DV),"",2)_"^0.00^0.00"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOMGCOM 4231 printed Feb 18, 2025@23:57:27 Page 2
- PSOMGCOM ;BHAM ISC/JMB,SAB - management compile/recompile routine ;9/13/05 8:54am
- +1 ;;7.0;OUTPATIENT PHARMACY;**20,28,174,221,444**;DEC 1997;Build 34
- +2 ;External Ref. to ELIG^VADPT is supp. by DBIA# 10061
- +3 ;External Ref. to ^PSDRUG( is supp. by DBIA# 221
- COM1 if DA=0
- DO ORI
- if DA>0
- DO REF
- if '$DATA(^PSRX(REC,1,DA,0))&(DA>0)
- QUIT
- DO STA
- +1 QUIT
- ORI if '$DATA(^PSRX(REC,0))
- QUIT
- SET RX0=^PSRX(REC,0)
- SET DV=$SELECT($PIECE($GET(^PSRX(REC,2)),"^",9):$PIECE(^PSRX(REC,2),"^",9),1:$ORDER(^PS(59,0)))
- +1 SET NEW(DV)=NEW(DV)+1
- if $PIECE(RX0,"^",11)="W"
- SET WIND(DV)=WIND(DV)+1
- if $PIECE(RX0,"^",11)="M"
- SET MAIL(DV)=MAIL(DV)+1
- SET DATE=$PIECE(^PSRX(REC,0),"^",2)-.01
- +2 SET COST=$PIECE(RX0,"^",7)*$SELECT(+$PIECE(RX0,"^",17):$PIECE(RX0,"^",17),1:+$PIECE($GET(^PSDRUG(+$PIECE(RX0,"^",6),660)),"^",6))
- +3 ;W !!!!,REC," ",$$GET1^DIQ(52,REC,.01)," ",$$GET1^DIQ(52,REC,8)
- +4 DO DAYS
- QUIT
- DAYS ;
- +1 SET TFIL=TFIL+1
- SET TDAYS(DV)=$GET(TDAYS(DV))+DAYS-(DAYS#30)
- SET TFCT=TFCT+COST
- SET EQCOST(DV)=EQCOST(DV)+COST
- +2 ; - Adding up Equivalent Fills (30-Day count) for each Division
- +3 SET EQFL(DV)=EQFL(DV)+$$MIN^XLFMTH((DAYS\30)+((DAYS#30)>0),12)
- +4 ;
- +5 ; - Adding up Specific Fills for each Division
- +6 IF DAYS<31
- SET QTY30(DV)=QTY30(DV)+1
- QUIT
- +7 IF DAYS>30&(DAYS<61)
- SET QTY60(DV)=QTY60(DV)+1
- QUIT
- +8 IF DAYS>60&(DAYS<91)
- SET QTY90(DV)=QTY90(DV)+1
- QUIT
- +9 IF DAYS>90
- SET QTYOVR90(DV)=QTYOVR90(DV)+1
- QUIT
- +10 QUIT
- +11 ;
- REF if '$DATA(^PSRX(REC,1,DA,0))
- QUIT
- SET RXF=^PSRX(REC,1,DA,0)
- SET DV=$SELECT($PIECE(RXF,"^",9):$PIECE(RXF,"^",9),1:$ORDER(^PS(59,0)))
- SET REF(DV)=REF(DV)+1
- if $PIECE(RXF,"^",2)="W"
- SET WIND(DV)=WIND(DV)+1
- if $PIECE(RXF,"^",2)="M"
- SET MAIL(DV)=MAIL(DV)+1
- SET DATE=$PIECE(^PSRX(REC,1,DA,0),"^")-.01
- +1 SET COST=$PIECE(RXF,"^",4)*$SELECT($PIECE(RXF,"^",11):$PIECE(RXF,"^",11),1:+$PIECE($GET(^PSDRUG(+$PIECE(^PSRX(REC,0),"^",6),660)),"^",6))
- DO DAYS
- +2 QUIT
- CLE FOR DV=0:0
- SET DV=$ORDER(^PS(59,DV))
- if '+DV
- QUIT
- Begin DoDot:1
- +1 SET METHAD(DV)=$SELECT($DATA(^PS(59,DV,5)):$PIECE(^PS(59,DV,5),"^",2),1:0)
- +2 SET (CATA(DV),CATC(DV),OTH(DV),CAT(DV),CATCOST(DV),QTY30(DV),QTY60(DV),QTY90(DV),QTYOVR90(DV),TDAYS(DV),EQFL(DV),EQCOST(DV))=0
- +3 SET (METH(DV),METHCOST(DV),PCPP(DV),PP(DV),PPCOST(DV),PREQ(DV),FEE(DV),FCOST(DV),STAFF(DV),STCOST(DV),NEW(DV),REF(DV),WIND(DV),MAIL(DV),INV(DV))=0
- End DoDot:1
- +4 SET (TFIL,TFTY,TFCT)=0
- QUIT
- STA if $PIECE($GET(^PSDRUG(+$PIECE(^PSRX(REC,0),"^",6),0)),"^",3)["I"
- SET INV(DV)=INV(DV)+1
- +1 IF $DATA(METHAD(DV))
- IF DRUG=METHAD(DV)
- SET METH(DV)=METH(DV)+1
- SET METHCOST(DV)=METHCOST(DV)+COST
- +2 IF '$TEST
- KILL PCAT
- DO CAT
- +3 IF $PIECE($GET(^VA(200,+$GET(PHYS),"PS")),"^",6)=4
- SET FEE(DV)=FEE(DV)+1
- SET FCOST(DV)=FCOST(DV)+COST
- +4 IF '$TEST
- SET STAFF(DV)=STAFF(DV)+1
- SET STCOST(DV)=STCOST(DV)+COST
- +5 IF '$DATA(^TMP($JOB,DV,DFN))
- SET ^TMP($JOB,DV,DFN)=$GET(PCAT)
- SET PREQ(DV)=PREQ(DV)+1
- +6 QUIT
- CAT IF '$DATA(^TMP($JOB,DV,DFN))
- DO ELIG^VADPT
- SET PCAT=$PIECE($GET(VAEL(9)),"^")
- SET CATCOST(DV)=CATCOST(DV)+COST
- if PCAT="A"
- SET CATA(DV)=CATA(DV)+1
- if PCAT="C"
- SET CATC(DV)=CATC(DV)+1
- if PCAT'="A"&(PCAT'="C")
- SET OTH(DV)=OTH(DV)+1
- QUIT
- +1 SET PCAT=$GET(^TMP($JOB,DV,DFN))
- SET CATCOST(DV)=CATCOST(DV)+COST
- if PCAT="A"
- SET CATA(DV)=CATA(DV)+1
- if PCAT="C"
- SET CATC(DV)=CATC(DV)+1
- if PCAT'="A"&(PCAT'="C")
- SET OTH(DV)=OTH(DV)+1
- +2 QUIT
- BUILD ;SET GLOBAL NODE
- +1 FOR DV=0:0
- SET DV=$ORDER(^PS(59,DV))
- if '+DV
- QUIT
- DO BLD
- +2 QUIT
- BLD ;
- +1 SET CAT(DV)=CATA(DV)+CATC(DV)+OTH(DV)
- +2 SET RXPREQ(DV)=$FNUMBER($SELECT(CAT(DV)=0!(PREQ(DV)=0):0,1:CAT(DV)/PREQ(DV)),"",1)
- +3 SET EQPREQ(DV)=$FNUMBER($SELECT(EQFL(DV)=0!(PREQ(DV)=0):0,1:EQFL(DV)/PREQ(DV)),"",0)
- +4 SET NODE1=EQFL(DV)_"^"_METH(DV)_"^"_(NEW(DV)+REF(DV))_"^"_(EQFL(DV)+METH(DV))_"^"_PREQ(DV)_"^"_RXPREQ(DV)_"^"_EQPREQ(DV)_"^"_INV(DV)
- +5 SET ^PS(59.12,PDATE,1,DV,0)=DV_"^"_CATA(DV)_"^"_CATC(DV)_"^"_OTH(DV)_"^"_CAT(DV)_"^"_QTY30(DV)_"^"_QTY60(DV)_"^"_QTY90(DV)_"^"_QTYOVR90(DV)_"^"_NODE1
- +6 ;
- +7 SET COSTPST(DV)=$FNUMBER($SELECT(STCOST(DV)=0!(STAFF(DV)=0):0,1:STCOST(DV)/STAFF(DV)),"",2)
- +8 SET ^PS(59.12,PDATE,2,DV,0)=DV_"^^"_FEE(DV)_"^"_STAFF(DV)_"^"_(FEE(DV)+STAFF(DV))_"^"_NEW(DV)_"^"_REF(DV)_"^"_(NEW(DV)+REF(DV))_"^"_WIND(DV)_"^"_MAIL(DV)_"^"_(WIND(DV)+MAIL(DV))_"^^"_PP(DV)_"^"_PCPP(DV)
- +9 ;
- +10 SET AVGFEE(DV)=$FNUMBER($SELECT(FCOST(DV)=0!(FEE(DV)=0):0,1:FCOST(DV)/FEE(DV)),"",2)
- +11 SET AVGST(DV)=$FNUMBER($SELECT(STCOST(DV)=0!(STAFF(DV)=0):0,1:STCOST(DV)/STAFF(DV)),"",2)
- +12 SET AVGCAT(DV)=$FNUMBER($SELECT(CATCOST(DV)=0!(CAT(DV)=0):0,1:CATCOST(DV)/CAT(DV)),"",2)
- +13 SET AVGEQFL(DV)=$FNUMBER($SELECT(EQCOST(DV)=0!(EQFL(DV)=0):0,1:(EQCOST(DV)-METHCOST(DV)/EQFL(DV))),"",2)
- +14 SET AVGMETH(DV)=$FNUMBER($SELECT(METHCOST(DV)=0!(METH(DV)=0):0,1:METHCOST(DV)/METH(DV)),"",2)
- +15 SET ^PS(59.12,PDATE,3,DV,0)=DV_"^"_AVGST(DV)_"^"_AVGFEE(DV)_"^"_AVGCAT(DV)_"^"_AVGEQFL(DV)_"^"_AVGMETH(DV)_"^"_$FNUMBER((CATCOST(DV)+METHCOST(DV)),"",2)_"^"_$FNUMBER(METHCOST(DV),"",2)_"^0.00^0.00"
- +16 QUIT