source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOMGCOM.m@ 1119

Last change on this file since 1119 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1PSOMGCOM ;BHAM ISC/JMB,SAB - management compile/recompile routine ;9/13/05 8:54am
2 ;;7.0;OUTPATIENT PHARMACY;**20,28,174,221**;DEC 1997
3 ;External Ref. to ELIG^VADPT is supp. by DBIA# 10061
4 ;External Ref. to ^PSDRUG( is supp. by DBIA# 221
5COM1 D:DA=0 ORI D:DA>0 REF Q:'$D(^PSRX(REC,1,DA,0))&(DA>0) D STA
6 Q
7ORI 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)))
8 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
9 S COST=$P(RX0,"^",7)*$S(+$P(RX0,"^",17):$P(RX0,"^",17),1:+$P($G(^PSDRUG(+$P(RX0,"^",6),660)),"^",6))
10 D DAYS Q
11DAYS S TFIL=TFIL+1,TFCT=TFCT+COST,EQCOST(DV)=EQCOST(DV)+COST I DAYS<31 S QTY30(DV)=QTY30(DV)+1 Q
12 I DAYS>30&(DAYS<61) S QTY60(DV)=QTY60(DV)+1 Q
13 I DAYS>60&(DAYS<91) S QTY90(DV)=QTY90(DV)+1 Q
14 I DAYS>90&(DAYS<120) S QTY120(DV)=QTY120(DV)+1 Q
15 I DAYS>120&(DAYS<180) S QTY179(DV)=QTY179(DV)+1 Q
16 I DAYS=180 S QTY180(DV)=QTY180(DV)+1
17 Q
18REF 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
19 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
20 Q
21CLE F DV=0:0 S DV=$O(^PS(59,DV)) Q:'+DV D
22 .S METHAD(DV)=$S($D(^PS(59,DV,5)):$P(^PS(59,DV,5),"^",2),1:0)
23 .S (CATA(DV),CATC(DV),OTH(DV),CAT(DV),CATCOST(DV),QTY30(DV),QTY60(DV),QTY90(DV),QTY120(DV),QTY179(DV),QTY180(DV),EQFL(DV),EQCOST(DV))=0
24 .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
25 S (TFIL,TFTY,TFCT)=0 Q
26STA S:$P($G(^PSDRUG(+$P(^PSRX(REC,0),"^",6),0)),"^",3)["I" INV(DV)=INV(DV)+1
27 I $D(METHAD(DV)),DRUG=METHAD(DV) S METH(DV)=METH(DV)+1,METHCOST(DV)=METHCOST(DV)+COST
28 E K PCAT D CAT
29 I $P($G(^VA(200,+$G(PHYS),"PS")),"^",6)=4 S FEE(DV)=FEE(DV)+1,FCOST(DV)=FCOST(DV)+COST
30 E S STAFF(DV)=STAFF(DV)+1,STCOST(DV)=STCOST(DV)+COST
31 I '$D(^TMP($J,DV,DFN)) S ^TMP($J,DV,DFN)=$G(PCAT),PREQ(DV)=PREQ(DV)+1
32 Q
33CAT 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
34 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
35BUILD ;SET GLOBAL NODE
36 F DV=0:0 S DV=$O(^PS(59,DV)) Q:'+DV D BLD
37 Q
38BLD S EQFL(DV)=QTY30(DV)+(QTY60(DV)*2)+(QTY90(DV)*3)+(QTY120(DV)*4)+(QTY179(DV)*5)+(QTY180(DV)*6)
39 S CAT(DV)=CATA(DV)+CATC(DV)+OTH(DV)
40 S RXPREQ(DV)=$FN($S(CAT(DV)=0!(PREQ(DV)=0):0,1:CAT(DV)/PREQ(DV)),"",1)
41 S EQPREQ(DV)=$FN($S(EQFL(DV)=0!(PREQ(DV)=0):0,1:EQFL(DV)/PREQ(DV)),"",0)
42 S NODE1=EQFL(DV)_"^"_METH(DV)_"^"_(NEW(DV)+REF(DV))_"^"_(EQFL(DV)+METH(DV))_"^"_PREQ(DV)_"^"_RXPREQ(DV)_"^"_EQPREQ(DV)_"^"_INV(DV)
43 S ^PS(59.12,PDATE,1,DV,0)=DV_"^"_CATA(DV)_"^"_CATC(DV)_"^"_OTH(DV)_"^"_CAT(DV)_"^"_QTY30(DV)_"^"_QTY60(DV)_"^"_QTY90(DV)_"^^"_NODE1
44 ;
45 S COSTPST(DV)=$FN($S(STCOST(DV)=0!(STAFF(DV)=0):0,1:STCOST(DV)/STAFF(DV)),"",2)
46 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)
47 ;
48 S AVGFEE(DV)=$FN($S(FCOST(DV)=0!(FEE(DV)=0):0,1:FCOST(DV)/FEE(DV)),"",2)
49 S AVGST(DV)=$FN($S(STCOST(DV)=0!(STAFF(DV)=0):0,1:STCOST(DV)/STAFF(DV)),"",2)
50 S AVGCAT(DV)=$FN($S(CATCOST(DV)=0!(CAT(DV)=0):0,1:CATCOST(DV)/CAT(DV)),"",2)
51 S AVGEQFL(DV)=$FN($S(EQCOST(DV)=0!(EQFL(DV)=0):0,1:(EQCOST(DV)-METHCOST(DV)/EQFL(DV))),"",2)
52 S AVGMETH(DV)=$FN($S(METHCOST(DV)=0!(METH(DV)=0):0,1:METHCOST(DV)/METH(DV)),"",2)
53 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"
54 Q
Note: See TracBrowser for help on using the repository browser.