- EASEZF1 ;ALB/jap,TM - Filing 1010EZ Data to Patient Database ; 8/16/11 4:04pm
- ;;1.0;ENROLLMENT APPLICATION SYSTEM;**1,51,57,62,70,93,92**;Mar 15, 2001;Build 20
- ;
- F2(EASAPP,EASDFN) ;file to Patient record in #2
- ;input EASDFN = ien to #2
- N KEYIEN,FILE,SUBFILE,FLD,DATAKEY,MULTIPLE,SECT,QUES,SUBIEN,ACCEPT,EZDATA,PTDATA,LINK,EROOT,EAS,ERR,IENS,ARRAY,ELIGVER
- N DIC,DIQ,DA,DR,X,Y,EZSTRG
- Q:'$G(EASDFN)
- ;L +^DPT(EASDFN) ;Handling locking in EASEZFM - EAS*1*93
- I '$G(EASVRSN) S EASVRSN=$$VERSION^EASEZU4(EASAPP)
- ;EAS*1.0*70 - Special handling for Foreign Address
- S KEYIEN=+$$KEY711^EASEZU1("APPLICANT COUNTRY")
- S DATAKEY=$P(^TMP("EZDATA",$J,KEYIEN),U,4)
- S SECT=$P(DATAKEY,";"),QUES=$P(DATAKEY,";",2)
- S EZDATA=$P($G(^TMP("EZTEMP",$J,SECT,1,QUES)),U,2)
- I EZDATA="UNITED STATES" S EZSTRG="APPLICANT PROVINCE^APPLICANT POSTAL CODE"
- E S EZSTRG="APPLICANT COUNTY^APPLICANT STATE^APPLICANT ZIP"
- F X=1:1 S DATANM=$P(EZSTRG,U,X) Q:DATANM="" D
- . S KEYIEN=+$$KEY711^EASEZU1(DATANM) Q:(KEYIEN=.1)
- . S DATAKEY=$P(^TMP("EZDATA",$J,KEYIEN),U,4)
- . S SECT=$P(DATAKEY,";"),QUES=$P(DATAKEY,";",2)
- . K ^TMP("EZDATA",$J,KEYIEN),^TMP("EZTEMP",$J,SECT,1,QUES)
- ;
- S KEYIEN=0
- F S KEYIEN=$O(^TMP("EZDATA",$J,KEYIEN)) Q:'KEYIEN D
- . S LN=^TMP("EZDATA",$J,KEYIEN),FILE=$P(LN,U,1)
- . Q:FILE'=2
- . S SUBFILE=$P(LN,U,2),FLD=$P(LN,U,3),DATAKEY=$P(LN,U,4)
- . S SECT=$P(DATAKEY,";",1),QUES=$P(DATAKEY,";",2)
- . ;call to suppress may be redundant
- . Q:$$SUPPRESS^EASEZU4(EASAPP,DATAKEY,1,EASVRSN)
- . ;in file #2, multiple is always 1
- . S MULTIPLE=1
- . Q:'$D(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1))
- . S X=$G(^TMP("EZTEMP",$J,SECT,MULTIPLE,QUES))
- . Q:$P(X,U,1)'=KEYIEN
- . S EZDATA=$P(X,U,2),ACCEPT=$P(X,U,3),SUBIEN=$P(X,U,4),PTDATA=$P(X,U,5)
- . Q:EZDATA=""
- . Q:'SUBIEN
- . ;special handling for Designee
- . I FLD=.3405 S EZDATA=$S(EZDATA="NEXT OF KIN":"YES",1:"NO")
- . ;strip off code display from county
- . I SECT="I",QUES="9E." S EZDATA=$P(EZDATA," (",1)
- . ;get file #2 ien; always same as EASDFN
- . S LINK=EASDFN
- . ;don't continue if data item not accepted
- . Q:ACCEPT<1
- . ;process subfile data elsewhere
- . I SUBFILE=2.01 Q
- . I SUBFILE=2.101 Q
- . I SUBFILE=2.02 D F202^EASEZF1(SUBFILE,DATAKEY,EZDATA,SUBIEN,KEYIEN) Q
- . I SUBFILE=2.06 D F206^EASEZF1(SUBFILE,DATAKEY,EZDATA,SUBIEN) Q
- . ;Special for Military Service Episodes
- . I SUBFILE=2.3216 D:KEYIEN=28 Q
- . . D F23216(SUBFILE,DATAKEY,EZDATA,SUBIEN,KEYIEN)
- . ;special conversion to file data to field #.328
- . I FLD=.328 D
- . . S X=$$UC^EASEZT1(EZDATA) I X="SSN" D
- . . . ;allow SSN as Service Number only if field #.328 in patient record is null;
- . . . S PTSSN=$$GETANY^EASEZU1(EASAPP,EASDFN,SUBIEN)
- . . . I PTSSN="" S EZDATA="SS" Q
- . . . ;otherwise Applicant SSN must match Patient SSN
- . . . S KK=$$KEY711^EASEZU1("APPLICANT SOCIAL SECURITY NUMBER")
- . . . S EZSSN=$P($G(^TMP("EZDATA",$J,KK,1,1)),U,1),EZSSN=$TR(EZSSN,"-","")
- . . . I EZSSN=PTSSN S EZDATA="SS" Q
- . . . S EZDATA="ssn"
- . . K KK,PTSSN,EZSSN
- . ;special for fields #.092 & #.093
- . I FILE=2,((FLD=.092)!(FLD=.093)) D FPOB(DATAKEY,EZDATA,SUBIEN,PTDATA) Q
- . ;don't need these lines after 672
- . ;special for field #.362
- . ;I FILE=2,FLD=.362,EASVRSN>5.99 I (EZDATA="Y")!(EZDATA="YES") S EZDATA="YES, RECEIVING MILITARY RETIREMENT IN LIEU OF VA COMPENSATION"
- . Q:EZDATA=PTDATA
- . ;repeat check for verified eligibility;
- . ;do not file certain fields if eligibility verified
- . K ARRAY
- . S DA=EASDFN,DIC="^DPT(",DR=".3611;.3613",DIQ(0)="I",DIQ="ARRAY"
- . D EN^DIQ1 K DA,DIC,DIQ,DR
- . I $G(ARRAY(2,EASDFN,.3611,"I"))="V",$G(ARRAY(2,EASDFN,.3613,"I"))="H" S ELIGVER=1
- . I FLD=.313,$G(ARRAY(2,EASDFN,.3611,"I"))="V" Q
- . I $G(ELIGVER),((FLD=.301)!(FLD=.302)!(FLD=.36235)) Q
- . ;special for field #.32102 - Agent Orange Exposure . DATAKEY = I;14F
- . I FLD=.32102 D F32102^EASEZF1A(EASAPP,EASDFN,EZDATA)
- . ;setup to call FM database server using EASDFN as file #2 record
- . K EAS,ERR
- . S IENS=EASDFN_","
- . S EROOT="EAS("_EASAPP_")"
- . D VAL^DIE(2,IENS,FLD,"F",EZDATA,,EROOT,"ERR")
- . ;try to resolve possible invalid input for free text fields due to length
- . I $D(ERR) D RESOLVE
- . I $D(ERR) D ERROR^EASEZF2("AP",MULTIPLE,.ERR,"LINK")
- . ;file to database if input is valid
- . I '$D(ERR) D
- . . ;2/1/2001 - don't attempt to file Name, SSN, DOB; too many complications;
- . . ; example: if system assigns pseudo-SSN to new patient, user could overwrite;
- . . ; example: if applicant matched to existing patient, all critical identifying
- . . ; data could be overwritten; could impact HEC as well
- . . D FILE^DIE("S",EROOT,"ERR")
- . . ;set any replaced data into subfile #712.01 for audit
- . . S ^EAS(712,EASAPP,10,SUBIEN,2)=PTDATA_U_LINK
- ;
- ;L -^DPT(EASDFN) ;Handling locking in EASEZFM - EAS*1*93
- Q
- ;
- RESOLVE ;try to resolve invalid input for free text fields only
- ;see if mapped to free text field
- N FDEF,FTYPE,MAX
- I (SUBFILE=FILE)!(SUBFILE="") S FDEF=FILE
- E S FDEF=SUBFILE
- S FTYPE=$$GET1^DID(FDEF,FLD,"","TYPE")
- Q:FTYPE'="FREE TEXT"
- S MAX=$$GET1^DID(FDEF,FLD,"","FIELD LENGTH")
- S EZDATA=$E(EZDATA,1,MAX)
- K ERR
- D VAL^DIE(2,IENS,FLD,"F",EZDATA,,EROOT,"ERR")
- ;if still sets ERR array then won't be filed to database
- Q
- ;
- F202(SUBFILE,DATAKEY,EZDATA,SUBIEN,KEYIEN) ;add or edit subrecord in subfile #2.02
- ;input SUBFILE = 2.02
- ; DATAKEY = data item identifier, e.g., I;4B.
- ; EZDATA = in these cases, either "N(o)" or "Y(es)"
- ; SUBIEN = subrecord # for data in #712/#10
- ; KEYIEN = record # for data element in #711
- N X,N,DATANM,EROOT,EAS,EIEN,ERR,FLD,IENS,EASARRAY,LINK,OUT,K1,K3
- Q:EZDATA'["Y"
- Q:SUBFILE'=2.02
- ;covert data to corresponding file #10 pointer
- S X=$$KEY711^EASEZU1(DATAKEY)
- S K1=$P(X,U,1),DATANM=$P(X,U,2),K3=$P(X,U,3)
- Q:(DATANM="")
- Q:(K1'=KEYIEN)
- Q:(K3'=DATAKEY)
- S DATANM=$P(DATANM," - ",2),DATANM=$E(DATANM,1,30)
- I DATANM["UNANSWERED" S DATANM="UNKNOWN BY PATIENT"
- S EZDATA=$O(^DIC(10,"B",DATANM,0))
- Q:EZDATA=""
- D I202^EASEZI(EASDFN,.EASARRAY)
- ;if matching race already exists, edit method only
- S OUT=0,N=0 F S N=$O(EASARRAY(N)) Q:'N D
- . Q:($P(EASARRAY(N),";",2)'=EZDATA)
- . K EAS,ERR
- . S IENS=EZDATA_","_EASDFN_","
- . S EROOT="EAS("_EASAPP_")"
- . S FLD=.02,EAS(EASAPP,SUBFILE,IENS,FLD)=1
- . D FILE^DIE("S",EROOT,"ERR")
- . S OUT=1
- ;no matching race in patient record, add new subrecord
- I 'OUT D
- . K ERR
- . S EROOT="EAS("_EASAPP_")"
- . S IENS="+1,"_EASDFN_",",EIEN(1)=EZDATA
- . S FLD=.01,EAS(EASAPP,SUBFILE,IENS,FLD)=EZDATA
- . S FLD=.02,EAS(EASAPP,SUBFILE,IENS,FLD)=1
- . D UPDATE^DIE("S",EROOT,"EIEN","ERR")
- . I $D(ERR) D ERROR^EASEZF2("AP",1,.ERR,"LINK") Q
- . S LINK=EASDFN_";"_EZDATA
- . S ^EAS(712,EASAPP,10,SUBIEN,2)=U_LINK
- Q
- ;
- F206(SUBFILE,DATAKEY,EZDATA,SUBIEN) ;add subrecord in subfile #2.06
- ;input SUBFILE = 2.06
- ; DATAKEY = data item identifier, e.g., I;4A.
- ; EZDATA = in these cases, either "N(o)" or "Y(es)"
- N X,EROOT,EAS,EIEN,ERR,FLD,EASARRAY,IENS,LINK,PTDATA
- Q:SUBFILE'=2.06
- D I206^EASEZI(EASDFN,.EASARRAY)
- S LINK=$P($G(EASARRAY(1)),";",2),PTDATA="" I LINK S PTDATA=$P(^DPT(EASDFN,.06,LINK,0),U,1)
- I DATAKEY="I;4A." S EZDATA=$S(EZDATA["Y":"H",$E(EZDATA,1)="N":"N",1:"U") D
- . S EROOT="EAS("_EASAPP_")"
- . S IENS="+1,"_EASDFN_","
- . S FLD=.01,EAS(EASAPP,SUBFILE,IENS,FLD)=EZDATA
- . S FLD=.02,EAS(EASAPP,SUBFILE,IENS,FLD)="SELF IDENTIFICATION"
- . D UPDATE^DIE("ES",EROOT,"EIEN","ERR")
- . S LINK=EASDFN_";"_$G(EIEN(1))
- . S ^EAS(712,EASAPP,10,SUBIEN,2)=PTDATA_U_LINK
- Q
- ;
- FPOB(DATAKEY,EZDATA,SUBIEN,PTDATA) ;add or edit pob city & state
- ;input DATAKEY = data item identifier, either, I;8A. or I;8B.
- ; EZDATA = free text if city or
- ; state abbrv if state
- ;filing for both city & state only done when datakey=I;8A.
- N X,EROOT,EAS,EIEN,ERR,FLD,EASARRAY,IENS,LINK,SECT,QUES,XIEN,XDATA
- Q:(DATAKEY'="I;8A.")
- Q:(EZDATA="")
- Q:(EZDATA=PTDATA)
- ;file pob city
- K EAS,ERR
- S FLD=.092,LINK=EASDFN
- S IENS=EASDFN_","
- S EROOT="EAS("_EASAPP_")"
- D VAL^DIE(2,IENS,FLD,"F",EZDATA,,EROOT,"ERR")
- I $D(ERR) D RESOLVE
- I $D(ERR) D ERROR^EASEZF2("AP",1,.ERR,"LINK") Q
- D FILE^DIE("ES",EROOT,"ERR")
- ;set any replaced data into subfile #712.01 for audit
- S ^EAS(712,EASAPP,10,SUBIEN,2)=PTDATA_U_LINK
- ;file pob state
- S (EZDATA,XDATA)=""
- S DATAKEY="I;8B.",SECT=$P(DATAKEY,";",1),QUES=$P(DATAKEY,";",2)
- S X=$G(^TMP("EZTEMP",$J,SECT,1,QUES)),EZDATA=$P(X,U,2),XIEN=$P(X,U,4),XDATA=$P(X,U,5)
- Q:(EZDATA="")
- Q:(EZDATA=XDATA)
- I (EZDATA["FOREIGN")!(EZDATA="FC")!(EZDATA="FG") S EZDATA="FOREIGN"
- K EAS,ERR
- S FLD=.093
- S IENS=EASDFN_","
- S EROOT="EAS("_EASAPP_")"
- D VAL^DIE(2,IENS,FLD,"F",EZDATA,,EROOT,"ERR")
- I $D(ERR) D ERROR^EASEZF2("AP",1,.ERR,"LINK") Q
- D FILE^DIE("ES",EROOT,"ERR")
- S ^EAS(712,EASAPP,10,XIEN,2)=XDATA_U_LINK
- Q
- ;
- F23216(SUBFILE,DATAKEY,EZDATA,SUBIEN,KEYIEN) ;add subrecord in subfile #2.3216
- ;input SUBFILE = 2.3216
- ; DATAKEY = data item identifier, e.g., I;13A.
- ; EZDATA = data value in external format
- ; KEYIEN = record # for data element in #711
- ;
- ;Values for KEYIEN DATAKEY
- ; 28 - Branch of Service I;13A
- ; 29 - Last Entry Date I;13B
- ; 30 - Last Separation Date I;13C
- ; 31 - Last Discharge Type I;13D
- ; 32 - Last Service Number I;13E
- ;
- Q:SUBFILE'=2.3216
- ;
- N X,EAS,EASARRAY,LINK,PTDATA,SUBIEN
- ;Get episodes from VistA into EASARRAY
- D GETMSE^DGMSEUTL(EASDFN,.EASARRAY)
- ;Move last VistA episode into PDATA (for future use in edit option)
- S LINK=$G(EASARRAY(1,"IEN")),PTDATA=""
- I LINK S PTDATA=$G(^DPT(EASDFN,2.3216,LINK,0))
- ;
- ;Only proceed to add new subrecord if no .3216 data exists
- Q:PTDATA'=""
- ;
- TBD1 ;if this is entirely new and later than VistA episodes, allow add?
- ;
- ; (compare EDATE to last episode in PDATA and allow addition if it is; a date later than last separation date)
- ;
- TBD2 ;if matching episode already exists, allow update?
- ;
- ; (see code in F202^EASEZF1 for update, get last IENS from EASARRAY)
- ;
- ;Get last episode 1010EZ fields from ^TMP("EZDATA"
- N BOS,EDATE,SDATE,DTYPE,SERVNO
- S BOS=$P($G(^TMP("EZDATA",$J,28,1,1)),U) Q:BOS=""
- S EDATE=$P($G(^TMP("EZDATA",$J,29,1,1)),U) Q:EDATE=""
- S SDATE=$P($G(^TMP("EZDATA",$J,30,1,1)),U) Q:SDATE=""
- S DTYPE=$P($G(^TMP("EZDATA",$J,31,1,1)),U) Q:DTYPE=""
- S SERVNO=$P($G(^TMP("EZDATA",$J,32,1,1)),U)
- ;
- ;Special conversion of service number (see code in EASEZF1)
- I $$UC^EASEZT1(SERVNO)="SSN" D
- .N EZSSN,KK,PTSSN
- .;allow SSN as Service Number if service number in patient last
- .;.3216 record is null. Always case if no .3216 data exists
- .S PTSSN=$P(PTDATA,U,5)
- .I PTSSN="" S SERVNO="SS" Q
- .;alternatively Applicant SSN must match service number
- .S KK=$$KEY711^EASEZU1("APPLICANT SOCIAL SECURITY NUMBER")
- .S EZSSN=$P($G(^TMP("EZDATA",$J,KK,1,1)),U,1)
- .S EZSSN=$TR(EZSSN,"-","")
- .I EZSSN=PTSSN S SERVNO="SS" Q
- .S SERVNO="ssn"
- ;
- ;File 1010EZ data to .3216
- N X,Y,EROOT,ERR,FLD,IENS,EIEN
- S EROOT="EAS("_EASAPP_")"
- S IENS="+1,"_EASDFN_","
- S FLD=.01,EAS(EASAPP,SUBFILE,IENS,FLD)=EDATE
- S FLD=.02,EAS(EASAPP,SUBFILE,IENS,FLD)=SDATE
- S FLD=.03,EAS(EASAPP,SUBFILE,IENS,FLD)=BOS
- S FLD=.05,EAS(EASAPP,SUBFILE,IENS,FLD)=SERVNO
- S FLD=.06,EAS(EASAPP,SUBFILE,IENS,FLD)=DTYPE
- D UPDATE^DIE("ES",EROOT,"EIEN","ERR")
- I $D(ERR) D ERROR^EASEZF2("AP",1,.ERR,"LINK") Q
- ;
- S SUBIEN=$O(^EAS(712,EASAPP,10,"B",28,""))
- S:SUBIEN ^EAS(712,EASAPP,10,SUBIEN,2)=U_EASDFN_";"_$G(EIEN(1))
- S SUBIEN=$O(^EAS(712,EASAPP,10,"B",29,""))
- S:SUBIEN ^EAS(712,EASAPP,10,SUBIEN,2)=U_EASDFN_";"_$G(EIEN(1))
- S SUBIEN=$O(^EAS(712,EASAPP,10,"B",30,""))
- S:SUBIEN ^EAS(712,EASAPP,10,SUBIEN,2)=U_EASDFN_";"_$G(EIEN(1))
- S SUBIEN=$O(^EAS(712,EASAPP,10,"B",31,""))
- S:SUBIEN ^EAS(712,EASAPP,10,SUBIEN,2)=U_EASDFN_";"_$G(EIEN(1))
- S SUBIEN=$O(^EAS(712,EASAPP,10,"B",32,""))
- S:SUBIEN ^EAS(712,EASAPP,10,SUBIEN,2)=U_EASDFN_";"_$G(EIEN(1))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASEZF1 12072 printed Feb 18, 2025@23:20:53 Page 2
- EASEZF1 ;ALB/jap,TM - Filing 1010EZ Data to Patient Database ; 8/16/11 4:04pm
- +1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**1,51,57,62,70,93,92**;Mar 15, 2001;Build 20
- +2 ;
- F2(EASAPP,EASDFN) ;file to Patient record in #2
- +1 ;input EASDFN = ien to #2
- +2 NEW KEYIEN,FILE,SUBFILE,FLD,DATAKEY,MULTIPLE,SECT,QUES,SUBIEN,ACCEPT,EZDATA,PTDATA,LINK,EROOT,EAS,ERR,IENS,ARRAY,ELIGVER
- +3 NEW DIC,DIQ,DA,DR,X,Y,EZSTRG
- +4 if '$GET(EASDFN)
- QUIT
- +5 ;L +^DPT(EASDFN) ;Handling locking in EASEZFM - EAS*1*93
- +6 IF '$GET(EASVRSN)
- SET EASVRSN=$$VERSION^EASEZU4(EASAPP)
- +7 ;EAS*1.0*70 - Special handling for Foreign Address
- +8 SET KEYIEN=+$$KEY711^EASEZU1("APPLICANT COUNTRY")
- +9 SET DATAKEY=$PIECE(^TMP("EZDATA",$JOB,KEYIEN),U,4)
- +10 SET SECT=$PIECE(DATAKEY,";")
- SET QUES=$PIECE(DATAKEY,";",2)
- +11 SET EZDATA=$PIECE($GET(^TMP("EZTEMP",$JOB,SECT,1,QUES)),U,2)
- +12 IF EZDATA="UNITED STATES"
- SET EZSTRG="APPLICANT PROVINCE^APPLICANT POSTAL CODE"
- +13 IF '$TEST
- SET EZSTRG="APPLICANT COUNTY^APPLICANT STATE^APPLICANT ZIP"
- +14 FOR X=1:1
- SET DATANM=$PIECE(EZSTRG,U,X)
- if DATANM=""
- QUIT
- Begin DoDot:1
- +15 SET KEYIEN=+$$KEY711^EASEZU1(DATANM)
- if (KEYIEN=.1)
- QUIT
- +16 SET DATAKEY=$PIECE(^TMP("EZDATA",$JOB,KEYIEN),U,4)
- +17 SET SECT=$PIECE(DATAKEY,";")
- SET QUES=$PIECE(DATAKEY,";",2)
- +18 KILL ^TMP("EZDATA",$JOB,KEYIEN),^TMP("EZTEMP",$JOB,SECT,1,QUES)
- End DoDot:1
- +19 ;
- +20 SET KEYIEN=0
- +21 FOR
- SET KEYIEN=$ORDER(^TMP("EZDATA",$JOB,KEYIEN))
- if 'KEYIEN
- QUIT
- Begin DoDot:1
- +22 SET LN=^TMP("EZDATA",$JOB,KEYIEN)
- SET FILE=$PIECE(LN,U,1)
- +23 if FILE'=2
- QUIT
- +24 SET SUBFILE=$PIECE(LN,U,2)
- SET FLD=$PIECE(LN,U,3)
- SET DATAKEY=$PIECE(LN,U,4)
- +25 SET SECT=$PIECE(DATAKEY,";",1)
- SET QUES=$PIECE(DATAKEY,";",2)
- +26 ;call to suppress may be redundant
- +27 if $$SUPPRESS^EASEZU4(EASAPP,DATAKEY,1,EASVRSN)
- QUIT
- +28 ;in file #2, multiple is always 1
- +29 SET MULTIPLE=1
- +30 if '$DATA(^TMP("EZDATA",$JOB,KEYIEN,MULTIPLE,1))
- QUIT
- +31 SET X=$GET(^TMP("EZTEMP",$JOB,SECT,MULTIPLE,QUES))
- +32 if $PIECE(X,U,1)'=KEYIEN
- QUIT
- +33 SET EZDATA=$PIECE(X,U,2)
- SET ACCEPT=$PIECE(X,U,3)
- SET SUBIEN=$PIECE(X,U,4)
- SET PTDATA=$PIECE(X,U,5)
- +34 if EZDATA=""
- QUIT
- +35 if 'SUBIEN
- QUIT
- +36 ;special handling for Designee
- +37 IF FLD=.3405
- SET EZDATA=$SELECT(EZDATA="NEXT OF KIN":"YES",1:"NO")
- +38 ;strip off code display from county
- +39 IF SECT="I"
- IF QUES="9E."
- SET EZDATA=$PIECE(EZDATA," (",1)
- +40 ;get file #2 ien; always same as EASDFN
- +41 SET LINK=EASDFN
- +42 ;don't continue if data item not accepted
- +43 if ACCEPT<1
- QUIT
- +44 ;process subfile data elsewhere
- +45 IF SUBFILE=2.01
- QUIT
- +46 IF SUBFILE=2.101
- QUIT
- +47 IF SUBFILE=2.02
- DO F202^EASEZF1(SUBFILE,DATAKEY,EZDATA,SUBIEN,KEYIEN)
- QUIT
- +48 IF SUBFILE=2.06
- DO F206^EASEZF1(SUBFILE,DATAKEY,EZDATA,SUBIEN)
- QUIT
- +49 ;Special for Military Service Episodes
- +50 IF SUBFILE=2.3216
- if KEYIEN=28
- Begin DoDot:2
- +51 DO F23216(SUBFILE,DATAKEY,EZDATA,SUBIEN,KEYIEN)
- End DoDot:2
- QUIT
- +52 ;special conversion to file data to field #.328
- +53 IF FLD=.328
- Begin DoDot:2
- +54 SET X=$$UC^EASEZT1(EZDATA)
- IF X="SSN"
- Begin DoDot:3
- +55 ;allow SSN as Service Number only if field #.328 in patient record is null;
- +56 SET PTSSN=$$GETANY^EASEZU1(EASAPP,EASDFN,SUBIEN)
- +57 IF PTSSN=""
- SET EZDATA="SS"
- QUIT
- +58 ;otherwise Applicant SSN must match Patient SSN
- +59 SET KK=$$KEY711^EASEZU1("APPLICANT SOCIAL SECURITY NUMBER")
- +60 SET EZSSN=$PIECE($GET(^TMP("EZDATA",$JOB,KK,1,1)),U,1)
- SET EZSSN=$TRANSLATE(EZSSN,"-","")
- +61 IF EZSSN=PTSSN
- SET EZDATA="SS"
- QUIT
- +62 SET EZDATA="ssn"
- End DoDot:3
- +63 KILL KK,PTSSN,EZSSN
- End DoDot:2
- +64 ;special for fields #.092 & #.093
- +65 IF FILE=2
- IF ((FLD=.092)!(FLD=.093))
- DO FPOB(DATAKEY,EZDATA,SUBIEN,PTDATA)
- QUIT
- +66 ;don't need these lines after 672
- +67 ;special for field #.362
- +68 ;I FILE=2,FLD=.362,EASVRSN>5.99 I (EZDATA="Y")!(EZDATA="YES") S EZDATA="YES, RECEIVING MILITARY RETIREMENT IN LIEU OF VA COMPENSATION"
- +69 if EZDATA=PTDATA
- QUIT
- +70 ;repeat check for verified eligibility;
- +71 ;do not file certain fields if eligibility verified
- +72 KILL ARRAY
- +73 SET DA=EASDFN
- SET DIC="^DPT("
- SET DR=".3611;.3613"
- SET DIQ(0)="I"
- SET DIQ="ARRAY"
- +74 DO EN^DIQ1
- KILL DA,DIC,DIQ,DR
- +75 IF $GET(ARRAY(2,EASDFN,.3611,"I"))="V"
- IF $GET(ARRAY(2,EASDFN,.3613,"I"))="H"
- SET ELIGVER=1
- +76 IF FLD=.313
- IF $GET(ARRAY(2,EASDFN,.3611,"I"))="V"
- QUIT
- +77 IF $GET(ELIGVER)
- IF ((FLD=.301)!(FLD=.302)!(FLD=.36235))
- QUIT
- +78 ;special for field #.32102 - Agent Orange Exposure . DATAKEY = I;14F
- +79 IF FLD=.32102
- DO F32102^EASEZF1A(EASAPP,EASDFN,EZDATA)
- +80 ;setup to call FM database server using EASDFN as file #2 record
- +81 KILL EAS,ERR
- +82 SET IENS=EASDFN_","
- +83 SET EROOT="EAS("_EASAPP_")"
- +84 DO VAL^DIE(2,IENS,FLD,"F",EZDATA,,EROOT,"ERR")
- +85 ;try to resolve possible invalid input for free text fields due to length
- +86 IF $DATA(ERR)
- DO RESOLVE
- +87 IF $DATA(ERR)
- DO ERROR^EASEZF2("AP",MULTIPLE,.ERR,"LINK")
- +88 ;file to database if input is valid
- +89 IF '$DATA(ERR)
- Begin DoDot:2
- +90 ;2/1/2001 - don't attempt to file Name, SSN, DOB; too many complications;
- +91 ; example: if system assigns pseudo-SSN to new patient, user could overwrite;
- +92 ; example: if applicant matched to existing patient, all critical identifying
- +93 ; data could be overwritten; could impact HEC as well
- +94 DO FILE^DIE("S",EROOT,"ERR")
- +95 ;set any replaced data into subfile #712.01 for audit
- +96 SET ^EAS(712,EASAPP,10,SUBIEN,2)=PTDATA_U_LINK
- End DoDot:2
- End DoDot:1
- +97 ;
- +98 ;L -^DPT(EASDFN) ;Handling locking in EASEZFM - EAS*1*93
- +99 QUIT
- +100 ;
- RESOLVE ;try to resolve invalid input for free text fields only
- +1 ;see if mapped to free text field
- +2 NEW FDEF,FTYPE,MAX
- +3 IF (SUBFILE=FILE)!(SUBFILE="")
- SET FDEF=FILE
- +4 IF '$TEST
- SET FDEF=SUBFILE
- +5 SET FTYPE=$$GET1^DID(FDEF,FLD,"","TYPE")
- +6 if FTYPE'="FREE TEXT"
- QUIT
- +7 SET MAX=$$GET1^DID(FDEF,FLD,"","FIELD LENGTH")
- +8 SET EZDATA=$EXTRACT(EZDATA,1,MAX)
- +9 KILL ERR
- +10 DO VAL^DIE(2,IENS,FLD,"F",EZDATA,,EROOT,"ERR")
- +11 ;if still sets ERR array then won't be filed to database
- +12 QUIT
- +13 ;
- F202(SUBFILE,DATAKEY,EZDATA,SUBIEN,KEYIEN) ;add or edit subrecord in subfile #2.02
- +1 ;input SUBFILE = 2.02
- +2 ; DATAKEY = data item identifier, e.g., I;4B.
- +3 ; EZDATA = in these cases, either "N(o)" or "Y(es)"
- +4 ; SUBIEN = subrecord # for data in #712/#10
- +5 ; KEYIEN = record # for data element in #711
- +6 NEW X,N,DATANM,EROOT,EAS,EIEN,ERR,FLD,IENS,EASARRAY,LINK,OUT,K1,K3
- +7 if EZDATA'["Y"
- QUIT
- +8 if SUBFILE'=2.02
- QUIT
- +9 ;covert data to corresponding file #10 pointer
- +10 SET X=$$KEY711^EASEZU1(DATAKEY)
- +11 SET K1=$PIECE(X,U,1)
- SET DATANM=$PIECE(X,U,2)
- SET K3=$PIECE(X,U,3)
- +12 if (DATANM="")
- QUIT
- +13 if (K1'=KEYIEN)
- QUIT
- +14 if (K3'=DATAKEY)
- QUIT
- +15 SET DATANM=$PIECE(DATANM," - ",2)
- SET DATANM=$EXTRACT(DATANM,1,30)
- +16 IF DATANM["UNANSWERED"
- SET DATANM="UNKNOWN BY PATIENT"
- +17 SET EZDATA=$ORDER(^DIC(10,"B",DATANM,0))
- +18 if EZDATA=""
- QUIT
- +19 DO I202^EASEZI(EASDFN,.EASARRAY)
- +20 ;if matching race already exists, edit method only
- +21 SET OUT=0
- SET N=0
- FOR
- SET N=$ORDER(EASARRAY(N))
- if 'N
- QUIT
- Begin DoDot:1
- +22 if ($PIECE(EASARRAY(N),";",2)'=EZDATA)
- QUIT
- +23 KILL EAS,ERR
- +24 SET IENS=EZDATA_","_EASDFN_","
- +25 SET EROOT="EAS("_EASAPP_")"
- +26 SET FLD=.02
- SET EAS(EASAPP,SUBFILE,IENS,FLD)=1
- +27 DO FILE^DIE("S",EROOT,"ERR")
- +28 SET OUT=1
- End DoDot:1
- +29 ;no matching race in patient record, add new subrecord
- +30 IF 'OUT
- Begin DoDot:1
- +31 KILL ERR
- +32 SET EROOT="EAS("_EASAPP_")"
- +33 SET IENS="+1,"_EASDFN_","
- SET EIEN(1)=EZDATA
- +34 SET FLD=.01
- SET EAS(EASAPP,SUBFILE,IENS,FLD)=EZDATA
- +35 SET FLD=.02
- SET EAS(EASAPP,SUBFILE,IENS,FLD)=1
- +36 DO UPDATE^DIE("S",EROOT,"EIEN","ERR")
- +37 IF $DATA(ERR)
- DO ERROR^EASEZF2("AP",1,.ERR,"LINK")
- QUIT
- +38 SET LINK=EASDFN_";"_EZDATA
- +39 SET ^EAS(712,EASAPP,10,SUBIEN,2)=U_LINK
- End DoDot:1
- +40 QUIT
- +41 ;
- F206(SUBFILE,DATAKEY,EZDATA,SUBIEN) ;add subrecord in subfile #2.06
- +1 ;input SUBFILE = 2.06
- +2 ; DATAKEY = data item identifier, e.g., I;4A.
- +3 ; EZDATA = in these cases, either "N(o)" or "Y(es)"
- +4 NEW X,EROOT,EAS,EIEN,ERR,FLD,EASARRAY,IENS,LINK,PTDATA
- +5 if SUBFILE'=2.06
- QUIT
- +6 DO I206^EASEZI(EASDFN,.EASARRAY)
- +7 SET LINK=$PIECE($GET(EASARRAY(1)),";",2)
- SET PTDATA=""
- IF LINK
- SET PTDATA=$PIECE(^DPT(EASDFN,.06,LINK,0),U,1)
- +8 IF DATAKEY="I;4A."
- SET EZDATA=$SELECT(EZDATA["Y":"H",$EXTRACT(EZDATA,1)="N":"N",1:"U")
- Begin DoDot:1
- +9 SET EROOT="EAS("_EASAPP_")"
- +10 SET IENS="+1,"_EASDFN_","
- +11 SET FLD=.01
- SET EAS(EASAPP,SUBFILE,IENS,FLD)=EZDATA
- +12 SET FLD=.02
- SET EAS(EASAPP,SUBFILE,IENS,FLD)="SELF IDENTIFICATION"
- +13 DO UPDATE^DIE("ES",EROOT,"EIEN","ERR")
- +14 SET LINK=EASDFN_";"_$GET(EIEN(1))
- +15 SET ^EAS(712,EASAPP,10,SUBIEN,2)=PTDATA_U_LINK
- End DoDot:1
- +16 QUIT
- +17 ;
- FPOB(DATAKEY,EZDATA,SUBIEN,PTDATA) ;add or edit pob city & state
- +1 ;input DATAKEY = data item identifier, either, I;8A. or I;8B.
- +2 ; EZDATA = free text if city or
- +3 ; state abbrv if state
- +4 ;filing for both city & state only done when datakey=I;8A.
- +5 NEW X,EROOT,EAS,EIEN,ERR,FLD,EASARRAY,IENS,LINK,SECT,QUES,XIEN,XDATA
- +6 if (DATAKEY'="I;8A.")
- QUIT
- +7 if (EZDATA="")
- QUIT
- +8 if (EZDATA=PTDATA)
- QUIT
- +9 ;file pob city
- +10 KILL EAS,ERR
- +11 SET FLD=.092
- SET LINK=EASDFN
- +12 SET IENS=EASDFN_","
- +13 SET EROOT="EAS("_EASAPP_")"
- +14 DO VAL^DIE(2,IENS,FLD,"F",EZDATA,,EROOT,"ERR")
- +15 IF $DATA(ERR)
- DO RESOLVE
- +16 IF $DATA(ERR)
- DO ERROR^EASEZF2("AP",1,.ERR,"LINK")
- QUIT
- +17 DO FILE^DIE("ES",EROOT,"ERR")
- +18 ;set any replaced data into subfile #712.01 for audit
- +19 SET ^EAS(712,EASAPP,10,SUBIEN,2)=PTDATA_U_LINK
- +20 ;file pob state
- +21 SET (EZDATA,XDATA)=""
- +22 SET DATAKEY="I;8B."
- SET SECT=$PIECE(DATAKEY,";",1)
- SET QUES=$PIECE(DATAKEY,";",2)
- +23 SET X=$GET(^TMP("EZTEMP",$JOB,SECT,1,QUES))
- SET EZDATA=$PIECE(X,U,2)
- SET XIEN=$PIECE(X,U,4)
- SET XDATA=$PIECE(X,U,5)
- +24 if (EZDATA="")
- QUIT
- +25 if (EZDATA=XDATA)
- QUIT
- +26 IF (EZDATA["FOREIGN")!(EZDATA="FC")!(EZDATA="FG")
- SET EZDATA="FOREIGN"
- +27 KILL EAS,ERR
- +28 SET FLD=.093
- +29 SET IENS=EASDFN_","
- +30 SET EROOT="EAS("_EASAPP_")"
- +31 DO VAL^DIE(2,IENS,FLD,"F",EZDATA,,EROOT,"ERR")
- +32 IF $DATA(ERR)
- DO ERROR^EASEZF2("AP",1,.ERR,"LINK")
- QUIT
- +33 DO FILE^DIE("ES",EROOT,"ERR")
- +34 SET ^EAS(712,EASAPP,10,XIEN,2)=XDATA_U_LINK
- +35 QUIT
- +36 ;
- F23216(SUBFILE,DATAKEY,EZDATA,SUBIEN,KEYIEN) ;add subrecord in subfile #2.3216
- +1 ;input SUBFILE = 2.3216
- +2 ; DATAKEY = data item identifier, e.g., I;13A.
- +3 ; EZDATA = data value in external format
- +4 ; KEYIEN = record # for data element in #711
- +5 ;
- +6 ;Values for KEYIEN DATAKEY
- +7 ; 28 - Branch of Service I;13A
- +8 ; 29 - Last Entry Date I;13B
- +9 ; 30 - Last Separation Date I;13C
- +10 ; 31 - Last Discharge Type I;13D
- +11 ; 32 - Last Service Number I;13E
- +12 ;
- +13 if SUBFILE'=2.3216
- QUIT
- +14 ;
- +15 NEW X,EAS,EASARRAY,LINK,PTDATA,SUBIEN
- +16 ;Get episodes from VistA into EASARRAY
- +17 DO GETMSE^DGMSEUTL(EASDFN,.EASARRAY)
- +18 ;Move last VistA episode into PDATA (for future use in edit option)
- +19 SET LINK=$GET(EASARRAY(1,"IEN"))
- SET PTDATA=""
- +20 IF LINK
- SET PTDATA=$GET(^DPT(EASDFN,2.3216,LINK,0))
- +21 ;
- +22 ;Only proceed to add new subrecord if no .3216 data exists
- +23 if PTDATA'=""
- QUIT
- +24 ;
- TBD1 ;if this is entirely new and later than VistA episodes, allow add?
- +1 ;
- +2 ; (compare EDATE to last episode in PDATA and allow addition if it is; a date later than last separation date)
- +3 ;
- TBD2 ;if matching episode already exists, allow update?
- +1 ;
- +2 ; (see code in F202^EASEZF1 for update, get last IENS from EASARRAY)
- +3 ;
- +4 ;Get last episode 1010EZ fields from ^TMP("EZDATA"
- +5 NEW BOS,EDATE,SDATE,DTYPE,SERVNO
- +6 SET BOS=$PIECE($GET(^TMP("EZDATA",$JOB,28,1,1)),U)
- if BOS=""
- QUIT
- +7 SET EDATE=$PIECE($GET(^TMP("EZDATA",$JOB,29,1,1)),U)
- if EDATE=""
- QUIT
- +8 SET SDATE=$PIECE($GET(^TMP("EZDATA",$JOB,30,1,1)),U)
- if SDATE=""
- QUIT
- +9 SET DTYPE=$PIECE($GET(^TMP("EZDATA",$JOB,31,1,1)),U)
- if DTYPE=""
- QUIT
- +10 SET SERVNO=$PIECE($GET(^TMP("EZDATA",$JOB,32,1,1)),U)
- +11 ;
- +12 ;Special conversion of service number (see code in EASEZF1)
- +13 IF $$UC^EASEZT1(SERVNO)="SSN"
- Begin DoDot:1
- +14 NEW EZSSN,KK,PTSSN
- +15 ;allow SSN as Service Number if service number in patient last
- +16 ;.3216 record is null. Always case if no .3216 data exists
- +17 SET PTSSN=$PIECE(PTDATA,U,5)
- +18 IF PTSSN=""
- SET SERVNO="SS"
- QUIT
- +19 ;alternatively Applicant SSN must match service number
- +20 SET KK=$$KEY711^EASEZU1("APPLICANT SOCIAL SECURITY NUMBER")
- +21 SET EZSSN=$PIECE($GET(^TMP("EZDATA",$JOB,KK,1,1)),U,1)
- +22 SET EZSSN=$TRANSLATE(EZSSN,"-","")
- +23 IF EZSSN=PTSSN
- SET SERVNO="SS"
- QUIT
- +24 SET SERVNO="ssn"
- End DoDot:1
- +25 ;
- +26 ;File 1010EZ data to .3216
- +27 NEW X,Y,EROOT,ERR,FLD,IENS,EIEN
- +28 SET EROOT="EAS("_EASAPP_")"
- +29 SET IENS="+1,"_EASDFN_","
- +30 SET FLD=.01
- SET EAS(EASAPP,SUBFILE,IENS,FLD)=EDATE
- +31 SET FLD=.02
- SET EAS(EASAPP,SUBFILE,IENS,FLD)=SDATE
- +32 SET FLD=.03
- SET EAS(EASAPP,SUBFILE,IENS,FLD)=BOS
- +33 SET FLD=.05
- SET EAS(EASAPP,SUBFILE,IENS,FLD)=SERVNO
- +34 SET FLD=.06
- SET EAS(EASAPP,SUBFILE,IENS,FLD)=DTYPE
- +35 DO UPDATE^DIE("ES",EROOT,"EIEN","ERR")
- +36 IF $DATA(ERR)
- DO ERROR^EASEZF2("AP",1,.ERR,"LINK")
- QUIT
- +37 ;
- +38 SET SUBIEN=$ORDER(^EAS(712,EASAPP,10,"B",28,""))
- +39 if SUBIEN
- SET ^EAS(712,EASAPP,10,SUBIEN,2)=U_EASDFN_";"_$GET(EIEN(1))
- +40 SET SUBIEN=$ORDER(^EAS(712,EASAPP,10,"B",29,""))
- +41 if SUBIEN
- SET ^EAS(712,EASAPP,10,SUBIEN,2)=U_EASDFN_";"_$GET(EIEN(1))
- +42 SET SUBIEN=$ORDER(^EAS(712,EASAPP,10,"B",30,""))
- +43 if SUBIEN
- SET ^EAS(712,EASAPP,10,SUBIEN,2)=U_EASDFN_";"_$GET(EIEN(1))
- +44 SET SUBIEN=$ORDER(^EAS(712,EASAPP,10,"B",31,""))
- +45 if SUBIEN
- SET ^EAS(712,EASAPP,10,SUBIEN,2)=U_EASDFN_";"_$GET(EIEN(1))
- +46 SET SUBIEN=$ORDER(^EAS(712,EASAPP,10,"B",32,""))
- +47 if SUBIEN
- SET ^EAS(712,EASAPP,10,SUBIEN,2)=U_EASDFN_";"_$GET(EIEN(1))
- +48 QUIT