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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1DGYPSDE2 ;ALB/GAH - EST. FILE SIZE NEEDED FOR OUT PATIENT ENCOUNTER FILE ; 10/10/2006
2 ;;5.3;REGISTRATION;**568,725**;Aug 13, 1993;Build 12
3 ;
4START N DGI,DGDTE,DGNUM,DGCSC,DGCNT,DGCLAR,X1,X2,DFN
5 N DGAPT,DGDISP,DGNODE,DGAE,DGAEDT,DGPCL,DGARRAY,SDCNT
6 S X1=DT,X2=-365 D C^%DTC S DG1YR=X ; one yr ago
7 S TDT=DT+.2359 ; today
8 ; Build Appointment information from Scheduling API
9 S DGARRAY(1)=DG1YR_";"_TDT,DGARRAY("FLDS")="2;3;10",DGARRAY("SORT")="P"
10 S SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
11 S (DGYR("AP"),DGYR("DI"),DGYR("AE"),DGYR("CR"),DFN,DGCNT)=0
12 ;SET UP A TEMP ARRAY -DGCLAR- WITH CLASSIFICATION ABBREVIATIONS
13 S DGCLAR(1)="AO",DGCLAR(2)="IR",DGCLAR(3)="SC",DGCLAR(4)="EC"
14 F DGCNT=1:1:4 S DGCL(DGCNT)=0
15 D DISAPP,AEDIT
16 K DGARRAY,SDCNT,^TMP($J,"SDAMA301")
17 Q
18 ;
19DISAPP ; FOR THE LAST YR PICK UP ALL APPT. AND DISP. FROM PATIENT FILE
20 ; SDAMA301 = APPOINTMENTS, "DIS" = DISPOSTIONS
21 F S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:'DFN D
22 .S DGAPT=0 F S DGAPT=$O(^TMP($J,"SDAMA301",DFN,DGAPT)) Q:'DGAPT D
23 ..N DGAPT0,DGCLN,DGSTAT,DGTYP S DGAPT0=^TMP($J,"SDAMA301",DFN,DGAPT)
24 ..S DGSTAT=$P($P(DGAPT0,U,3),";"),DGCLN=$P($P(DGAPT0,U,2),";"),DGTYP=$P($P(DGAPT0,U,10),";")
25 ..I DGSTAT["C"!(DGSTAT["N") Q
26 ..; INCR WILL CHECK FOR AND ACCUMULATE CLASSIFICATIONS
27 ..I $$STATUS(DFN,DGAPT,DGCLN,1)="C",$$EXEMPT($P($G(^SC(DGCLN,0)),U,7),DGTYP) D INCR(DFN)
28 ..S DGYR("AP")=DGYR("AP")+1
29 ..S:$P($G(^SC(DGCLN,0)),U,18)]"" DGYR("CR")=DGYR("CR")+1
30 .; -- Dispositions
31 .S DGDISP=0 F S DGDISP=$O(^DPT(DFN,"DIS",DGDISP)) Q:'DGDISP D
32 ..S DGNODE=$G(^DPT(DFN,"DIS",DGDISP,0))
33 ..I ((+DGNODE)>DG1YR)&((+DGNODE)<TDT),$P(DGNODE,U,2)=0!($P(DGNODE,U,2)=1) D
34 ...I $$STATUS(DFN,DGDISP,0,3)="C",$$EXEMPT(+$O(^DIC(40.7,"C",102,0)),9) D INCR(DFN)
35 ...S DGYR("DI")=DGYR("DI")+1
36 Q
37AEDIT ;FOR THE PAST YEAR PICK UP ALL ADD/EDITS FROM THE STOP CODE FILE
38 ;
39 S DGAEDT=""
40 F S DGAEDT=$O(^SDV(DGAEDT)) Q:DGAEDT="" D
41 .S DGNODE=$G(^SDV(DGAEDT,0))
42 .I (DGAEDT>DG1YR)&(DGAEDT<TDT) D
43 ..S DGAE=0
44 ..F S DGAE=$O(^SDV(DGAEDT,"CS",DGAE)) Q:'DGAE D
45 ...N DGAE0 S DGAE0=^SDV(DGAEDT,"CS",DGAE,0)
46 ...; DUPL WILL CHECK FOR ASSOCIATED APPT
47 ...I $$STATUS(+$P(DGNODE,U,2),+DGNODE,0,2),$$EXEMPT(+DGAE0,+$P(DGAE0,U,5)) D INCR($P(DGNODE,U,2))
48 ...D DUPL
49 ...S DGYR("AE")=DGYR("AE")+1
50 Q
51DUPL ; FOR EACH A/E RUN THROUGH THE APPTS LOOOK FOR ASSOC. APPTS
52 ; IF FOUND AND THEY HAVE A CLASSIFICATION CALL DECR
53 N DGBEG,DGEND
54 S DGCSC=^SDV(DGAEDT,"CS",DGAE,0)
55 S DFN=$P(DGNODE,U,2)
56 S DGCL=$P(DGCSC,U,3)
57 S DGBEG=$P(DGAEDT,".")
58 S DGEND=DGBEG+.2359
59 S DGI=DGBEG
60 F S DGI=$O(^TMP($J,"SDAMA301",DFN,DGI)) Q:('DGI)!(DGI>DGEND) D
61 .N DGI0,DGIST,DGICL,DGITP S DGI0=^TMP($J,"SDAMA301",DFN,DGI)
62 .S DGIST=$P($P(DGI0,U,3),";"),DGICL=$P($P(DGI0,U,2),";"),DGITP=$P($P(DGI0,U,10),";")
63 .I DGIST["C"!(DGIST["N") Q
64 .I +DGI0=DGCL,$$STATUS(DFN,DGI,DGCL,1)="C",$$EXEMPT(+$P($G(^SC(DGICL,0)),U,7),DGITP) D DECR(DFN)
65 Q
66DECR(DFN) ; DECREMENT ARRAY WITH THE CLASS CNTS
67 N DGYPCL D BLD^DGYPSDE3(DFN,.DGYPCL)
68 I $O(DGYPCL(0)) D
69 .S DGYPPCL=0
70 .F S DGYPPCL=$O(DGYPCL(DGYPPCL)) Q:'DGYPPCL D
71 ..S DGCL(DGYPPCL)=DGCL(DGYPPCL)-1
72 Q
73INCR(DFN) ; INCREMENT ARRAY WITH CLASS CNTS
74 N DGYPCL D BLD^DGYPSDE3(DFN,.DGYPCL)
75 I $O(DGYPCL(0)) D
76 .S DGYPPCL=0
77 .F S DGYPPCL=$O(DGYPCL(DGYPPCL)) Q:'DGYPPCL D
78 ..S DGCL(DGYPPCL)=DGCL(DGYPPCL)+1
79 Q
80 ;
81 ; STATUS WILL DETERMINE IF APPT WAS AN INPATIENT
82 ; OR A NON STOP CODE CLINIC
83STATUS(DFN,DGT,DGCL,DGORG) ;
84 N Y S Y=""
85 I $$INP^SDAM2(DFN,DGT)="I" S Y="I"
86 I Y="",DGORG=1,$P($G(^SC(+DGCL,0)),U,17)="Y" S Y="NC"
87 I Y="" S Y="C"
88 Q Y
89 ;
90 ; EXEMPT WILL RETURN A LOW IF THE STOP CODE IS BETWEEN 103+170
91 ; OR APPT TYPE IS NOT 9=REGULAR OR 2=SPECIAL DENTAL
92EXEMPT(DGSTOP,DGAPTY) ;
93 N Y
94 S DGSTOP=$P($G(^DIC(40.7,+DGSTOP,0)),U,2)
95 I DGSTOP>103,DGSTOP<171 S Y=0 G EXEMPTQ
96 I DGAPTY=9!(DGAPTY=2) S Y=1 G EXEMPTQ
97 S Y=0
98EXEMPTQ Q Y
Note: See TracBrowser for help on using the repository browser.