source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMTSR2.m@ 636

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1DGPMTSR2 ;ALB/LM - TREATING SPECIALTY REPORT SET ; 3/1/93
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4A ; This will set ^TMP("TSR") = TREATING SPECIALTY TOTALS
5 ; ^TMP("TSRS") = SERVICE TOTALS
6 ; ^TMP("TSRD") = DIVISION TOTALS
7 ; ^TMP("TSRG") = GRAND TOTAL
8 Q
9 ;
10START ; Pats Remaining (Previous Date)
11 S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",2)=+$P(CN1,"^",2)
12 S $P(^TMP("TSRS",$J,D,S),"^",2)=$P(^TMP("TSRS",$J,D,S),"^",2)+$P(CN1,"^",2)
13 S $P(^TMP("TSRD",$J,D),"^",2)=$P(^TMP("TSRD",$J,D),"^",2)+$P(CN1,"^",2)
14 S $P(^TMP("TSRG",$J),"^",2)=$P(^TMP("TSRG",$J),"^",2)+$P(CN1,"^",2)
15 ;
16GAINS ; Gains Total Cum (new) - Gains Total Cum (previous)
17 S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",3)=$P(CN,"^",28)-$P(CN1,"^",28)
18 S $P(^TMP("TSRS",$J,D,S),"^",3)=$P(^TMP("TSRS",$J,D,S),"^",3)+$P(CN,"^",28)-$P(CN1,"^",28)
19 S $P(^TMP("TSRD",$J,D),"^",3)=$P(^TMP("TSRD",$J,D),"^",3)+$P(CN,"^",28)-$P(CN1,"^",28)
20 S $P(^TMP("TSRG",$J),"^",3)=$P(^TMP("TSRG",$J),"^",3)+$P(CN,"^",28)-$P(CN1,"^",28)
21 ;
22LOSSES ; losses (new) - losses (previous)
23 S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",4)=$P(CN,"^",24)-$P(CN1,"^",24)
24 S $P(^TMP("TSRS",$J,D,S),"^",4)=$P(^TMP("TSRS",$J,D,S),"^",4)+$P(CN,"^",24)-$P(CN1,"^",24)
25 S $P(^TMP("TSRD",$J,D),"^",4)=$P(^TMP("TSRD",$J,D),"^",4)+$P(CN,"^",24)-$P(CN1,"^",24)
26 S $P(^TMP("TSRG",$J),"^",4)=$P(^TMP("TSRG",$J),"^",4)+$P(CN,"^",24)-$P(CN1,"^",24)
27 ;
28CURRENT ; Patients Remaining
29 S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",5)=+$P(CN,"^",2)
30 S $P(^TMP("TSRS",$J,D,S),"^",5)=$P(^TMP("TSRS",$J,D,S),"^",5)+$P(CN,"^",2)
31 S $P(^TMP("TSRD",$J,D),"^",5)=$P(^TMP("TSRD",$J,D),"^",5)+$P(CN,"^",2)
32 S $P(^TMP("TSRG",$J),"^",5)=$P(^TMP("TSRG",$J),"^",5)+$P(CN,"^",2)
33 ;
34PASS S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",6)=+$P(CN(1),"^",5)
35 S $P(^TMP("TSRS",$J,D,S),"^",6)=$P(^TMP("TSRS",$J,D,S),"^",6)+$P(CN(1),"^",5)
36 S $P(^TMP("TSRD",$J,D),"^",6)=$P(^TMP("TSRD",$J,D),"^",6)+$P(CN(1),"^",5)
37 S $P(^TMP("TSRG",$J),"^",6)=$P(^TMP("TSRG",$J),"^",6)+$P(CN(1),"^",5)
38 ;
39AA S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",7)=+$P(CN(1),"^",6)
40 S $P(^TMP("TSRS",$J,D,S),"^",7)=$P(^TMP("TSRS",$J,D,S),"^",7)+$P(CN(1),"^",6)
41 S $P(^TMP("TSRD",$J,D),"^",7)=$P(^TMP("TSRD",$J,D),"^",7)+$P(CN(1),"^",6)
42 S $P(^TMP("TSRG",$J),"^",7)=$P(^TMP("TSRG",$J),"^",7)+$P(CN(1),"^",6)
43 ;
44UA S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",8)=+$P(CN(1),"^",7)
45 S $P(^TMP("TSRS",$J,D,S),"^",8)=$P(^TMP("TSRS",$J,D,S),"^",8)+$P(CN(1),"^",7)
46 S $P(^TMP("TSRD",$J,D),"^",8)=$P(^TMP("TSRD",$J,D),"^",8)+$P(CN(1),"^",7)
47 S $P(^TMP("TSRG",$J),"^",8)=$P(^TMP("TSRG",$J),"^",8)+$P(CN(1),"^",7)
48 ;
49ASIH S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",9)=+$P(CN(1),"^",8)
50 S $P(^TMP("TSRS",$J,D,S),"^",9)=$P(^TMP("TSRS",$J,D,S),"^",9)+$P(CN(1),"^",8)
51 S $P(^TMP("TSRD",$J,D),"^",9)=$P(^TMP("TSRD",$J,D),"^",9)+$P(CN(1),"^",8)
52 S $P(^TMP("TSRG",$J),"^",9)=$P(^TMP("TSRG",$J),"^",9)+$P(CN(1),"^",8)
53 ;
54ADC S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",10)=ADC("P")
55 S $P(^TMP("TSRS",$J,D,S),"^",10)=ADC("S")
56 S $P(^TMP("TSRD",$J,D),"^",10)=ADC("D")
57 S $P(^TMP("TSRG",$J),"^",10)=ADC("G")
58 ;
59CUM S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",12)=BD("P")
60 S $P(^TMP("TSRS",$J,D,S),"^",12)=BD("S")
61 S $P(^TMP("TSRD",$J,D),"^",12)=BD("D")
62 S $P(^TMP("TSRG",$J),"^",12)=BD("G")
63 ;
64 ; formats ADC number into comma output
65COMMA S X=$P(^TMP("TSR",$J,D,S,ORDER,TS),"^",12) D COMMA^%DTC S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",11)=$P(X,".")
66 S X=$P(^TMP("TSRS",$J,D,S),"^",12) D COMMA^%DTC S $P(^TMP("TSRS",$J,D,S),"^",11)=$P(X,".")
67 S X=$P(^TMP("TSRD",$J,D),"^",12) D COMMA^%DTC S $P(^TMP("TSRD",$J,D),"^",11)=$P(X,".")
68 S X=$P(^TMP("TSRG",$J),"^",12) D COMMA^%DTC S $P(^TMP("TSRG",$J),"^",11)=$P(X,".")
69 ;
70END Q
Note: See TracBrowser for help on using the repository browser.