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

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1DGYPREG1 ;ALB/REW - POST-INIT PATIENT FILE POST-INIT CONT'D ;1-APR-93
2 ;;5.3;Registration;;Aug 13, 1993
3CFLREP ;End of Patient File Loop: Problem CFL Fields
4 N DGDJ
5 D SETUP(1) ; 1=CFL 2=TOTVACHK
6 D CSUM(1),CDET
7 D END
8 Q
9TOTVAREP ;End of Patient File Loop: Problem MB Fields
10 S DGDJ=$G(DGDJ)
11 N FROM,REP,SUB,TEXT,TO
12 N DGACT,DGDJ,DGFSTINT,DGL4,DGLPCT,DGPTNM,DGX,DGTEXT,X
13 S DGLPCT=0
14 D SETUP(2) ;1=CFL 2=TOTVA
15 D CSUM(2)
16 S DGFSTINT=+(9999999-$G(DGFSTDT)) ;INTERNAL FIRST DATE TO PRINT
17 I $G(DGFSTDT) D
18 .D MESS(" Only patients whose Last Activity Date is AFTER "_$E(DGFSTDT,4,5)_"/"_$E(DGFSTDT,6,7)_"/"_$E(DGFSTDT,2,3)_" will be listed.",1)
19 I $G(DGTOTBD)>DGMAXPT D
20 .D MESS(" Only "_DGMAXPT_" patients will be listed.",2)
21 .D MESS(" To see more, run the PIMS Monetary Benefit Amounts Conversion Report",1)
22 D MESS("PATIENT NAME LAST ACTIVITY A&A H.B. Dis. Pension")
23 D MESS($E(DGSPACE,1,17)_"4-ID DATE AMOUNT AMOUNT AMOUNT AMOUNT")
24 D MESS(DGUND)
25 F DGACT=0:0 S DGACT=$O(^TMP("DGBDMB",$J,DGACT)) Q:'DGACT F DFN=0:0 S DFN=$O(^TMP("DGBDMB",$J,DGACT,DFN)) Q:'DFN!(DGLPCT'<DGMAXPT)!(DGACT>DGFSTINT) S DGX=$G(^(DFN)) D
26 .D GETID
27 .S X=9999999-DGACT
28 .S DGTEXT=DGPTNM_$E(DGSPACE,$L(DGPTNM),16)_DGL4_" "_$E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3)_$E(DGSPACE,$L(X),6)_" "
29 .F X=1:1:4 S DGTEXT=DGTEXT_$J($P(DGX,U,X),10,2)
30 .D MESS(DGTEXT)
31 .S DGLPCT=DGLPCT+1
32 D END
33 Q
34END ;
35 N DIFROM
36 D ^XMD
37 ;K @DGROOT
38 K DGFSTDT,DGMAXPT,DGROOT,DGSPACE,DGTEXT,DGUCCT,DGUND,DGX,DGXM,DIR,XMDUZ,XMSUB,XMTEXT,XMY
39 Q
40SETUP(REP) ;
41 Q:'$G(REP)
42 S DGDJ=$S($G(DGDJ):DGDJ,1:$J)
43 S $P(DGUND,"=",76)=""
44 S $P(DGSPACE," ",81)=""
45 S:'$G(DGMAXPT) DGMAXPT=1999
46 S XMSUB=$S(REP=1:"Claims Folder Location Conversion Report",(REP=2):"Total Annual VA Check Amount Conversion Report",1:"PATIENT File ZIP+4 Population Complete")
47 S XMDUZ=.5
48 S XMY(DUZ)=""
49 S XMY(.5)=""
50 S DGROOT="^TMP("_$S(REP=1:"""DGCFLREP""",(REP=2):"""DGTOTVA""",1:"""DGZIP4""")_","_$J
51 S XMTEXT=DGROOT_","
52 S DGROOT=DGROOT_")"
53 K @DGROOT
54 D:(REP<3) HEAD^DGYPREG2(REP)
55 Q
56CSUM(REP) ;PRINTS SUMMARY
57 ;OUTPUT: DGUCCT = #Un-Convertible Patients
58 N ACT,ACTCT,CT,DFN,SUB,Z
59 D MESS(" "_($E(DGSPACE,1,23)_"TOTAL ACTIVE INACTIVE"))
60 S Z=9999999-(DT-10000)
61 S DGUCCT=0
62 I REP=1 F SUB="DGBDCFL","DGGDCFL" S (CT,ACTCT)=0 D SUM S:SUB="DGBDCFL" DGUCCT=CT
63 I REP=2 F SUB="DGBDMB","DGGDMB" S (CT,ACTCT)=0 D SUM S:SUB="DGBDMB" DGUCCT=CT
64 D MESS("")
65 Q
66SUM ;
67 F ACT=0:0 S ACT=$O(^TMP(SUB,$J,ACT)) Q:'ACT D
68 .S DFN=0 F CT=CT:1 S DFN=$O(^TMP(SUB,$J,ACT,DFN)) Q:'DFN S:ACT<Z ACTCT=ACTCT+1
69 D MESS(" "_$S(SUB["DGBD":"Un-Convertible:",1:"Convertible:")_$E(DGSPACE,$S(SUB["DGGD":12,1:15),19)_$J(CT,8)_" "_$J(ACTCT,8)_" "_$J((CT-ACTCT),8))
70 Q
71CDET ;
72 N DGCT,DGDT,DGACT,DGFSTINT,DGL4,DGPTNM,X
73 Q:'$G(DGMAXPT)
74 Q:'$G(DGUCCT)
75 D MESS("")
76 S DGFSTINT=+(9999999-$G(DGFSTDT)) ;INTERNAL FIRST DATE TO PRINT
77 I $G(DGFSTDT) D
78 .D MESS(" Only patients whose Last Activity Date is AFTER "_$E(DGFSTDT,4,5)_"/"_$E(DGFSTDT,6,7)_"/"_$E(DGFSTDT,2,3)_" will be listed.",1)
79 I DGUCCT>DGMAXPT D
80 .D MESS(" Only "_DGMAXPT_" patients will be listed.",2)
81 .D MESS(" To see more, run the PIMS Claim Folder Location Conversion Report",1)
82 D MESS("PATIENT NAME LAST ACTIVITY CLAIM FOLDER")
83 D MESS($E(DGSPACE,1,18)_"4-ID DATE LOCATION")
84 D MESS(DGUND)
85 S CT=0
86 F DGACT=0:0 S DGACT=$O(^TMP("DGBDCFL",$J,DGACT)) Q:('DGACT)!(DGMAXPT'>CT)!(DGACT>DGFSTINT) S DFN=0 F CT=CT:1:DGMAXPT S DFN=$O(^TMP("DGBDCFL",$J,DGACT,DFN)) Q:'DFN S DGX=$G(^(DFN)) D
87 .D GETID
88 .S X=9999999-DGACT
89 .D MESS(DGPTNM_$E(DGSPACE,$L(DGPTNM),17)_DGL4_" "_$E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3)_$E(DGSPACE,$L(X),6)_" "_$P(DGX,U,2))
90 Q
91GETID ;
92 N DGPNODE
93 S DGPNODE=$G(^DPT(DFN,0))
94 S DGPTNM=$E($P(DGPNODE,U,1),1,15),DGL4=$E($P(DGPNODE,U,9),6,9)
95 Q
96ACTDT(DFN) ;RETURNS LAST ACTIVE DATE
97 N A,ACTDT,X,Y
98 S ACTDT=0
99 S X=$O(^DPT(DFN,"DIS",0)) S:X ACTDT=9999999-X ;REG
100 S:$G(^DPT(DFN,.105)) ACTDT=DT ;INPATIENT
101 F A=0:0 S A=$O(^DGS(41.1,"B",DFN,A)) Q:A'>0 S X=$P($G(^DGS(41.1,+A,0)),U,2) S:X>ACTDT ACTDT=X ;ADM
102 S X=ACTDT F S X=$O(^DPT(DFN,"S",X)) S:X Y=X I 'X S:$G(Y)>ACTDT ACTDT=Y Q ;CLIN
103 S X=ACTDT F S X=$O(^DGPM("APRD",DFN,X)) S:X Y=X I 'X S:$G(Y)>ACTDT ACTDT=Y Q ;PM
104MESS(TEXT,LINES) ;ADD TO MAIL TEXT
105 ;
106 ; INPUT VARIABLES:
107 ; DGROOT - ARRAY HOLDING MAIL TEXT (NEEDS TO BE DEFINED)
108 ; TEXT - CONTENT OF NEXT LINE (PARAMETER)
109 ; LINES - [Optional] Parameter to do following line feed(s)
110 ; DGXM - LINE COUNT (NEEDS TO BE DEFINED)
111 Q:'$G(DGXM)!'$D(TEXT)
112 N I
113 S LINES=+$G(LINES)
114 F I=0:1:LINES D
115 .S DGXM=DGXM+1
116 .S @DGROOT@(DGXM,0)=TEXT
117 .S TEXT=""
118 Q
Note: See TracBrowser for help on using the repository browser.