source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASEZI.m@ 862

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

initial load of WorldVistAEHR
File size: 6.2 KB
RevLine 
[613]1EASEZI ;ALB/jap - Database Inquiry & Record Finder for 1010EZ Processing ;10/12/00 13:08
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**1,9,44,51,57**;Mar 15, 2001
3 ;
4DFN(EASAPP,EASDFN) ;match or add 1010EZ applicant to Patient file #2
5 ;
6 ;input
7 ; EASAPP = application ien in file #712
8 ;output
9 ; EASDFN = valid ien in file #2; passed by reference
10 ; OR -1 if no patient match made;
11 ; note: this may be an existing patient or one newly created by user action
12 ;
13 ;This entry point it used only for initial match of Applicant with Patient database.
14 ;
15 N DFN,DGNEWPF,DGRPTOUT,EZDATA,KEY,NAME,SSN,DOB,SEX,KEYIEN,ACCEPT,ARRAY,RECD
16 N VETTYPE,NEW,TSSN,REM,N,X,DA,DR,DIE,DIC,DIQ,ALREADY,OUT,FILE,SUBFILE,FLD,ELIGVER,SVCVER,APPTVER
17 Q:'EASAPP
18 ;do not proceed if link to file #2 already established
19 S EASDFN=$P($G(^EAS(712,EASAPP,0)),U,10) Q:EASDFN
20 D FULL^VALM1 W @IOF
21 S EASEZNEW="",ELIGVER=0,SVCVER=0,APPTVER=0
22 S KEY=$$KEY711^EASEZU1("APPLICANT SEX")
23 S SEX=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1),SEX=$S(SEX="M":"Male",SEX="F":"Female",1:"")
24 S DIQ="ARRAY",DIQ(0)="E",DA=EASAPP,DR="1;2;3;3.3",DIC=712 D EN^DIQ1
25 S NAME=$G(ARRAY(712,EASAPP,1,"E"))
26 S SSN=$P($G(ARRAY(712,EASAPP,2,"E")),"&",1)
27 S DOB=$P($G(ARRAY(712,EASAPP,2,"E")),"&",2)
28 S RECD=$G(ARRAY(712,EASAPP,3,"E"))
29 S VETTYPE=$G(ARRAY(712,EASAPP,3.3,"E"))
30 W !,"Applicant Data",?24,"Application #: ",EASAPP,?48,"Received: ",RECD,!
31 W !,"Name: ",NAME
32 W !,"SSN: ",SSN,?24,"DOB: ",DOB,?48,"Sex: ",SEX
33 W !,"Veteran Type: ",VETTYPE
34 W !!,"Enter Applicant data as prompted --"
35 ;
36 ;Get Patient file (#2) IEN - DFN
37 D GETPAT^DGRPTU("",1,.DFN,.DGNEWPF)
38 Q:($G(DFN)'>0)
39 ;if DGNEWPF=1 then applicant has just been added to file #2 as new patient
40 S NEW=""
41 I DGNEWPF D
42 . S NEW=1
43 . ;add a remark to file #2 record to help keep track of new patients added by 1010EZ
44 . S REM="NEW PT. FROM ELECTRONIC 10-10EZ -- IN PROCESS"
45 . S DA=DFN,DIE="^DPT(",DR=".091///^S X=REM"
46 . D ^DIE
47 ;if seems to be not new, check remark field just to make sure
48 I NEW="" D
49 . S REM="NEW PT. FROM ELECTRONIC 10-10EZ -- IN PROCESS"
50 . I $P(^DPT(DFN,0),U,10)=REM S NEW=1
51 . S REM="New Patient record added by ELECTRONIC 10-10EZ."
52 . I $P(^DPT(DFN,0),U,10)=REM S NEW=1
53 ;MPI Query
54 S X="MPIFAPI" X ^%ZOSF("TEST") D
55 . Q:'$T
56 . K MPIFRTN
57 . D MPIQ^MPIFAPI(DFN)
58 . K MPIFRTN,MPIQRYNM
59 ;check for an in-process application already linked to this DFN
60 S OUT=0,ALREADY=0 F S ALREADY=$O(^EAS(712,"AC",DFN,ALREADY)) Q:'ALREADY D Q:OUT
61 . S FILDATE=$P($G(^EAS(712,ALREADY,2)),U,5)
62 . S CLSDATE=$P($G(^EAS(712,ALREADY,2)),U,9)
63 . I 'FILDATE,'CLSDATE S OUT=1 D
64 . . W !!?3,"Sorry... cannot link to selected Patient."
65 . . W !?3,"Application #"_ALREADY_" is already linked to this Patient,"
66 . . W !?3,"and is still in-process."
67 . . D PAUSE^VALM1 K FILDATE,CLSDATE
68 Q:OUT
69 D RESET^EASEZI1
70 Q
71 ;
72I201(EASDFN,EASARRAY) ;retrieve ien(s) in subfile #2.01
73 ;input EASDFN = ien to #2
74 ;output EASARRAY = ien(s) to #2.01
75 ; each array element = EASDFN;subfile_ien
76 ;
77 N N,IEN
78 S IEN=0,N=0 F S IEN=$O(^DPT(EASDFN,.01,IEN)) Q:'IEN S N=N+1,EASARRAY(N)=EASDFN_";"_IEN
79 Q
80 ;
81I202(EASDFN,EASARRAY) ;retrieve ien(s) in subfile #2.02
82 ;input EASDFN = ien to #2
83 ;output EASARRAY = ien(s) to #2.01
84 ; each array element = EASDFN;subfile_ien
85 ;
86 N N,IEN
87 S IEN=0,N=0 F S IEN=$O(^DPT(EASDFN,.02,IEN)) Q:'IEN S N=N+1,EASARRAY(N)=EASDFN_";"_IEN
88 Q
89 ;
90I206(EASDFN,EASARRAY) ;retrieve ien(s) in subfile #2.06
91 ;input EASDFN = ien to #2
92 ;output EASARRAY = ien(s) to #2.01
93 ; each array element = EASDFN;subfile_ien
94 ;
95 N N,IEN
96 S IEN=0,N=0 F S IEN=$O(^DPT(EASDFN,.06,IEN)) Q:'IEN S N=N+1,EASARRAY(N)=EASDFN_";"_IEN
97 Q
98 ;
99I2101(EASDFN,EASARRAY) ;retrieve ien to subfile #2.101
100 ;input EASDFN = ien to #2
101 ;output EASARRAY = most recent ien in #2.101;
102 ; array element = EASDFN;subfile_ien
103 ;
104 N N,IEN,ARR,LAST
105 S IEN=0,N=0 F S IEN=$O(^DPT(EASDFN,"DIS",IEN)) Q:'IEN D
106 . S RDATE=$P(^DPT(EASDFN,"DIS",IEN,0),U,1),ARR(RDATE)=IEN
107 I $D(ARR) D
108 . S LAST=$O(ARR(999999999),-1),IEN=ARR(LAST)
109 . S EASARRAY(1)=EASDFN_";"_IEN
110 Q
111 ;
112I2711(EASDFN,EASARRAY) ;retrieve ien to file #27.11
113 ;input EASDFN = ien to #2
114 ;output EASARRAY = current enrollment ien in #27.11;
115 ; array element = ien
116 N CUR
117 S CUR=$$FINDCUR^DGENA(+EASDFN)
118 S EASARRAY(1)=CUR
119 Q
120 ;
121I408(EASDFN,EASAPP,EASARRAY) ;retrieve ien(s) to files #408.12,#408.13,#408.21,#408.22
122 ;
123 ;input EASDFN = ien to #2
124 ; EASAPP = ien to #712
125 ;output EASARRAY = ien(s) to files; passed by reference
126 ; array(408,"V",1) = ien_#408.12^ien_#408.13^ien_#408.21^ien#408.22 ;veteran data
127 ; array(408,"S",1) = ien_#408.12^ien_#408.13^ien_#408.21^ien#408.22 ;spouse data
128 ; array(408,"C",multiple) = ien_#408.12^ien_#408.13^ien_#408.21^ien#408.22 ;child data
129 ; where ien_#408.13 = ien;global_root
130 ;
131 N CURINCYR,X,Y,DIC,DA,DR,DIQ,EAS,DEP,REL,IX,JX,KX,I13,SUB1,SUB2,INCYR,PT
132 ;
133 Q:'EASDFN
134 S Y=$P($G(^EAS(712,EASAPP,0)),U,6) I Y="" S Y=DT
135 S %F=5,X=$$FMTE^XLFDT(Y,%F),X=+$P(X,"/",3)-1,%DT="P" D ^%DT S CURINCYR=Y
136 ;find all associated 408 records, even if no actual income test
137 ; get #408.12, #408.13, #408.21, #408.22 iens
138 K EAS S DEP=0
139 S IX=0 F S IX=$O(^DGPR(408.12,"B",EASDFN,IX)) Q:'IX D
140 . S DIC=408.12,DA=IX,DIQ="EAS",DIQ(0)="I",DR=".02;.03" D EN^DIQ1
141 . S REL=$G(EAS(408.12,IX,.02,"I")),I13=$G(EAS(408.12,IX,.03,"I"))
142 . S (SUB1,SUB2)="" S:REL=1 SUB1="V",SUB2=1 S:REL=2 SUB1="S",SUB2=1 S:REL>2 SUB1="C",DEP=DEP+1,SUB2=DEP
143 . I SUB1]"" S EASARRAY(408,SUB1,SUB2)=IX_U_I13 D
144 . . S JX=$O(^DGMT(408.21,"C",IX,""),-1)
145 . . I JX D
146 . . . S DIC=408.21,DA=JX,DIQ="EAS",DIQ(0)="I",DR=".01;.02" D EN^DIQ1
147 . . . S INCYR=$G(EAS(408.21,JX,.01,"I")),PT=$G(EAS(408.21,JX,.02,"I"))
148 . . . Q:PT'=IX
149 . . . Q:(INCYR<CURINCYR)
150 . . . S KX=$O(^DGMT(408.22,"AIND",JX,0))
151 . . . S EASARRAY(408,SUB1,SUB2)=EASARRAY(408,SUB1,SUB2)_U_JX_U_KX
152 Q
153 ;
154I1275(IEN) ;get the active subrecord from subfile #408.1275
155 ;input IEN = internal record number to file #408.12
156 ;output SUBIEN = internal record number for active subrecord,
157 ; or -1 if invalid
158 N B,ACT,SUBIEN
159 I 'IEN Q -1
160 S SUBIEN=-1
161 S B=0 F S B=$O(^DGPR(408.12,IEN,"E",B)) Q:'B D
162 . S ACT=$P(^DGPR(408.12,IEN,"E",B,0),U,2)
163 . I ACT S SUBIEN=B
164 Q SUBIEN
Note: See TracBrowser for help on using the repository browser.