source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCDXPOV.m@ 949

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1SCDXPOV ;ALB/SCK - VISIT REPORT BY NPCDB TRANSMISSION STATUS ; 05 Oct 98 8:37 PM
2 ;;5.3;Scheduling;**73,118,123,159,173**;AUG 13, 1993
3 ;
4 Q
5EN ; Main entry point for the visit report.
6 ;
7 ; Variables:
8 ; SCXBEG - Beginning date for encounters
9 ; SCXEND - Ending date for encounters
10 ; SCXMD - Multi-divisional Flag, 1: Multi-divisional, 0: if not
11 ; SCXSITE - Site
12 ; SCXSN - Site Number
13 ; SCDIV - Division
14 ; SCHDIV - Temporary division holder
15 ; SCXTFLG - Flag for show totals only
16 ; SCXOPT - Report option, 1: transmission only, 2: visit only, 3: both
17 ; SCXABRT - Flag abort condition
18 ;
19 N SCXBEG,SCXEND,SCXMD,SCDIV,SCHDIV,SCXTFLG,SCXOPT,SCXABRT
20 ;
21 K ^TMP("SCDXPOV",$J),^TMP("SCDXV",$J)
22 ;
23 S SCXBEG=$$GETDATE^SCDXPOV2("From Date: ")
24 G:SCXBEG<0 END
25EN1 S SCXEND=$$GETDATE^SCDXPOV2("To Date: ")
26 G:SCXEND<0 END
27 I SCXEND<SCXBEG D G EN1
28 . W !!,"TO DATE CANNOT BE EARLIER THAN FROM DATE",!
29 S SCXEND=SCXEND+.9
30 S SCXMD=0 I $D(^DIC(4,+$$SITE^VASITE(SCXBEG),"DIV")),^("DIV")="Y" S SCXMD=1
31 S SCXOPT=$$RPTOPT^SCDXPOV2 G:SCXOPT<0 END
32 I SCXMD,SCXOPT'[2 S SCXTFLG=$$SHWTOT^SCDXPOV2 G:SCXTFLG<0 END
33 S %ZIS="Q" D ^%ZIS G:POP END
34 I $D(IO("Q")) D QUE^SCDXPOV2 G END
35 ;
36START ;
37 S SCXABRT=0
38 S SCDIV=$P($$SITE^VASITE(SCXBEG),U,3)
39 I SCXMD F SCDIV=0:0 S SCDIV=$O(^DG(40.8,SCDIV)) Q:'SCDIV S SCHDIV=SCDIV,SCDIV=$P($$SITE^VASITE(SCXBEG,+SCDIV),U,3) D:SCDIV]"" INIT(SCDIV) S SCDIV=SCHDIV
40 I 'SCXMD D INIT(SCDIV)
41 ;
42 D BUILD(SCXBEG,SCXEND)
43 D:SCXOPT'[2 WRT^SCDXPOV1
44 G:SCXABRT END
45 D:SCXOPT'=1 WRT^SCDXPOV3
46 ;
47END ;
48 D:'$D(ZTQUEUED) ^%ZISC
49 K ^TMP("SCDXPOV",$J),^TMP("SCDXV",$J),ZTDESCR,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
50 Q
51 ;
52BUILD(SCXB,SCXE) ; Order through the encounters in the selected date range and process.
53 ; Input:
54 ; SCXB - Beginnging date (SCXBEG)
55 ; SCXE - Ending date (SCXEND)
56 ;
57 ; Variables
58 ; SDT - Date being checked
59 ; SCXOE - Outpatient encounter being checked
60 ;
61 N SDT,SCXOE
62 ;
63 S SDT=SCXB-.1
64 F S SDT=$O(^SCE("B",SDT)) Q:SDT'>0!(SDT>SCXE) D
65 . S SCXOE=0
66 . F S SCXOE=$O(^SCE("B",SDT,SCXOE)) Q:SCXOE'>0 D:$D(^SCE(SCXOE,0)) GOTIT(SCXOE)
67 Q
68 ;
69GOTIT(SCXOE) ; Process line of data in the OUTPATIENT ENCOUNTER FILE
70 ; Input:
71 ; SCXOE - IEN of entry in the OUTPATIENT ENCOUNTER File, #409.73
72 ; Variables
73 ; SCX - 0 node of the OUTPATIENT ENCOUNTER entry
74 ; SCX1 - 0 node of the TRANSMITTED OUTPATIENT ENCOUNTER entry
75 ; SCX2 - 1 node of the TRANSMITTED OUTPATIENT ENCOUNTER entry
76 ; SCXI - IEN of the associated entry (SCX) in the TRANSMITTED OUTPATIENT ENCOUNTER File
77 ; SCXEL - Eligibility of the encounter
78 ; SCXCV - Originating process for the encounter
79 ; SCXCP - 1 if appt. type is C&P, 0 if not
80 ; SCXDV - Division where the encounter took place
81 ; SCXACK - Acknowledgement status of TRANSMITTED OUTPATIENT ENCOUNTER entry
82 ; 0 - No information
83 ; 1 - Waiting Transmission
84 ; 2 - Transmitted
85 ; 3 - Acknowledged
86 ;
87 N SCX,SCX1,SCX2,SCXI,SCXEL,SCXCV,SCXCP,SCXDV,SCXACK
88 ;
89 Q:'$D(^SD(409.73,"AENC",SCXOE))
90 S SCX=^SCE(SCXOE,0)
91 S SCXI=0,SCXI=$O(^SD(409.73,"AENC",SCXOE,SCXI))
92 S SCX1=^SD(409.73,SCXI,0),SCX2=$G(^(1))
93 ;
94 S SCXEL=$P(SCX,U,13)
95 Q:SCXEL']"" Q:'$D(^DIC(8,SCXEL,0))
96 S SCXCV=$P(SCX,U,8) Q:SCXCV=4 S SCXCV=$$SCH(SCXCV)
97 S SCXCP=$S($P(SCX,U,10)=1:1,1:0)
98 S SCXDV=$P($$SITE^VASITE(SCXBEG,$P(SCX,U,11)),U,3)
99 ;
100 ;if division was inactive as of report start date, but division
101 ; was active as of the date of this encounter, be sure an array entry
102 ; exists to be able to count it.
103 I SCXDV']"" D Q:SCXDV']""
104 .D ECDT^SCDXUTL2(SCXI) S X=$P(X," ",1,3) D ^%DT
105 .S SCXDV=$P($$SITE^VASITE(Y,$P(SCX,U,11)),U,3)
106 .I SCXDV]"" D
107 ..D:'$D(^TMP("SCDXPOV",$J,SCXDV)) INIT(SCXDV)
108 ;
109 S SCXACK=0
110 ;
111 I $P(SCX1,U,4)=1&($P(SCX2,U,1)']"")&($P(SCX2,U,4)']"") S SCXACK=1
112 I $P(SCX1,U,4)=0&($P(SCX2,U,1)]"")&($P(SCX2,U,4)']"") S SCXACK=2
113 I $P(SCX1,U,4)=0&($P(SCX2,U,1)]"")&($P(SCX2,U,4)]"") S SCXACK=3
114 ;
115 Q:SCXACK=0
116 ;
117 ;I '$D(^TMP("SCDXPOV",$J,SCXDV)) D INIT(SCXDV)
118 Q:'$D(^TMP("SCDXPOV",$J,SCXDV))
119 ;
120 I SCXEL]"",$P(^DIC(8,SCXEL,0),U,5)="N" D
121 . S $P(^TMP("SCDXPOV",$J,SCXDV,"NVELIG",SCXEL),U,SCXACK)=+$P($G(^TMP("SCDXPOV",$J,SCXDV,"NVELIG",SCXEL)),U,SCXACK)+1
122 . S $P(^TMP("SCDXPOV",$J,"TOT","NVELIG",SCXEL),U,SCXACK)=+$P($G(^TMP("SCDXPOV",$J,"TOT","NVELIG",SCXEL)),U,SCXACK)+1
123 ;
124 I SCXEL]"",$P(^DIC(8,SCXEL,0),U,5)="Y" D
125 . S $P(^TMP("SCDXPOV",$J,SCXDV,"VELIG",SCXEL),U,SCXACK)=+$P($G(^TMP("SCDXPOV",$J,SCXDV,"VELIG",SCXEL)),U,SCXACK)+1
126 . S $P(^TMP("SCDXPOV",$J,"TOT","VELIG",SCXEL),U,SCXACK)=+$P($G(^TMP("SCDXPOV",$J,"TOT","VELIG",SCXEL)),U,SCXACK)+1
127 ;
128 I SCXCV]"",$D(^TMP("SCDXPOV",$J,SCXDV,"COV",SCXCV)) D
129 . S $P(^TMP("SCDXPOV",$J,SCXDV,"COV",SCXCV),U,SCXACK)=+$P(^TMP("SCDXPOV",$J,SCXDV,"COV",SCXCV),U,SCXACK)+1
130 . S $P(^TMP("SCDXPOV",$J,"TOT","COV",SCXCV),U,SCXACK)=+$P(^TMP("SCDXPOV",$J,"TOT","COV",SCXCV),U,SCXACK)+1
131 ;
132 I SCXCP,$D(^TMP("SCDXPOV",$J,SCXDV,"CP")) D
133 . S $P(^TMP("SCDXPOV",$J,SCXDV,"CP"),U,SCXACK)=+$P(^TMP("SCDXPOV",$J,SCXDV,"CP"),U,SCXACK)+1
134 . S $P(^TMP("SCDXPOV",$J,"TOT","CP"),U,SCXACK)=+$P(^TMP("SCDXPOV",$J,"TOT","CP"),U,SCXACK)+1
135 ;
136 ; Removed D:SCXACK, all encounters will now count towards visit
137 D VISIT^SCDXPOV3($P($P(SCX,U),"."),$P(SCX,U,2),SCXEL,$P(^DIC(8,SCXEL,0),U,5),SCXCV,SCXCP)
138 ;
139 Q
140 ;
141SCH(SCXCV) ;Determine scheduled/unscheduled status for appointment type encounters
142 ;Output: if SCXCV=2 or 3, SCXCV; if SCXCV=1, then 1 if appointment was pre-scheduled or 2 if appointment was a walk-in
143 Q:SCXCV'=1 SCXCV
144 N SCXAP S SCXAP=$G(^DPT(+$P(SCX,U,2),"S",+SCX,0))
145 Q:$P(SCXAP,U,20)'=SCXOE SCXCV
146 Q:$P(SCXAP,U,7)=4 2
147 Q 1
148 ;
149INIT(SDIV) ; Build TMP globals for encounter status count
150 ; Ignores any entry beginning with "DOM" or "ZZ"
151 ;
152 ; Input:
153 ; SDIV - Medical Center Division
154 ;
155 ; Variables
156 ; SCXELG - IEN from ELIGIBILITY CODE File, File #8
157 ; SCXN - 0 node for ELIGIBILITY CODE IEN
158 ;
159 N SCXELG,SCXN,LL
160 S SCXELG=0
161 ;
162 F S SCXELG=$O(^DIC(8,SCXELG)) Q:'SCXELG D
163 . S SCXN=$G(^DIC(8,SCXELG,0))
164 . Q:$$CHKELG^SCDXPOV2(SCXELG)
165 . I $P($G(^DIC(8,SCXELG,0)),U,5)="N" D
166 .. S ^TMP("SCDXPOV",$J,SDIV,"NVELIG",SCXELG)="0^0^0"
167 .. S:'$D(^TMP("SCDXPOV",$J,"TOT","NVELIG",SCXELG)) ^TMP("SCDXPOV",$J,"TOT","NVELIG",SCXELG)="0^0^0"
168 . I $P($G(^DIC(8,SCXELG,0)),U,5)="Y" D
169 .. S ^TMP("SCDXPOV",$J,SDIV,"VELIG",SCXELG)="0^0^0"
170 .. S:'$D(^TMP("SCDXPOV",$J,"TOT","VELIG",SCXELG)) ^TMP("SCDXPOV",$J,"TOT","VELIG",SCXELG)="0^0^0"
171 ;
172 F LL=1:1:3 D
173 . S ^TMP("SCDXPOV",$J,SDIV,"COV",LL)="0^0^0"
174 . S:'$D(^TMP("SCDXPOV",$J,"TOT","COV",LL)) ^TMP("SCDXPOV",$J,"TOT","COV",LL)="0^0^0"
175 ;
176 S ^TMP("SCDXPOV",$J,SDIV,"CP")="0^0^0"
177 S:'$D(^TMP("SCDXPOV",$J,"TOT","CP")) ^TMP("SCDXPOV",$J,"TOT","CP")="0^0^0"
178 Q
Note: See TracBrowser for help on using the repository browser.