source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASEZU2.m@ 623

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

initial load of WorldVistAEHR
File size: 7.3 KB
RevLine 
[613]1EASEZU2 ;ALB/jap - Utilities for 1010EZ Processing ;10/13/00 10:53
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**53**;Mar 15, 2001
3 ;
4PICKALL(EASVIEW) ;For processing status selected, pick-up all records in #712
5 ;Loop through Application Holding file #712 for status selected
6 N APP,FAC,INDEX,JDATE,DAT0,NAME,SSN,VETTYPE,FDAYS,WEBID,WILLSEND,ENTRY,EDATE,X,Y,I,J,T,V,X1,X2,X3
7 Q:'EASVIEW Q:EASVIEW>6
8 K ^TMP($J,712,EASVIEW)
9 ;index to search depends on status selected for viewing
10 S V=EASVIEW,INDEX=$S(V=1:"NEW",V=2:"REV",V=3:"PRT",V=4:"SIG",V=5:"FIL",V=6:"CLS",1:"")
11 Q:V="" Q:INDEX=""
12 S I=INDEX D
13 .;use the index to get each application in selected status
14 .;here JDATE is the date on which the application reached status of interest
15 .S JDATE=0 F S JDATE=$O(^EAS(712,I,JDATE)) Q:'JDATE S APP=0 F S APP=$O(^EAS(712,I,JDATE,APP)) Q:'APP D
16 ..S DAT0=$G(^EAS(712,APP,0)),NAME=$P(DAT0,U,4),ENTRY=$P(DAT0,U,6),SSN=$P($P(DAT0,U,5),"&",1),T=$P(DAT0,U,9)
17 ..S WEBID=$P(DAT0,U,2),WILLSEND=$P(DAT0,U,13)
18 ..S FAC=$P($G(^EAS(712,APP,1)),U,6) S:FAC="" FAC=1
19 ..;don't include filed apps if filed more than 30 days ago.
20 ..S FDAYS=0 I (INDEX="FIL")!(INDEX="CLS") S X2=JDATE,X1=DT D ^%DTC S FDAYS=X
21 ..I FDAYS>30 K ^EAS(712,INDEX,JDATE,APP)
22 ..Q:FDAYS>30
23 ..;avoid any stub entries
24 ..Q:NAME=""
25 ..S Y=ENTRY,%F=2,EDATE=$$FMTE^XLFDT(Y,%F) I $L(EDATE)<10 D
26 ...S X1=$P(EDATE,"/",1),X2=$P(EDATE,"/",2),X3=$P(EDATE,"/",3)
27 ...S:$L(X1)=1 X1="0"_X1 S:$L(X2)=1 X2="0"_X2
28 ...S EDATE=X1_"/"_X2_"/"_X3
29 ..S VETTYPE=$S(T=1:"SC 50-100%",T=2:"SC <50%",T=3:"SC 0%",T=4:"POW",T=5:"PURPLE HEART",T=6:"MIL. RETIREE",T=7:"NSC",1:"")
30 ..S ^TMP($J,712,EASVIEW,FAC,NAME,ENTRY,APP)=APP_U_SSN_U_VETTYPE_U_EDATE_U_JDATE_U_WEBID_U_WILLSEND_U_FAC
31 Q
32 ;
33SETDATE(EASAPP,INDEX) ;update fields & indexes associated with processing status
34 ;
35 N DA,DR,DIE
36 S DA=EASAPP,DIE="^EAS(712,"
37 I INDEX="REV" S DR="5.1///^S X=DT;5.2////^S X=DUZ" D ^DIE,REINDEX^EASEZU2(EASAPP,INDEX) Q
38 I INDEX="PRT" S DR="6.1///^S X=DT;6.2////^S X=DUZ" D ^DIE,REINDEX^EASEZU2(EASAPP,INDEX) Q
39 I INDEX="SIG" S DR="4///^S X=DT;4.1///^S X=DT;4.2////^S X=DUZ" D ^DIE,REINDEX^EASEZU2(EASAPP,INDEX) Q
40 I INDEX="FIL" S DR="7.1///^S X=DT;7.2////^S X=DUZ" D ^DIE,REINDEX^EASEZU2(EASAPP,INDEX) Q
41 I INDEX="CLS" S DR="9.1///^S X=DT;9.2////^S X=DUZ" D ^DIE,REINDEX^EASEZU2(EASAPP,INDEX) Q
42 Q
43 ;
44APPINDEX(EASAPP) ;Check file #712 processing index for Application
45 ;get determining date and remove any index entries no longer current
46 N CLSDATE,FILDATE,SIGDATE,PRTDATE,REVDATE,NEWDATE
47 S CLSDATE=$P($G(^EAS(712,EASAPP,2)),U,9) I CLSDATE D REINDEX(EASAPP,"CLS",CLSDATE) Q
48 S FILDATE=$P($G(^EAS(712,EASAPP,2)),U,5) I FILDATE D REINDEX(EASAPP,"FIL",FILDATE) Q
49 S SIGDATE=$P($G(^EAS(712,EASAPP,1)),U,1) I SIGDATE D REINDEX(EASAPP,"SIG",SIGDATE) Q
50 S PRTDATE=$P($G(^EAS(712,EASAPP,2)),U,3) I PRTDATE D REINDEX(EASAPP,"PRT",PRTDATE) Q
51 S REVDATE=$P($G(^EAS(712,EASAPP,2)),U,1) I REVDATE D REINDEX(EASAPP,"REV",REVDATE) Q
52 S NEWDATE=$P($G(^EAS(712,EASAPP,0)),U,6) I NEWDATE D REINDEX(EASAPP,"NEW",NEWDATE) Q
53 Q
54 ;
55REINDEX(EASAPP,EASINDEX,THISDATE) ;Remove previous index for Application upon processing status change
56 ;There are 6 critical indexes maintained on file #712 to indicate processing status.
57 ; "NEW" -- New applications; uses field #3, ENTRY DATE
58 ; "REV" -- In Review applications; uses field #5.1, REVIEW DATE
59 ; "PRT" -- Printed/Awaiting Signature applications; uses field #6.1, PRINT DATE
60 ; "SIG" -- Signed applications; uses field #4, DATE SIGNED BY APPLICANT
61 ; "FIL" -- Filed applications; uses field #7.1, FILING DATE
62 ; "CLS" -- Closed/inactivated applications; uses field #9.1, CLOSE DATE
63 ;
64 ;When a date is initially entered into one of the fields listed above, FM updates the
65 ; the index as needed; this function removes the "old" index entry for the application.
66 ;
67 ;Once a date has been entered into one of the fields listed above, repeated actions
68 ; of the same type do not update the field with a new date; therefore, a new index
69 ; entry won't be created.
70 ; For example: The first time the 1010EZ application is Printed for Signature
71 ; field #6.1 is updated and FM creates the index entry in "PRT",
72 ; and this function is called to remove the old "REV" index entry;
73 ; If the 1010EZ is Printed again sometime later, say after it has
74 ; already been Filed, that Print action will not update field #6.1
75 ;
76 ;input
77 ; EASAPP = ien in file #712 for Application
78 ; EASINDEX = index for current processing status
79 ; THISDATE = date to be used to set cross-reference; [optional]
80 ; internal FM format
81 ;output
82 ; none
83 ;
84 N DATE
85 ;
86 ;set appropriate index if necessary
87 I $G(THISDATE) S ^EAS(712,EASINDEX,THISDATE,EASAPP)=""
88 ;
89 I EASINDEX="NEW" D Q
90 .;get REVIEW DATE
91 .S DATE=$P($G(^EAS(712,EASAPP,2)),U,1)
92 .I DATE K ^EAS(712,"REV",DATE,EASAPP)
93 .;get PRINT DATE
94 .S DATE=$P($G(^EAS(712,EASAPP,2)),U,3)
95 .I DATE K ^EAS(712,"PRT",DATE,EASAPP)
96 ;
97 I EASINDEX="REV" D Q
98 .;get ENTRY DATE
99 .S DATE=$P($G(^EAS(712,EASAPP,0)),U,6)
100 .I DATE K ^EAS(712,"NEW",DATE,EASAPP)
101 ;
102 I EASINDEX="PRT" D Q
103 .;get REVIEW DATE
104 .S DATE=$P($G(^EAS(712,EASAPP,2)),U,1)
105 .I DATE K ^EAS(712,"REV",DATE,EASAPP)
106 ;
107 I EASINDEX="SIG" D Q
108 .;get REVIEW DATE
109 .S DATE=$P($G(^EAS(712,EASAPP,2)),U,1)
110 .I DATE K ^EAS(712,"REV",DATE,EASAPP)
111 .;get PRINT DATE
112 .S DATE=$P($G(^EAS(712,EASAPP,2)),U,3)
113 .I DATE K ^EAS(712,"PRT",DATE,EASAPP)
114 ;
115 I EASINDEX="FIL" D Q
116 .;get PRINT DATE
117 .S DATE=$P($G(^EAS(712,EASAPP,2)),U,3)
118 .I DATE K ^EAS(712,"PRT",DATE,EASAPP)
119 .;get DATE SIGNED BY APPLICANT
120 .S DATE=$P($G(^EAS(712,EASAPP,1)),U,1)
121 .I DATE K ^EAS(712,"SIG",DATE,EASAPP)
122 ;
123 I EASINDEX="CLS" D Q
124 .;get ENTRY DATE
125 .S DATE=$P($G(^EAS(712,EASAPP,0)),U,6)
126 .I DATE K ^EAS(712,"NEW",DATE,EASAPP)
127 .;get REVIEW DATE
128 .S DATE=$P($G(^EAS(712,EASAPP,2)),U,1)
129 .I DATE K ^EAS(712,"REV",DATE,EASAPP)
130 .;get PRINT DATE
131 .S DATE=$P($G(^EAS(712,EASAPP,2)),U,3)
132 .I DATE K ^EAS(712,"PRT",DATE,EASAPP)
133 ;
134 Q
135 ;
136CURRSTAT(EASAPP) ;Check file #712 processing index for Application
137 ;return current Application status
138 N CLSDATE,FILDATE,SIGDATE,PRTDATE,REVDATE,NEWDATE
139 S CLSDATE=$P($G(^EAS(712,EASAPP,2)),U,9) I CLSDATE Q "CLS"
140 S FILDATE=$P($G(^EAS(712,EASAPP,2)),U,5) I FILDATE Q "FIL"
141 S SIGDATE=$P($G(^EAS(712,EASAPP,1)),U,1) I SIGDATE Q "SIG"
142 S PRTDATE=$P($G(^EAS(712,EASAPP,2)),U,3) I PRTDATE Q "PRT"
143 S REVDATE=$P($G(^EAS(712,EASAPP,2)),U,1) I REVDATE Q "REV"
144 S NEWDATE=$P($G(^EAS(712,EASAPP,0)),U,6) I NEWDATE Q "NEW"
145 Q ""
146 ;
147LOCAL711 ;set up TMP global array
148 ;to hold file #711 & file #712 correlated data; and a useful index
149 N IEN,DIC,DIE,DA,DR,DLAYGO,DINUM,X,Y,DATANM,DATAKEY,DISPNM,FILE,SUBF,FLD,GRP
150 ;make sure 'unknown' is in #711
151 K ^TMP("EZDATA",$J),^TMP("EZINDEX",$J)
152 I '$D(^EAS(711,.1,0)) D
153 .S DIC="^EAS(711,",DIC(0)="L",DLAYGO="",X="UNKNOWN",DINUM=.1
154 .K DD,DO D FILE^DICN
155 I $D(^EAS(711,.1,0)) D
156 .S DA=.1
157 .S DIE="^EAS(711,",DR=".1///^S X=""UNKNOWN"";1///^S X=""A"";2///^S X=0;3///^S X=0;4///^S X=0"
158 .D ^DIE
159 ;pick up records from "ACTIVE" index
160 S IEN=0 F S IEN=$O(^EAS(711,"A","A",IEN)) Q:'IEN D
161 .S DATAKEY=$P(^EAS(711,IEN,0),U,2),X=$G(^EAS(711,IEN,1)),FILE=$P(X,U,1),SUBF=$P(X,U,2),FLD=$P(X,U,3) S:SUBF="" SUBF=FILE
162 .S DATANM=$P($G(^EAS(711,IEN,0)),U,1),DISPNM=$G(^EAS(711,IEN,2))
163 .S ^TMP("EZDATA",$J,IEN)=X_U_DATAKEY_U_DISPNM
164 .S GRP=$S(DATANM["SPOUSE":"S",DATANM["CHILD1":"C1",DATANM["CHILD(N)":"CN",1:"A")
165 .S ^TMP("EZINDEX",$J,GRP,FILE,SUBF,FLD,IEN)=IEN_U_DATANM
166 Q
Note: See TracBrowser for help on using the repository browser.