source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOMGRP1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 3.1 KB
Line 
1PSOMGRP1 ;BHAM ISC/JMB - DAILY MANAGEMENT PRESCRIPTION COUNTS REPORT ; 4/1/93
2 ;;7.0;OUTPATIENT PHARMACY;**14**;DEC 1997
3EN S (CNT,PG)=0 D:ANS="A" PRI D:ANS="S" DV W:ANS="S" @IOF Q
4ENQ S CNT=0 S PSOELSE=ANS I ANS="A" D PRI,PRI^PSOMGRP2,PRI^PSOMGRP3
5 I PSOELSE'="A" S PG=0 D DV S (CNT,PG)=0 D EN^PSOMGRP2 S (CNT,PG)=0 D EN^PSOMGRP3
6 K PSOELSE D ^PSOMGRP4 Q
7RPT W:CNT @IOF S PG=PG+1,CNT=CNT+1 U IO W !!?30,"O U T P A T I E N T P H A R M A C Y M A N A G E M E N T R E P O R T",!?56,"PRESCRIPTION COUNTS",?112,"PAGE ",PG
8 W !!?40,"FROM "_$E(SDT,4,5)_"-"_$E(SDT,6,7)_"-"_$E(SDT,2,3),?60,"TO "_$E(EDT,4,5)_"-"_$E(EDT,6,7)_"-"_$E(EDT,2,3)_" "_$S('PRT:"DIVISION: "_$P(^PS(59,DIV,0),"^"),1:"ALL DIVISIONS")
9 W !!?9 F K=1:1:14 W $J($P("^^^TOT^30^60^90^EQ^^TOT^TOT^MED^RX/^EQ FL/","^",K),8)
10 W !,"DATE",?9 F K=1:1:14 W $J($P("CAT A^CAT C^OTH^CAT^DAY^DAY^DAY^FLS^METH^RX^EQ FL^REQ^REQ^REQ","^",K),8)
11 W ! F K=1:1:121 W "="
12 Q
13PRI S T1="0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0",CNT=0,PG=0 F DIV=0:0 S DIV=$O(^PS(59,DIV)) Q:'DIV D DV
14 D TOT
15 Q
16DV S (BEG,PRT)=0 D RPT S S1(DIV)="0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0" F PDATE=SDT-1:0 S PDATE=$O(^PS(59.12,PDATE)) D:$Y+6>IOSL RPT D:'PDATE!(PDATE>EDT) SUB Q:'PDATE!(PDATE>EDT) D
17 .S DVMN=DIV_"^"_$E(PDATE,1,5) S:'BEG PRV=DIV_"^"_$E(PDATE,1,5),M1(DVMN)="0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0",BEG=1 I DVMN'=PRV D MON S PRV=DIV_"^"_$E(PDATE,1,5),M1(DVMN)="0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0"
18 .W !,$E(PDATE,4,5)_"-"_$E(PDATE,6,8)_"-"_$E(PDATE,2,3),?9
19 .D:$G(^PS(59.12,PDATE,1,DIV,0))'=DIV_"^0^0^0^0^0^0^0^^0^0^0^0^0^0^0^0" LN
20 I ANS="S" W !!!?17,"FINISHED PRINTING ON: " D NOW^%DTC S Y=% X ^DD("DD") W Y W:RUN="A"&(ANS="S") @IOF
21 Q
22LN F K=2,3,4,5,6,7,8,10,11,12,13,14,15,16 W $J(+$P($G(^PS(59.12,PDATE,1,DIV,0)),"^",K),8) D
23 .S $P(M1(DVMN),"^",K)=$P(M1(DVMN),"^",K)+$P($G(^PS(59.12,PDATE,1,DIV,0)),"^",K)
24 .S $P(S1(DIV),"^",K)=$P(S1(DIV),"^",K)+$P($G(^PS(59.12,PDATE,1,DIV,0)),"^",K) S:$D(T1) $P(T1,"^",K)=$P(T1,"^",K)+$P($G(^PS(59.12,PDATE,1,DIV,0)),"^",K)
25 Q
26MON ;PRINT MONTHLY TOTALS
27 W !?9 F K=1:1:14 W $J("-------",8)
28 W !,"MON TOTAL",?9 F K=2,3,4,5,6,7,8,10,11,12,13,14 W $J($P(M1(PRV),"^",K),8)
29 W $J($S($P(M1(PRV),"^",12)=0!($P(M1(PRV),"^",14)=0):0,1:$P(M1(PRV),"^",12)/$P(M1(PRV),"^",14)),8,2)
30 W $J($S($P(M1(PRV),"^",13)=0!($P(M1(PRV),"^",14)=0):0,1:$P(M1(PRV),"^",13)/$P(M1(PRV),"^",14)),8,2)
31 Q
32SUB ;PRINT SUB TOTALS
33 I 'PRT D MON W !?9 F K=1:1:14 W $J("=======",8)
34 W !,$S('PRT:"DIV TOTAL",1:$E($P(^PS(59,DIV,0),"^"),1,8)),?9 F K=2,3,4,5,6,7,8,10,11,12,13,14 W $J($P(S1(DIV),"^",K),8)
35 W $J($S($P(S1(DIV),"^",12)=0!($P(S1(DIV),"^",14)=0):0,1:$P(S1(DIV),"^",12)/$P(S1(DIV),"^",14)),8,2)
36 W $J($S($P(S1(DIV),"^",13)=0!($P(S1(DIV),"^",14)=0):0,1:$P(S1(DIV),"^",13)/$P(S1(DIV),"^",14)),8,2)
37 Q
38TOT ;PRINT GRAND TOTALS
39 S PRT=1 D RPT F DIV=0:0 S DIV=$O(^PS(59,DIV)) Q:'DIV D SUB
40 W !?9 F K=1:1:14 W $J("=======",8)
41 W !,"GR TOTAL",?9 F K=2,3,4,5,6,7,8,10,11,12,13,14 W $J($P(T1,"^",K),8)
42 W $J($S($P(T1,"^",12)=0!($P(T1,"^",14)=0):0,1:$P(T1,"^",12)/$P(T1,"^",14)),8,2)
43 W $J($S($P(T1,"^",13)=0!($P(T1,"^",14)=0):0,1:$P(T1,"^",13)/$P(T1,"^",14)),8,2)
44 W !!!?17,"FINISHED PRINTING ON: " D NOW^%DTC S Y=% X ^DD("DD") W Y W:RUN'="A" @IOF
45 Q
Note: See TracBrowser for help on using the repository browser.