source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMTSR.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.4 KB
RevLine 
[613]1DGPMTSR ;ALB/LM - TREATING SPECIALTY REPORT PRINT ; 3/12/93
2 ;;5.3;Registration;**34,134**;Aug 13, 1993
3 ;
4A ; This will output ^TMP totals by treating specialty ; by service ; by division ; and finally by grand total
5 ;
6START ;
7 K ^TMP("TSR",$J),^TMP("TSRS",$J),^TMP("TSRD",$J),^TMP("TSRG",$J) ; cleans out temp global.
8 I '$D(^DG(40.8,"ATS")) G END
9 I TSRI>RD Q ; If report date is not greater than TSR Initialization date quit
10 ;
11 S PAGE=0
12 S D=0 F D1=0:0 S D=$O(^DG(40.8,"ATS",D)) Q:'D S ORDER=0 F O1=0:0 S ORDER=$O(^DG(40.8,"ATS",D,ORDER)) Q:ORDER="" F I=0:0 S I=$O(^DG(40.8,"ATS",D,ORDER,I)) Q:'I I ORDER>0 D START^DGPMTSR1,START^DGPMTSR2
13 ;
14 D HEAD I $D(END) Q
15 D PRINT
16 D KILL
17 ;
18END Q
19 ;
20HEAD I PAGE,$E(IOST,1,2)="C-" W !,"Press RETURN to continue or '^' to exit: " R X:DTIME S:X='$T!(X="^") END=1 Q:$D(END)
21 W:'($E(IOST,1,2)'="C-"&'$D(PAGE)) @IOF
22 S PAGE=PAGE+1
23 W !?94,"Date/Time Printed: ",DGNOW
24 W !?RM-26\2,"TREATING SPECIALTY REPORT"
25 W ?(IOM-10),"PAGE ",$J(PAGE,3)
26 S X=$$NAME^VASITE(RD)
27 I X']"" D
28 .S X="VA MEDICAL CENTER"
29 .S DGPM("GL")=$S($D(^DG(43,1,"GL")):^("GL"),1:"")
30 .S:$D(^DG(40.8,+$P(DGPM("GL"),"^",3),0)) X=X_", "_$P(^(0),"^")
31 W !?RM-$L(X)\2,X
32 S X=RD
33 D DW^%DTC
34 S X1=X,X="PERIOD ENDING MIDNIGHT "_X1_", "
35 S Y=RD X ^DD("DD") S X=X_Y
36 W !?RM-$L(X)\2,X,!
37 S X="T O T A L S B Y T R E A T I N G S P E C I A L T Y"
38 ;
39 W ! W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
40 W !?0,"|",?(RM-$L(X)\2),X,?130,"|"
41 W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
42 ;
43HEAD2 W !?0,"|","DIVISION",?44,"PREVIOUS",?74,"CURRENT",?109,"AVERAGE",?118,"CUMULATIVE",?130,"|"
44 W !?0,"|",?2,"SERVICE",?44,"PATIENTS",?74,"PATIENT",?109,"DAILY",?118,"PATIENT",?130,"|"
45 W !?0,"|",?3,"FACILITY TREATING SPECIALTY",?44,"REMAINING",?57,"GAINS",?65,"LOSSES",?74,"REMAINING",?86,"PASS",?93,"AA",?98,"UA",?103,"ASIH",?109,"CENSUS",?118,"DAYS OF CARE",?130,"|"
46 W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
47 Q
48 ;
49PRINT ; Output
50 S TAB="3^44^57^65^74^86^93^98^103^109^118"
51 S JUS="1^5^3^4^5^3^2^2^3^6^7"
52 ;
53 F D=0:0 S D=$O(^TMP("TSR",$J,D)) Q:'D!$D(END) S DIVISION=D W !?1,$P(^TMP("TSRD",$J,D)," TOTALS") D S Q:$D(END) D TSRD Q:$D(END)
54 I $D(END) Q
55 D TSRG
56PEND Q ; print end
57 ;
58S S S="" F S1=0:0 S S=$O(^TMP("TSR",$J,D,S)) Q:S="" S SERVICE=S W !?2,$P(^TMP("TSRS",$J,D,S)," TOTALS") D ORDER Q:$D(END) D TSRS Q:$D(END)
59 Q
60 ;
61ORDER S ORDER=0 F ORDER1=0:0 S ORDER=$O(^TMP("TSR",$J,D,S,ORDER)) Q:'ORDER D TS Q:$D(END)
62 Q
63TS F TS=0:0 S TS=$O(^TMP("TSR",$J,D,S,ORDER,TS)) Q:'TS D TSR Q:$D(END)
64 Q
65 ;
66TSR ; print treating specialty total
67 I $Y+5>IOSL D HEAD Q:$D(END)
68 W !
69 F I=1:1:11 W ?+$P(TAB,"^",I),$J($P(^TMP("TSR",$J,D,S,ORDER,TS),"^",I),$P(JUS,"^",I))
70 Q
71 ;
72TSRS ; print service total
73 I $Y+7>IOSL D HEAD Q:$D(END)
74 W !
75 F L=1:1:(IOM-3) W "-"
76 W !
77 F I=1:1:11 W ?+$P(TAB,"^",I),$J($P(^TMP("TSRS",$J,D,SERVICE),"^",I),$P(JUS,"^",I))
78 W !
79 F L=1:1:(IOM-3) W "-"
80 Q
81 ;
82TSRD ; print division total
83 I $Y+6>IOSL D HEAD Q:$D(END)
84 W !
85 F I=1:1:11 W ?+$P(TAB,"^",I),$J($P(^TMP("TSRD",$J,DIVISION),"^",I),$P(JUS,"^",I))
86 W !
87 F L=1:1:(IOM-3) W "-"
88 Q
89 ;
90TSRG ; print grand total
91 I $Y+6>IOSL D HEAD Q:$D(END)
92 W !
93 F I=1:1:11 W ?+$P(TAB,"^",I),$J($P(^TMP("TSRG",$J),"^",I),$P(JUS,"^",I))
94 W !
95 F L=1:1:(IOM-3) W "-"
96 Q
97 ;
98KILL ; Kills Variables
99 K ^TMP("TSR",$J),^TMP("TSRS",$J),^TMP("TSRD",$J),^TMP("TSRG",$J)
100 K ADC,BD,CN,D,D,D1,DIVISION,DGPM("GL"),FY("D"),I,JUS,L,ORDER,ORDER1,O1,PD,RD,RM,S,SERVICE,S,S1,T,TAB,TS,UL,X,X,X1,X2,Y,TSR,DGNOW,END,PAGE,SV,TSRI
101 Q
Note: See TracBrowser for help on using the repository browser.