EASEZU2 ;ALB/jap - Utilities for 1010EZ Processing ;10/13/00 10:53
;;1.0;ENROLLMENT APPLICATION SYSTEM;**53,70**;Mar 15, 2001;Build 26
;
PICKALL(EASVIEW) ;For processing status selected, pick-up all records in #712
;Loop through Application Holding file #712 for status selected
N APP,FAC,INDEX,JDATE,DAT0,NAME,SSN,VETTYPE,FDAYS,WEBID,WILLSEND,ENTRY,EDATE,X,Y,I,J,T,V,X1,X2,X3
Q:'EASVIEW Q:EASVIEW>6
K ^TMP($J,712,EASVIEW)
;index to search depends on status selected for viewing
S V=EASVIEW,INDEX=$S(V=1:"NEW",V=2:"REV",V=3:"PRT",V=4:"SIG",V=5:"FIL",V=6:"CLS",1:"")
Q:V="" Q:INDEX=""
S I=INDEX D
. ;use the index to get each application in selected status
. ;here JDATE is the date on which the application reached status of interest
. 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
. . 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)
. . S WEBID=$P(DAT0,U,2),WILLSEND=$P(DAT0,U,13)
. . S FAC=$P($G(^EAS(712,APP,1)),U,6) S:FAC="" FAC=1
. . ;don't include filed apps if filed more than 30 days ago.
. . S FDAYS=0 I (INDEX="FIL")!(INDEX="CLS") S X2=JDATE,X1=DT D ^%DTC S FDAYS=X
. . I FDAYS>30 K ^EAS(712,INDEX,JDATE,APP)
. . Q:FDAYS>30
. . ;avoid any stub entries
. . Q:NAME=""
. . S Y=ENTRY,%F=2,EDATE=$$FMTE^XLFDT(Y,%F) I $L(EDATE)<10 D
. . . S X1=$P(EDATE,"/",1),X2=$P(EDATE,"/",2),X3=$P(EDATE,"/",3)
. . . S:$L(X1)=1 X1="0"_X1 S:$L(X2)=1 X2="0"_X2
. . . S EDATE=X1_"/"_X2_"/"_X3
. . 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:"")
. . S ^TMP($J,712,EASVIEW,FAC,NAME,ENTRY,APP)=APP_U_SSN_U_VETTYPE_U_EDATE_U_JDATE_U_WEBID_U_WILLSEND_U_FAC
Q
;
SETDATE(EASAPP,INDEX) ;update fields & indexes associated with processing status
;
N DA,DR,DIE
S DA=EASAPP,DIE="^EAS(712,"
I INDEX="REV" S DR="5.1///^S X=DT;5.2////^S X=DUZ" D ^DIE,REINDEX^EASEZU2(EASAPP,INDEX) Q
I INDEX="PRT" S DR="6.1///^S X=DT;6.2////^S X=DUZ" D ^DIE,REINDEX^EASEZU2(EASAPP,INDEX) Q
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
I INDEX="FIL" S DR="7.1///^S X=DT;7.2////^S X=DUZ" D ^DIE,REINDEX^EASEZU2(EASAPP,INDEX) Q
I INDEX="CLS" S DR="9.1///^S X=DT;9.2////^S X=DUZ" D ^DIE,REINDEX^EASEZU2(EASAPP,INDEX) Q
Q
;
APPINDEX(EASAPP) ;Check file #712 processing index for Application
;get determining date and remove any index entries no longer current
N CLSDATE,FILDATE,SIGDATE,PRTDATE,REVDATE,NEWDATE
S CLSDATE=$P($G(^EAS(712,EASAPP,2)),U,9) I CLSDATE D REINDEX(EASAPP,"CLS",CLSDATE) Q
S FILDATE=$P($G(^EAS(712,EASAPP,2)),U,5) I FILDATE D REINDEX(EASAPP,"FIL",FILDATE) Q
S SIGDATE=$P($G(^EAS(712,EASAPP,1)),U,1) I SIGDATE D REINDEX(EASAPP,"SIG",SIGDATE) Q
S PRTDATE=$P($G(^EAS(712,EASAPP,2)),U,3) I PRTDATE D REINDEX(EASAPP,"PRT",PRTDATE) Q
S REVDATE=$P($G(^EAS(712,EASAPP,2)),U,1) I REVDATE D REINDEX(EASAPP,"REV",REVDATE) Q
S NEWDATE=$P($G(^EAS(712,EASAPP,0)),U,6) I NEWDATE D REINDEX(EASAPP,"NEW",NEWDATE) Q
Q
;
REINDEX(EASAPP,EASINDEX,THISDATE) ;Remove previous index for Application upon processing status change
;There are 6 critical indexes maintained on file #712 to indicate processing status.
; "NEW" -- New applications; uses field #3, ENTRY DATE
; "REV" -- In Review applications; uses field #5.1, REVIEW DATE
; "PRT" -- Printed/Awaiting Signature applications; uses field #6.1, PRINT DATE
; "SIG" -- Signed applications; uses field #4, DATE SIGNED BY APPLICANT
; "FIL" -- Filed applications; uses field #7.1, FILING DATE
; "CLS" -- Closed/inactivated applications; uses field #9.1, CLOSE DATE
;
;When a date is initially entered into one of the fields listed above, FM updates the
; the index as needed; this function removes the "old" index entry for the application.
;
;Once a date has been entered into one of the fields listed above, repeated actions
; of the same type do not update the field with a new date; therefore, a new index
; entry won't be created.
; For example: The first time the 1010EZ application is Printed for Signature
; field #6.1 is updated and FM creates the index entry in "PRT",
; and this function is called to remove the old "REV" index entry;
; If the 1010EZ is Printed again sometime later, say after it has
; already been Filed, that Print action will not update field #6.1
;
;input
; EASAPP = ien in file #712 for Application
; EASINDEX = index for current processing status
; THISDATE = date to be used to set cross-reference; [optional]
; internal FM format
;output
; none
;
N DATE
;
;set appropriate index if necessary
I $G(THISDATE) S ^EAS(712,EASINDEX,THISDATE,EASAPP)=""
;
I EASINDEX="NEW" D Q
. ;get REVIEW DATE
. S DATE=$P($G(^EAS(712,EASAPP,2)),U,1)
. I DATE K ^EAS(712,"REV",DATE,EASAPP)
. ;get PRINT DATE
. S DATE=$P($G(^EAS(712,EASAPP,2)),U,3)
. I DATE K ^EAS(712,"PRT",DATE,EASAPP)
;
I EASINDEX="REV" D Q
. ;get ENTRY DATE
. S DATE=$P($G(^EAS(712,EASAPP,0)),U,6)
. I DATE K ^EAS(712,"NEW",DATE,EASAPP)
;
I EASINDEX="PRT" D Q
. ;get REVIEW DATE
. S DATE=$P($G(^EAS(712,EASAPP,2)),U,1)
. I DATE K ^EAS(712,"REV",DATE,EASAPP)
;
I EASINDEX="SIG" D Q
. ;get REVIEW DATE
. S DATE=$P($G(^EAS(712,EASAPP,2)),U,1)
. I DATE K ^EAS(712,"REV",DATE,EASAPP)
. ;get PRINT DATE
. S DATE=$P($G(^EAS(712,EASAPP,2)),U,3)
. I DATE K ^EAS(712,"PRT",DATE,EASAPP)
;
I EASINDEX="FIL" D Q
. ;get PRINT DATE
. S DATE=$P($G(^EAS(712,EASAPP,2)),U,3)
. I DATE K ^EAS(712,"PRT",DATE,EASAPP)
. ;get DATE SIGNED BY APPLICANT
. S DATE=$P($G(^EAS(712,EASAPP,1)),U,1)
. I DATE K ^EAS(712,"SIG",DATE,EASAPP)
;
I EASINDEX="CLS" D Q
. ;get ENTRY DATE
. S DATE=$P($G(^EAS(712,EASAPP,0)),U,6)
. I DATE K ^EAS(712,"NEW",DATE,EASAPP)
. ;get REVIEW DATE
. S DATE=$P($G(^EAS(712,EASAPP,2)),U,1)
. I DATE K ^EAS(712,"REV",DATE,EASAPP)
. ;get PRINT DATE
. S DATE=$P($G(^EAS(712,EASAPP,2)),U,3)
. I DATE K ^EAS(712,"PRT",DATE,EASAPP)
;
Q
;
CURRSTAT(EASAPP) ;Check file #712 processing index for Application
;return current Application status
N CLSDATE,FILDATE,SIGDATE,PRTDATE,REVDATE,NEWDATE
S CLSDATE=$P($G(^EAS(712,EASAPP,2)),U,9) I CLSDATE Q "CLS"
S FILDATE=$P($G(^EAS(712,EASAPP,2)),U,5) I FILDATE Q "FIL"
S SIGDATE=$P($G(^EAS(712,EASAPP,1)),U,1) I SIGDATE Q "SIG"
S PRTDATE=$P($G(^EAS(712,EASAPP,2)),U,3) I PRTDATE Q "PRT"
S REVDATE=$P($G(^EAS(712,EASAPP,2)),U,1) I REVDATE Q "REV"
S NEWDATE=$P($G(^EAS(712,EASAPP,0)),U,6) I NEWDATE Q "NEW"
Q ""
;
LOCAL711 ;set up TMP global array
;to hold file #711 & file #712 correlated data; and a useful index
N IEN,DIC,DIE,DA,DR,DLAYGO,DINUM,X,Y,DATANM,DATAKEY,DISPNM,FILE,SUBF,FLD,GRP
;make sure 'unknown' is in #711
K ^TMP("EZDATA",$J),^TMP("EZINDEX",$J)
I '$D(^EAS(711,.1,0)) D
. S DIC="^EAS(711,",DIC(0)="L",DLAYGO="",X="UNKNOWN",DINUM=.1
. K DD,DO D FILE^DICN
I $D(^EAS(711,.1,0)) D
. S DA=.1
. 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"
. D ^DIE
;pick up records from "ACTIVE" index
S IEN=0 F S IEN=$O(^EAS(711,"A","A",IEN)) Q:'IEN D
. 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
. S DATANM=$P($G(^EAS(711,IEN,0)),U,1),DISPNM=$G(^EAS(711,IEN,2))
. S ^TMP("EZDATA",$J,IEN)=X_U_DATAKEY_U_DISPNM
. ;EAS*1.0*70
. S GRP=$S(DATANM["SPOUSE":"S",DATANM["CHILD1":"C1",DATANM["CHILD(N)":"CN",DATANM["ASSET(N)":"CN",1:"A")
. I DATANM["ASSET(N)" S ^TMP("EZINDEX",$J,"C1",FILE,SUBF,FLD,IEN)=IEN_U_DATANM
. S ^TMP("EZINDEX",$J,GRP,FILE,SUBF,FLD,IEN)=IEN_U_DATANM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASEZU2 7894 printed Nov 22, 2024@17:05:21 Page 2
EASEZU2 ;ALB/jap - Utilities for 1010EZ Processing ;10/13/00 10:53
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**53,70**;Mar 15, 2001;Build 26
+2 ;
PICKALL(EASVIEW) ;For processing status selected, pick-up all records in #712
+1 ;Loop through Application Holding file #712 for status selected
+2 NEW APP,FAC,INDEX,JDATE,DAT0,NAME,SSN,VETTYPE,FDAYS,WEBID,WILLSEND,ENTRY,EDATE,X,Y,I,J,T,V,X1,X2,X3
+3 if 'EASVIEW
QUIT
if EASVIEW>6
QUIT
+4 KILL ^TMP($JOB,712,EASVIEW)
+5 ;index to search depends on status selected for viewing
+6 SET V=EASVIEW
SET INDEX=$SELECT(V=1:"NEW",V=2:"REV",V=3:"PRT",V=4:"SIG",V=5:"FIL",V=6:"CLS",1:"")
+7 if V=""
QUIT
if INDEX=""
QUIT
+8 SET I=INDEX
Begin DoDot:1
+9 ;use the index to get each application in selected status
+10 ;here JDATE is the date on which the application reached status of interest
+11 SET JDATE=0
FOR
SET JDATE=$ORDER(^EAS(712,I,JDATE))
if 'JDATE
QUIT
SET APP=0
FOR
SET APP=$ORDER(^EAS(712,I,JDATE,APP))
if 'APP
QUIT
Begin DoDot:2
+12 SET DAT0=$GET(^EAS(712,APP,0))
SET NAME=$PIECE(DAT0,U,4)
SET ENTRY=$PIECE(DAT0,U,6)
SET SSN=$PIECE($PIECE(DAT0,U,5),"&",1)
SET T=$PIECE(DAT0,U,9)
+13 SET WEBID=$PIECE(DAT0,U,2)
SET WILLSEND=$PIECE(DAT0,U,13)
+14 SET FAC=$PIECE($GET(^EAS(712,APP,1)),U,6)
if FAC=""
SET FAC=1
+15 ;don't include filed apps if filed more than 30 days ago.
+16 SET FDAYS=0
IF (INDEX="FIL")!(INDEX="CLS")
SET X2=JDATE
SET X1=DT
DO ^%DTC
SET FDAYS=X
+17 IF FDAYS>30
KILL ^EAS(712,INDEX,JDATE,APP)
+18 if FDAYS>30
QUIT
+19 ;avoid any stub entries
+20 if NAME=""
QUIT
+21 SET Y=ENTRY
SET %F=2
SET EDATE=$$FMTE^XLFDT(Y,%F)
IF $LENGTH(EDATE)<10
Begin DoDot:3
+22 SET X1=$PIECE(EDATE,"/",1)
SET X2=$PIECE(EDATE,"/",2)
SET X3=$PIECE(EDATE,"/",3)
+23 if $LENGTH(X1)=1
SET X1="0"_X1
if $LENGTH(X2)=1
SET X2="0"_X2
+24 SET EDATE=X1_"/"_X2_"/"_X3
End DoDot:3
+25 SET VETTYPE=$SELECT(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:"")
+26 SET ^TMP($JOB,712,EASVIEW,FAC,NAME,ENTRY,APP)=APP_U_SSN_U_VETTYPE_U_EDATE_U_JDATE_U_WEBID_U_WILLSEND_U_FAC
End DoDot:2
End DoDot:1
+27 QUIT
+28 ;
SETDATE(EASAPP,INDEX) ;update fields & indexes associated with processing status
+1 ;
+2 NEW DA,DR,DIE
+3 SET DA=EASAPP
SET DIE="^EAS(712,"
+4 IF INDEX="REV"
SET DR="5.1///^S X=DT;5.2////^S X=DUZ"
DO ^DIE
DO REINDEX^EASEZU2(EASAPP,INDEX)
QUIT
+5 IF INDEX="PRT"
SET DR="6.1///^S X=DT;6.2////^S X=DUZ"
DO ^DIE
DO REINDEX^EASEZU2(EASAPP,INDEX)
QUIT
+6 IF INDEX="SIG"
SET DR="4///^S X=DT;4.1///^S X=DT;4.2////^S X=DUZ"
DO ^DIE
DO REINDEX^EASEZU2(EASAPP,INDEX)
QUIT
+7 IF INDEX="FIL"
SET DR="7.1///^S X=DT;7.2////^S X=DUZ"
DO ^DIE
DO REINDEX^EASEZU2(EASAPP,INDEX)
QUIT
+8 IF INDEX="CLS"
SET DR="9.1///^S X=DT;9.2////^S X=DUZ"
DO ^DIE
DO REINDEX^EASEZU2(EASAPP,INDEX)
QUIT
+9 QUIT
+10 ;
APPINDEX(EASAPP) ;Check file #712 processing index for Application
+1 ;get determining date and remove any index entries no longer current
+2 NEW CLSDATE,FILDATE,SIGDATE,PRTDATE,REVDATE,NEWDATE
+3 SET CLSDATE=$PIECE($GET(^EAS(712,EASAPP,2)),U,9)
IF CLSDATE
DO REINDEX(EASAPP,"CLS",CLSDATE)
QUIT
+4 SET FILDATE=$PIECE($GET(^EAS(712,EASAPP,2)),U,5)
IF FILDATE
DO REINDEX(EASAPP,"FIL",FILDATE)
QUIT
+5 SET SIGDATE=$PIECE($GET(^EAS(712,EASAPP,1)),U,1)
IF SIGDATE
DO REINDEX(EASAPP,"SIG",SIGDATE)
QUIT
+6 SET PRTDATE=$PIECE($GET(^EAS(712,EASAPP,2)),U,3)
IF PRTDATE
DO REINDEX(EASAPP,"PRT",PRTDATE)
QUIT
+7 SET REVDATE=$PIECE($GET(^EAS(712,EASAPP,2)),U,1)
IF REVDATE
DO REINDEX(EASAPP,"REV",REVDATE)
QUIT
+8 SET NEWDATE=$PIECE($GET(^EAS(712,EASAPP,0)),U,6)
IF NEWDATE
DO REINDEX(EASAPP,"NEW",NEWDATE)
QUIT
+9 QUIT
+10 ;
REINDEX(EASAPP,EASINDEX,THISDATE) ;Remove previous index for Application upon processing status change
+1 ;There are 6 critical indexes maintained on file #712 to indicate processing status.
+2 ; "NEW" -- New applications; uses field #3, ENTRY DATE
+3 ; "REV" -- In Review applications; uses field #5.1, REVIEW DATE
+4 ; "PRT" -- Printed/Awaiting Signature applications; uses field #6.1, PRINT DATE
+5 ; "SIG" -- Signed applications; uses field #4, DATE SIGNED BY APPLICANT
+6 ; "FIL" -- Filed applications; uses field #7.1, FILING DATE
+7 ; "CLS" -- Closed/inactivated applications; uses field #9.1, CLOSE DATE
+8 ;
+9 ;When a date is initially entered into one of the fields listed above, FM updates the
+10 ; the index as needed; this function removes the "old" index entry for the application.
+11 ;
+12 ;Once a date has been entered into one of the fields listed above, repeated actions
+13 ; of the same type do not update the field with a new date; therefore, a new index
+14 ; entry won't be created.
+15 ; For example: The first time the 1010EZ application is Printed for Signature
+16 ; field #6.1 is updated and FM creates the index entry in "PRT",
+17 ; and this function is called to remove the old "REV" index entry;
+18 ; If the 1010EZ is Printed again sometime later, say after it has
+19 ; already been Filed, that Print action will not update field #6.1
+20 ;
+21 ;input
+22 ; EASAPP = ien in file #712 for Application
+23 ; EASINDEX = index for current processing status
+24 ; THISDATE = date to be used to set cross-reference; [optional]
+25 ; internal FM format
+26 ;output
+27 ; none
+28 ;
+29 NEW DATE
+30 ;
+31 ;set appropriate index if necessary
+32 IF $GET(THISDATE)
SET ^EAS(712,EASINDEX,THISDATE,EASAPP)=""
+33 ;
+34 IF EASINDEX="NEW"
Begin DoDot:1
+35 ;get REVIEW DATE
+36 SET DATE=$PIECE($GET(^EAS(712,EASAPP,2)),U,1)
+37 IF DATE
KILL ^EAS(712,"REV",DATE,EASAPP)
+38 ;get PRINT DATE
+39 SET DATE=$PIECE($GET(^EAS(712,EASAPP,2)),U,3)
+40 IF DATE
KILL ^EAS(712,"PRT",DATE,EASAPP)
End DoDot:1
QUIT
+41 ;
+42 IF EASINDEX="REV"
Begin DoDot:1
+43 ;get ENTRY DATE
+44 SET DATE=$PIECE($GET(^EAS(712,EASAPP,0)),U,6)
+45 IF DATE
KILL ^EAS(712,"NEW",DATE,EASAPP)
End DoDot:1
QUIT
+46 ;
+47 IF EASINDEX="PRT"
Begin DoDot:1
+48 ;get REVIEW DATE
+49 SET DATE=$PIECE($GET(^EAS(712,EASAPP,2)),U,1)
+50 IF DATE
KILL ^EAS(712,"REV",DATE,EASAPP)
End DoDot:1
QUIT
+51 ;
+52 IF EASINDEX="SIG"
Begin DoDot:1
+53 ;get REVIEW DATE
+54 SET DATE=$PIECE($GET(^EAS(712,EASAPP,2)),U,1)
+55 IF DATE
KILL ^EAS(712,"REV",DATE,EASAPP)
+56 ;get PRINT DATE
+57 SET DATE=$PIECE($GET(^EAS(712,EASAPP,2)),U,3)
+58 IF DATE
KILL ^EAS(712,"PRT",DATE,EASAPP)
End DoDot:1
QUIT
+59 ;
+60 IF EASINDEX="FIL"
Begin DoDot:1
+61 ;get PRINT DATE
+62 SET DATE=$PIECE($GET(^EAS(712,EASAPP,2)),U,3)
+63 IF DATE
KILL ^EAS(712,"PRT",DATE,EASAPP)
+64 ;get DATE SIGNED BY APPLICANT
+65 SET DATE=$PIECE($GET(^EAS(712,EASAPP,1)),U,1)
+66 IF DATE
KILL ^EAS(712,"SIG",DATE,EASAPP)
End DoDot:1
QUIT
+67 ;
+68 IF EASINDEX="CLS"
Begin DoDot:1
+69 ;get ENTRY DATE
+70 SET DATE=$PIECE($GET(^EAS(712,EASAPP,0)),U,6)
+71 IF DATE
KILL ^EAS(712,"NEW",DATE,EASAPP)
+72 ;get REVIEW DATE
+73 SET DATE=$PIECE($GET(^EAS(712,EASAPP,2)),U,1)
+74 IF DATE
KILL ^EAS(712,"REV",DATE,EASAPP)
+75 ;get PRINT DATE
+76 SET DATE=$PIECE($GET(^EAS(712,EASAPP,2)),U,3)
+77 IF DATE
KILL ^EAS(712,"PRT",DATE,EASAPP)
End DoDot:1
QUIT
+78 ;
+79 QUIT
+80 ;
CURRSTAT(EASAPP) ;Check file #712 processing index for Application
+1 ;return current Application status
+2 NEW CLSDATE,FILDATE,SIGDATE,PRTDATE,REVDATE,NEWDATE
+3 SET CLSDATE=$PIECE($GET(^EAS(712,EASAPP,2)),U,9)
IF CLSDATE
QUIT "CLS"
+4 SET FILDATE=$PIECE($GET(^EAS(712,EASAPP,2)),U,5)
IF FILDATE
QUIT "FIL"
+5 SET SIGDATE=$PIECE($GET(^EAS(712,EASAPP,1)),U,1)
IF SIGDATE
QUIT "SIG"
+6 SET PRTDATE=$PIECE($GET(^EAS(712,EASAPP,2)),U,3)
IF PRTDATE
QUIT "PRT"
+7 SET REVDATE=$PIECE($GET(^EAS(712,EASAPP,2)),U,1)
IF REVDATE
QUIT "REV"
+8 SET NEWDATE=$PIECE($GET(^EAS(712,EASAPP,0)),U,6)
IF NEWDATE
QUIT "NEW"
+9 QUIT ""
+10 ;
LOCAL711 ;set up TMP global array
+1 ;to hold file #711 & file #712 correlated data; and a useful index
+2 NEW IEN,DIC,DIE,DA,DR,DLAYGO,DINUM,X,Y,DATANM,DATAKEY,DISPNM,FILE,SUBF,FLD,GRP
+3 ;make sure 'unknown' is in #711
+4 KILL ^TMP("EZDATA",$JOB),^TMP("EZINDEX",$JOB)
+5 IF '$DATA(^EAS(711,.1,0))
Begin DoDot:1
+6 SET DIC="^EAS(711,"
SET DIC(0)="L"
SET DLAYGO=""
SET X="UNKNOWN"
SET DINUM=.1
+7 KILL DD,DO
DO FILE^DICN
End DoDot:1
+8 IF $DATA(^EAS(711,.1,0))
Begin DoDot:1
+9 SET DA=.1
+10 SET DIE="^EAS(711,"
SET DR=".1///^S X=""UNKNOWN"";1///^S X=""A"";2///^S X=0;3///^S X=0;4///^S X=0"
+11 DO ^DIE
End DoDot:1
+12 ;pick up records from "ACTIVE" index
+13 SET IEN=0
FOR
SET IEN=$ORDER(^EAS(711,"A","A",IEN))
if 'IEN
QUIT
Begin DoDot:1
+14 SET DATAKEY=$PIECE(^EAS(711,IEN,0),U,2)
SET X=$GET(^EAS(711,IEN,1))
SET FILE=$PIECE(X,U,1)
SET SUBF=$PIECE(X,U,2)
SET FLD=$PIECE(X,U,3)
if SUBF=""
SET SUBF=FILE
+15 SET DATANM=$PIECE($GET(^EAS(711,IEN,0)),U,1)
SET DISPNM=$GET(^EAS(711,IEN,2))
+16 SET ^TMP("EZDATA",$JOB,IEN)=X_U_DATAKEY_U_DISPNM
+17 ;EAS*1.0*70
+18 SET GRP=$SELECT(DATANM["SPOUSE":"S",DATANM["CHILD1":"C1",DATANM["CHILD(N)":"CN",DATANM["ASSET(N)":"CN",1:"A")
+19 IF DATANM["ASSET(N)"
SET ^TMP("EZINDEX",$JOB,"C1",FILE,SUBF,FLD,IEN)=IEN_U_DATANM
+20 SET ^TMP("EZINDEX",$JOB,GRP,FILE,SUBF,FLD,IEN)=IEN_U_DATANM
End DoDot:1
+21 QUIT
