source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMTSI2.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.4 KB
Line 
1DGPMTSI2 ;ALB/LM - TREATING SPECIALTY INPATIENT SET ; 3/10/93
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4 Q
5START ;
6 D PTLWD,PTLTS,PTCTS
7 ;
8END K AA,ASIH,PASS,UA,MVT,PT,SV,SV1,TREAT,WARD Q
9 ;
10 ;
11PTLWD Q:'PTLWD ; Patient Listing by Wards
12 S ^TMP($J,"PTLWD",DIV)=$S($D(^TMP($J,"PTLWD",DIV)):^TMP($J,"PTLWD",DIV),1:0)
13 S $P(^TMP($J,"PTLWD",DIV),"^",1)=$P(^TMP($J,"PTLWD",DIV),"^",1)+1
14 S $P(^TMP($J,"PTLWD",DIV),"^",2)=$P(^TMP($J,"PTLWD",DIV),"^",2)+PASS
15 S $P(^TMP($J,"PTLWD",DIV),"^",3)=$P(^TMP($J,"PTLWD",DIV),"^",3)+AA
16 S $P(^TMP($J,"PTLWD",DIV),"^",4)=$P(^TMP($J,"PTLWD",DIV),"^",4)+UA
17 S $P(^TMP($J,"PTLWD",DIV),"^",5)=$P(^TMP($J,"PTLWD",DIV),"^",5)+ASIH
18 S ^TMP($J,"PTLWD",DIV,WARD,+DGW)=$S($D(^TMP($J,"PTLWD",DIV,WARD,+DGW)):^TMP($J,"PTLWD",DIV,WARD,+DGW),1:0)
19 S $P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",1)=$P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",1)+1
20 S $P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",2)=$P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",2)+PASS
21 S $P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",3)=$P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",3)+AA
22 S $P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",4)=$P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",4)+UA
23 S $P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",5)=$P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",5)+ASIH
24 S ^TMP($J,"PTLWD",DIV,WARD,+DGW,PT,DFN)=TREAT_"^"_ADMDT_"^"_$S(SV'=0:SV,1:"")_"^"_MVT
25 Q
26 ;
27PTLTS Q:'PTLTS ; Patient Listing by Treating Specialty
28 S ^TMP($J,"PTLTS",DIV)=$S($D(^TMP($J,"PTLTS",DIV)):^TMP($J,"PTLTS",DIV),1:0)
29 S $P(^TMP($J,"PTLTS",DIV),"^",1)=$P(^TMP($J,"PTLTS",DIV),"^",1)+1
30 S $P(^TMP($J,"PTLTS",DIV),"^",2)=$P(^TMP($J,"PTLTS",DIV),"^",2)+PASS
31 S $P(^TMP($J,"PTLTS",DIV),"^",3)=$P(^TMP($J,"PTLTS",DIV),"^",3)+AA
32 S $P(^TMP($J,"PTLTS",DIV),"^",4)=$P(^TMP($J,"PTLTS",DIV),"^",4)+UA
33 S $P(^TMP($J,"PTLTS",DIV),"^",5)=$P(^TMP($J,"PTLTS",DIV),"^",5)+ASIH
34 S ^TMP($J,"PTLTS",DIV,TREAT,DGTS)=$S($D(^TMP($J,"PTLTS",DIV,TREAT,DGTS)):^TMP($J,"PTLTS",DIV,TREAT,DGTS),1:0)
35 S $P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",1)=$P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",1)+1
36 S $P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",2)=$P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",2)+PASS
37 S $P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",3)=$P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",3)+AA
38 S $P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",4)=$P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",4)+UA
39 S $P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",5)=$P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",5)+ASIH
40 S ^TMP($J,"PTLTS",DIV,TREAT,DGTS,PT,DFN)=WARD_"^"_ADMDT_"^"_$S(SV'=0:SV,1:"")_"^"_MVT
41 Q
42 ;
43PTCTS Q:'PTCTS ; Patient Counts by Treating Specialty
44 S ^TMP($J,"PTCTS",DIV)=$S($D(^TMP($J,"PTCTS",DIV)):^TMP($J,"PTCTS",DIV),1:0)
45 S $P(^TMP($J,"PTCTS",DIV),"^",1)=$P(^TMP($J,"PTCTS",DIV),"^",1)+1
46 S $P(^TMP($J,"PTCTS",DIV),"^",2)=$P(^TMP($J,"PTCTS",DIV),"^",2)+PASS
47 S $P(^TMP($J,"PTCTS",DIV),"^",3)=$P(^TMP($J,"PTCTS",DIV),"^",3)+AA
48 S $P(^TMP($J,"PTCTS",DIV),"^",4)=$P(^TMP($J,"PTCTS",DIV),"^",4)+UA
49 S $P(^TMP($J,"PTCTS",DIV),"^",5)=$P(^TMP($J,"PTCTS",DIV),"^",5)+ASIH
50 S ^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV)=$S($D(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV)):^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),1:0)
51 S $P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",1)=$P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",1)+1
52 S $P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",2)=$P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",2)+PASS
53 S $P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",3)=$P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",3)+AA
54 S $P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",4)=$P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",4)+UA
55 S $P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",5)=$P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",5)+ASIH
56 Q
Note: See TracBrowser for help on using the repository browser.