source: WorldVistAEHR/trunk/r/OPERATIONS_WITH_DESERT_STORM-A1B2/A1B2OSR1.m@ 699

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1A1B2OSR1 ;ALB/AAS - ODS SUMMARY REPORT - COLLECT DATA ; 11-JAN-91
2 ;;Version 1.55 (local for MAS v5 sites);;
3 ;
4 K ^UTILITY($J)
5 D DATA Q
6 ;
7DATA ; -- collect admission data
8 S A=A1B2BDT-.00001
9 F I=A:0 S A=$O(^A1B2(11500.2,"B",A)) Q:'A!(A>(A1B2EDT+.9)) F M=0:0 S M=$O(^A1B2(11500.2,"B",A,M)) Q:'M I M,$D(^A1B2(11500.2,M,0)) S N=^(0) D FAC,ADM
10 ;
11 ; --collect discharge data
12 S D=A1B2BDT-.00001
13 F I=D:0 S D=$O(^A1B2(11500.2,"ADS",D)) Q:'D!(D>(A1B2EDT+.9)) F M=0:0 S M=$O(^A1B2(11500.2,"ADS",D,M)) Q:'M I M,$D(^A1B2(11500.2,M,0)) S N=^(0) D FAC,DIS
14 ;
15 ; -- collect patients remaining
16 S P=""
17 F I=0:0 S P=$O(^A1B2(11500.2,"B",P)) Q:'P!(P>(A1B2EDT+.9)) F M=0:0 S M=$O(^A1B2(11500.2,"B",P,M)) Q:'M I M,$D(^A1B2(11500.2,M,0)) S N=^(0) D FAC I $S($P(N,"^",6)="":1,($P(N,"^",6)>(A1B2EDT+.9)):1,1:0) D PTRM
18 ;
19 ; -- collect data on VA patients transfered to other facilities
20 S T=A1B2BDT-.0001
21 F I=T:0 S T=$O(^A1B2(11500.3,"B",T)) Q:'T!(T>(A1B2EDT+.9)) F M=0:0 S M=$O(^A1B2(11500.3,"B",T,M)) Q:'M I M,$D(^A1B2(11500.3,M,0)) S N=^(0) D FAC,TRF
22 Q
23 ;
24ADM ; -- count total admissions
25 Q:FAC=""!('A1B2CHK)
26 S DFN=$P(N,"^",2) Q:'DFN!('$P(N,"^",15))
27 S BOS=$S('DFN:"",'$D(^A1B2(11500.1,DFN,0)):"",1:$P(^(0),"^",4))
28 S SPC=$S('$P(N,"^",3):"",'$D(^DIC(42.4,$P(N,"^",3),0)):"",1:$P(^(0),"^",3))
29 S:'$D(^UTILITY($J,"ODS-ADM",FAC)) ^(FAC)=0 S ^(FAC)=^(FAC)+1
30 S:'$D(^UTILITY($J,"ODS-ADM-NAT")) ^("ODS-ADM-NAT")=0 S ^("ODS-ADM-NAT")=^("ODS-ADM-NAT")+1
31 ;
32 ; -- count unique admissions
33 I '$D(^UTILITY($J,"ODS-PT-ADM",DFN,FAC)) S:'$D(^UTILITY($J,"ODS-UNQ-ADM",FAC)) ^(FAC)=0 S ^(FAC)=^(FAC)+1
34 I '$D(^UTILITY($J,"ODS-PT-ADM",DFN)) S:'$D(^UTILITY($J,"ODS-UNQ-ADM-NAT")) ^("ODS-UNQ-ADM-NAT")=0 S ^("ODS-UNQ-ADM-NAT")=^("ODS-UNQ-ADM-NAT")+1
35 ;
36 ; -- count unique admssions by branch of service
37 I BOS]"",'$D(^UTILITY($J,"ODS-PT-ADM-BOS",BOS,DFN,FAC)) S:'$D(^UTILITY($J,"ODS-UNQA-BOS",FAC,BOS)) ^(BOS)=0 S ^(BOS)=^(BOS)+1
38 I BOS]"",'$D(^UTILITY($J,"ODS-PT-ADM-BOS",BOS,DFN)) S:'$D(^UTILITY($J,"ODS-UNQA-BOS-NAT",BOS)) ^(BOS)=0 S ^(BOS)=^(BOS)+1
39 ;
40 ; -- count unique admissions by specialty
41 I SPC]"",'$D(^UTILITY($J,"ODS-PT-ADM-SPC",SPC,DFN,FAC)) S:'$D(^UTILITY($J,"ODS-UNQA-SPC",FAC,SPC)) ^(SPC)=0 S ^(SPC)=^(SPC)+1
42 I SPC]"",'$D(^UTILITY($J,"ODS-PT-ADM-SPC",SPC,DFN)) S:'$D(^UTILITY($J,"ODS-UNQA-SPC-NAT",SPC)) ^(SPC)=0 S ^(SPC)=^(SPC)+1
43 ;
44 ; - store unique indicator
45 S ^UTILITY($J,"ODS-PT-ADM",DFN,FAC)=""
46 I BOS]"" S ^UTILITY($J,"ODS-PT-ADM-BOS",BOS,DFN,FAC)=""
47 I SPC]"" S ^UTILITY($J,"ODS-PT-ADM-SPC",SPC,DFN,FAC)=""
48 Q
49 ;
50DIS ; -- count total discharges
51 Q:FAC=""!('$P(N,"^",15))!('A1B2CHK)
52 S:'$D(^UTILITY($J,"ODS-DIS",FAC)) ^(FAC)=0 S ^(FAC)=^(FAC)+1
53 S:'$D(^UTILITY($J,"ODS-DIS-NAT")) ^("ODS-DIS-NAT")=0 S ^("ODS-DIS-NAT")=("ODS-DIS-NAT")+1
54 Q:'$P(N,"^",11)
55 ; -- count transfers to non-va facilities
56 S:'$D(^UTILITY($J,"ODS-TRF-NVA",FAC)) ^(FAC)=0 S ^(FAC)=^(FAC)+1
57 S:'$D(^UTILITY($J,"ODS-TRF-NVA-NAT")) ^("ODS-TRF-NVA-NAT")=0 S ^("ODS-TRF-NVA-NAT")=^("ODS-TRF-NVA-NAT")+1
58 Q
59 ;
60PTRM ; -- count patients remaining
61 Q:FAC=""!('$P(N,"^",15))!('A1B2CHK)
62 S:'$D(^UTILITY($J,"ODS-PTRM",FAC)) ^(FAC)=0 S ^(FAC)=^(FAC)+1
63 S:'$D(^UTILITY($J,"ODS-PTRM-NAT")) ^("ODS-PTRM-NAT")=0 S ^("ODS-PTRM-NAT")=^("ODS-PTRM-NAT")+1
64 Q
65 ;
66TRF ; -- count patient transfers
67 Q:FAC=""!('$P(N,"^",15))!($P(N,"^",11)="")!('A1B2CHK)
68 S TYP=$P(N,"^",11),SUBS=$S(TYP:"ODS-DISP-NVA",1:"ODS-DISP-VA")
69 S:'$D(^UTILITY($J,SUBS,FAC)) ^(FAC)=0 S ^(FAC)=^(FAC)+1
70 S SUBS=SUBS_"-NAT"
71 S:'$D(^UTILITY($J,SUBS)) ^(SUBS)=0 S ^(SUBS)=^(SUBS)+1
72 Q
73 ;
74FAC ; --set up facility number/name
75 S FAC=$P(N,"^",7) Q:FAC=""!('$P(N,"^",15))
76 S A1B2CHK=0,X=$S($D(A1B2NTY):$P(A1B2NTY,U,2),1:"")
77 I $S(X=""!(X="A"):1,X="R":$P(N,U,9)=A1B2VRG,X="V":$P(N,U,7)=A1B2FN,1:0) S A1B2CHK=1
78 Q:'A1B2CHK
79 I '$D(^UTILITY($J,"ODS-FAC",FAC)) S ^UTILITY($J,"ODS-FAC",FAC)=$P(N,"^",8)
80 Q
Note: See TracBrowser for help on using the repository browser.