Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EASEZF1

EASEZF1.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. F2(EASAPP,EASDFN) ;file to Patient record in #2
  1. ;input EASDFN = ien to #2
  1. N KEYIEN,FILE,SUBFILE,FLD,DATAKEY,MULTIPLE,SECT,QUES,SUBIEN,ACCEPT,EZDATA,PTDATA,LINK,EROOT,EAS,ERR,IENS,ARRAY,ELIGVER
  1. N DIC,DIQ,DA,DR,X,Y,EZSTRG
  1. Q:'$G(EASDFN)
  1. ;L +^DPT(EASDFN) ;Handling locking in EASEZFM - EAS*1*93
  1. I '$G(EASVRSN) S EASVRSN=$$VERSION^EASEZU4(EASAPP)
  1. ;EAS*1.0*70 - Special handling for Foreign Address
  1. S KEYIEN=+$$KEY711^EASEZU1("APPLICANT COUNTRY")
  1. S DATAKEY=$P(^TMP("EZDATA",$J,KEYIEN),U,4)
  1. S SECT=$P(DATAKEY,";"),QUES=$P(DATAKEY,";",2)
  1. S EZDATA=$P($G(^TMP("EZTEMP",$J,SECT,1,QUES)),U,2)
  1. I EZDATA="UNITED STATES" S EZSTRG="APPLICANT PROVINCE^APPLICANT POSTAL CODE"
  1. E S EZSTRG="APPLICANT COUNTY^APPLICANT STATE^APPLICANT ZIP"
  1. F X=1:1 S DATANM=$P(EZSTRG,U,X) Q:DATANM="" D
  1. . S KEYIEN=+$$KEY711^EASEZU1(DATANM) Q:(KEYIEN=.1)
  1. . S DATAKEY=$P(^TMP("EZDATA",$J,KEYIEN),U,4)
  1. . S SECT=$P(DATAKEY,";"),QUES=$P(DATAKEY,";",2)
  1. . K ^TMP("EZDATA",$J,KEYIEN),^TMP("EZTEMP",$J,SECT,1,QUES)
  1. ;
  1. S KEYIEN=0
  1. F S KEYIEN=$O(^TMP("EZDATA",$J,KEYIEN)) Q:'KEYIEN D
  1. . S LN=^TMP("EZDATA",$J,KEYIEN),FILE=$P(LN,U,1)
  1. . Q:FILE'=2
  1. . S SUBFILE=$P(LN,U,2),FLD=$P(LN,U,3),DATAKEY=$P(LN,U,4)
  1. . S SECT=$P(DATAKEY,";",1),QUES=$P(DATAKEY,";",2)
  1. . ;call to suppress may be redundant
  1. . Q:$$SUPPRESS^EASEZU4(EASAPP,DATAKEY,1,EASVRSN)
  1. . ;in file #2, multiple is always 1
  1. . S MULTIPLE=1
  1. . Q:'$D(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1))
  1. . S X=$G(^TMP("EZTEMP",$J,SECT,MULTIPLE,QUES))
  1. . Q:$P(X,U,1)'=KEYIEN
  1. . S EZDATA=$P(X,U,2),ACCEPT=$P(X,U,3),SUBIEN=$P(X,U,4),PTDATA=$P(X,U,5)
  1. . Q:EZDATA=""
  1. . Q:'SUBIEN
  1. . ;special handling for Designee
  1. . I FLD=.3405 S EZDATA=$S(EZDATA="NEXT OF KIN":"YES",1:"NO")
  1. . ;strip off code display from county
  1. . I SECT="I",QUES="9E." S EZDATA=$P(EZDATA," (",1)
  1. . ;get file #2 ien; always same as EASDFN
  1. . S LINK=EASDFN
  1. . ;don't continue if data item not accepted
  1. . Q:ACCEPT<1
  1. . ;process subfile data elsewhere
  1. . I SUBFILE=2.01 Q
  1. . I SUBFILE=2.101 Q
  1. . I SUBFILE=2.02 D F202^EASEZF1(SUBFILE,DATAKEY,EZDATA,SUBIEN,KEYIEN) Q
  1. . I SUBFILE=2.06 D F206^EASEZF1(SUBFILE,DATAKEY,EZDATA,SUBIEN) Q
  1. . ;Special for Military Service Episodes
  1. . I SUBFILE=2.3216 D:KEYIEN=28 Q
  1. . . D F23216(SUBFILE,DATAKEY,EZDATA,SUBIEN,KEYIEN)
  1. . ;special conversion to file data to field #.328
  1. . I FLD=.328 D
  1. . . S X=$$UC^EASEZT1(EZDATA) I X="SSN" D
  1. . . . ;allow SSN as Service Number only if field #.328 in patient record is null;
  1. . . . S PTSSN=$$GETANY^EASEZU1(EASAPP,EASDFN,SUBIEN)
  1. . . . I PTSSN="" S EZDATA="SS" Q
  1. . . . ;otherwise Applicant SSN must match Patient SSN
  1. . . . S KK=$$KEY711^EASEZU1("APPLICANT SOCIAL SECURITY NUMBER")
  1. . . . S EZSSN=$P($G(^TMP("EZDATA",$J,KK,1,1)),U,1),EZSSN=$TR(EZSSN,"-","")
  1. . . . I EZSSN=PTSSN S EZDATA="SS" Q
  1. . . . S EZDATA="ssn"
  1. . . K KK,PTSSN,EZSSN
  1. . ;special for fields #.092 & #.093
  1. . I FILE=2,((FLD=.092)!(FLD=.093)) D FPOB(DATAKEY,EZDATA,SUBIEN,PTDATA) Q
  1. . ;don't need these lines after 672
  1. . ;special for field #.362
  1. . ;I FILE=2,FLD=.362,EASVRSN>5.99 I (EZDATA="Y")!(EZDATA="YES") S EZDATA="YES, RECEIVING MILITARY RETIREMENT IN LIEU OF VA COMPENSATION"
  1. . Q:EZDATA=PTDATA
  1. . ;repeat check for verified eligibility;
  1. . ;do not file certain fields if eligibility verified
  1. . K ARRAY
  1. . S DA=EASDFN,DIC="^DPT(",DR=".3611;.3613",DIQ(0)="I",DIQ="ARRAY"
  1. . D EN^DIQ1 K DA,DIC,DIQ,DR
  1. . I $G(ARRAY(2,EASDFN,.3611,"I"))="V",$G(ARRAY(2,EASDFN,.3613,"I"))="H" S ELIGVER=1
  1. . I FLD=.313,$G(ARRAY(2,EASDFN,.3611,"I"))="V" Q
  1. . I $G(ELIGVER),((FLD=.301)!(FLD=.302)!(FLD=.36235)) Q
  1. . ;special for field #.32102 - Agent Orange Exposure . DATAKEY = I;14F
  1. . I FLD=.32102 D F32102^EASEZF1A(EASAPP,EASDFN,EZDATA)
  1. . ;setup to call FM database server using EASDFN as file #2 record
  1. . K EAS,ERR
  1. . S IENS=EASDFN_","
  1. . S EROOT="EAS("_EASAPP_")"
  1. . D VAL^DIE(2,IENS,FLD,"F",EZDATA,,EROOT,"ERR")
  1. . ;try to resolve possible invalid input for free text fields due to length
  1. . I $D(ERR) D RESOLVE
  1. . I $D(ERR) D ERROR^EASEZF2("AP",MULTIPLE,.ERR,"LINK")
  1. . ;file to database if input is valid
  1. . I '$D(ERR) D
  1. . . ;2/1/2001 - don't attempt to file Name, SSN, DOB; too many complications;
  1. . . ; example: if system assigns pseudo-SSN to new patient, user could overwrite;
  1. . . ; example: if applicant matched to existing patient, all critical identifying
  1. . . ; data could be overwritten; could impact HEC as well
  1. . . D FILE^DIE("S",EROOT,"ERR")
  1. . . ;set any replaced data into subfile #712.01 for audit
  1. . . S ^EAS(712,EASAPP,10,SUBIEN,2)=PTDATA_U_LINK
  1. ;
  1. ;L -^DPT(EASDFN) ;Handling locking in EASEZFM - EAS*1*93
  1. Q
  1. ;
  1. RESOLVE ;try to resolve invalid input for free text fields only
  1. ;see if mapped to free text field
  1. N FDEF,FTYPE,MAX
  1. I (SUBFILE=FILE)!(SUBFILE="") S FDEF=FILE
  1. E S FDEF=SUBFILE
  1. S FTYPE=$$GET1^DID(FDEF,FLD,"","TYPE")
  1. Q:FTYPE'="FREE TEXT"
  1. S MAX=$$GET1^DID(FDEF,FLD,"","FIELD LENGTH")
  1. S EZDATA=$E(EZDATA,1,MAX)
  1. K ERR
  1. D VAL^DIE(2,IENS,FLD,"F",EZDATA,,EROOT,"ERR")
  1. ;if still sets ERR array then won't be filed to database
  1. Q
  1. ;
  1. F202(SUBFILE,DATAKEY,EZDATA,SUBIEN,KEYIEN) ;add or edit subrecord in subfile #2.02
  1. ;input SUBFILE = 2.02
  1. ; DATAKEY = data item identifier, e.g., I;4B.
  1. ; EZDATA = in these cases, either "N(o)" or "Y(es)"
  1. ; SUBIEN = subrecord # for data in #712/#10
  1. ; KEYIEN = record # for data element in #711
  1. N X,N,DATANM,EROOT,EAS,EIEN,ERR,FLD,IENS,EASARRAY,LINK,OUT,K1,K3
  1. Q:EZDATA'["Y"
  1. Q:SUBFILE'=2.02
  1. ;covert data to corresponding file #10 pointer
  1. S X=$$KEY711^EASEZU1(DATAKEY)
  1. S K1=$P(X,U,1),DATANM=$P(X,U,2),K3=$P(X,U,3)
  1. Q:(DATANM="")
  1. Q:(K1'=KEYIEN)
  1. Q:(K3'=DATAKEY)
  1. S DATANM=$P(DATANM," - ",2),DATANM=$E(DATANM,1,30)
  1. I DATANM["UNANSWERED" S DATANM="UNKNOWN BY PATIENT"
  1. S EZDATA=$O(^DIC(10,"B",DATANM,0))
  1. Q:EZDATA=""
  1. D I202^EASEZI(EASDFN,.EASARRAY)
  1. ;if matching race already exists, edit method only
  1. S OUT=0,N=0 F S N=$O(EASARRAY(N)) Q:'N D
  1. . Q:($P(EASARRAY(N),";",2)'=EZDATA)
  1. . K EAS,ERR
  1. . S IENS=EZDATA_","_EASDFN_","
  1. . S EROOT="EAS("_EASAPP_")"
  1. . S FLD=.02,EAS(EASAPP,SUBFILE,IENS,FLD)=1
  1. . D FILE^DIE("S",EROOT,"ERR")
  1. . S OUT=1
  1. ;no matching race in patient record, add new subrecord
  1. I 'OUT D
  1. . K ERR
  1. . S EROOT="EAS("_EASAPP_")"
  1. . S IENS="+1,"_EASDFN_",",EIEN(1)=EZDATA
  1. . S FLD=.01,EAS(EASAPP,SUBFILE,IENS,FLD)=EZDATA
  1. . S FLD=.02,EAS(EASAPP,SUBFILE,IENS,FLD)=1
  1. . D UPDATE^DIE("S",EROOT,"EIEN","ERR")
  1. . I $D(ERR) D ERROR^EASEZF2("AP",1,.ERR,"LINK") Q
  1. . S LINK=EASDFN_";"_EZDATA
  1. . S ^EAS(712,EASAPP,10,SUBIEN,2)=U_LINK
  1. Q
  1. ;
  1. F206(SUBFILE,DATAKEY,EZDATA,SUBIEN) ;add subrecord in subfile #2.06
  1. ;input SUBFILE = 2.06
  1. ; DATAKEY = data item identifier, e.g., I;4A.
  1. ; EZDATA = in these cases, either "N(o)" or "Y(es)"
  1. N X,EROOT,EAS,EIEN,ERR,FLD,EASARRAY,IENS,LINK,PTDATA
  1. Q:SUBFILE'=2.06
  1. D I206^EASEZI(EASDFN,.EASARRAY)
  1. S LINK=$P($G(EASARRAY(1)),";",2),PTDATA="" I LINK S PTDATA=$P(^DPT(EASDFN,.06,LINK,0),U,1)
  1. I DATAKEY="I;4A." S EZDATA=$S(EZDATA["Y":"H",$E(EZDATA,1)="N":"N",1:"U") D
  1. . S EROOT="EAS("_EASAPP_")"
  1. . S IENS="+1,"_EASDFN_","
  1. . S FLD=.01,EAS(EASAPP,SUBFILE,IENS,FLD)=EZDATA
  1. . S FLD=.02,EAS(EASAPP,SUBFILE,IENS,FLD)="SELF IDENTIFICATION"
  1. . D UPDATE^DIE("ES",EROOT,"EIEN","ERR")
  1. . S LINK=EASDFN_";"_$G(EIEN(1))
  1. . S ^EAS(712,EASAPP,10,SUBIEN,2)=PTDATA_U_LINK
  1. Q
  1. ;
  1. FPOB(DATAKEY,EZDATA,SUBIEN,PTDATA) ;add or edit pob city & state
  1. ;input DATAKEY = data item identifier, either, I;8A. or I;8B.
  1. ; EZDATA = free text if city or
  1. ; state abbrv if state
  1. ;filing for both city & state only done when datakey=I;8A.
  1. N X,EROOT,EAS,EIEN,ERR,FLD,EASARRAY,IENS,LINK,SECT,QUES,XIEN,XDATA
  1. Q:(DATAKEY'="I;8A.")
  1. Q:(EZDATA="")
  1. Q:(EZDATA=PTDATA)
  1. ;file pob city
  1. K EAS,ERR
  1. S FLD=.092,LINK=EASDFN
  1. S IENS=EASDFN_","
  1. S EROOT="EAS("_EASAPP_")"
  1. D VAL^DIE(2,IENS,FLD,"F",EZDATA,,EROOT,"ERR")
  1. I $D(ERR) D RESOLVE
  1. I $D(ERR) D ERROR^EASEZF2("AP",1,.ERR,"LINK") Q
  1. D FILE^DIE("ES",EROOT,"ERR")
  1. ;set any replaced data into subfile #712.01 for audit
  1. S ^EAS(712,EASAPP,10,SUBIEN,2)=PTDATA_U_LINK
  1. ;file pob state
  1. S (EZDATA,XDATA)=""
  1. S DATAKEY="I;8B.",SECT=$P(DATAKEY,";",1),QUES=$P(DATAKEY,";",2)
  1. S X=$G(^TMP("EZTEMP",$J,SECT,1,QUES)),EZDATA=$P(X,U,2),XIEN=$P(X,U,4),XDATA=$P(X,U,5)
  1. Q:(EZDATA="")
  1. Q:(EZDATA=XDATA)
  1. I (EZDATA["FOREIGN")!(EZDATA="FC")!(EZDATA="FG") S EZDATA="FOREIGN"
  1. K EAS,ERR
  1. S FLD=.093
  1. S IENS=EASDFN_","
  1. S EROOT="EAS("_EASAPP_")"
  1. D VAL^DIE(2,IENS,FLD,"F",EZDATA,,EROOT,"ERR")
  1. I $D(ERR) D ERROR^EASEZF2("AP",1,.ERR,"LINK") Q
  1. D FILE^DIE("ES",EROOT,"ERR")
  1. S ^EAS(712,EASAPP,10,XIEN,2)=XDATA_U_LINK
  1. Q
  1. ;
  1. F23216(SUBFILE,DATAKEY,EZDATA,SUBIEN,KEYIEN) ;add subrecord in subfile #2.3216
  1. ;input SUBFILE = 2.3216
  1. ; DATAKEY = data item identifier, e.g., I;13A.
  1. ; EZDATA = data value in external format
  1. ; KEYIEN = record # for data element in #711
  1. ;
  1. ;Values for KEYIEN DATAKEY
  1. ; 28 - Branch of Service I;13A
  1. ; 29 - Last Entry Date I;13B
  1. ; 30 - Last Separation Date I;13C
  1. ; 31 - Last Discharge Type I;13D
  1. ; 32 - Last Service Number I;13E
  1. ;
  1. Q:SUBFILE'=2.3216
  1. ;
  1. N X,EAS,EASARRAY,LINK,PTDATA,SUBIEN
  1. ;Get episodes from VistA into EASARRAY
  1. D GETMSE^DGMSEUTL(EASDFN,.EASARRAY)
  1. ;Move last VistA episode into PDATA (for future use in edit option)
  1. S LINK=$G(EASARRAY(1,"IEN")),PTDATA=""
  1. I LINK S PTDATA=$G(^DPT(EASDFN,2.3216,LINK,0))
  1. ;
  1. ;Only proceed to add new subrecord if no .3216 data exists
  1. Q:PTDATA'=""
  1. ;
  1. TBD1 ;if this is entirely new and later than VistA episodes, allow add?
  1. ;
  1. ; (compare EDATE to last episode in PDATA and allow addition if it is; a date later than last separation date)
  1. ;
  1. TBD2 ;if matching episode already exists, allow update?
  1. ;
  1. ; (see code in F202^EASEZF1 for update, get last IENS from EASARRAY)
  1. ;
  1. ;Get last episode 1010EZ fields from ^TMP("EZDATA"
  1. N BOS,EDATE,SDATE,DTYPE,SERVNO
  1. S BOS=$P($G(^TMP("EZDATA",$J,28,1,1)),U) Q:BOS=""
  1. S EDATE=$P($G(^TMP("EZDATA",$J,29,1,1)),U) Q:EDATE=""
  1. S SDATE=$P($G(^TMP("EZDATA",$J,30,1,1)),U) Q:SDATE=""
  1. S DTYPE=$P($G(^TMP("EZDATA",$J,31,1,1)),U) Q:DTYPE=""
  1. S SERVNO=$P($G(^TMP("EZDATA",$J,32,1,1)),U)
  1. ;
  1. ;Special conversion of service number (see code in EASEZF1)
  1. I $$UC^EASEZT1(SERVNO)="SSN" D
  1. .N EZSSN,KK,PTSSN
  1. .;allow SSN as Service Number if service number in patient last
  1. .;.3216 record is null. Always case if no .3216 data exists
  1. .S PTSSN=$P(PTDATA,U,5)
  1. .I PTSSN="" S SERVNO="SS" Q
  1. .;alternatively Applicant SSN must match service number
  1. .S KK=$$KEY711^EASEZU1("APPLICANT SOCIAL SECURITY NUMBER")
  1. .S EZSSN=$P($G(^TMP("EZDATA",$J,KK,1,1)),U,1)
  1. .S EZSSN=$TR(EZSSN,"-","")
  1. .I EZSSN=PTSSN S SERVNO="SS" Q
  1. .S SERVNO="ssn"
  1. ;
  1. ;File 1010EZ data to .3216
  1. N X,Y,EROOT,ERR,FLD,IENS,EIEN
  1. S EROOT="EAS("_EASAPP_")"
  1. S IENS="+1,"_EASDFN_","
  1. S FLD=.01,EAS(EASAPP,SUBFILE,IENS,FLD)=EDATE
  1. S FLD=.02,EAS(EASAPP,SUBFILE,IENS,FLD)=SDATE
  1. S FLD=.03,EAS(EASAPP,SUBFILE,IENS,FLD)=BOS
  1. S FLD=.05,EAS(EASAPP,SUBFILE,IENS,FLD)=SERVNO
  1. S FLD=.06,EAS(EASAPP,SUBFILE,IENS,FLD)=DTYPE
  1. D UPDATE^DIE("ES",EROOT,"EIEN","ERR")
  1. I $D(ERR) D ERROR^EASEZF2("AP",1,.ERR,"LINK") Q
  1. ;
  1. S SUBIEN=$O(^EAS(712,EASAPP,10,"B",28,""))
  1. S:SUBIEN ^EAS(712,EASAPP,10,SUBIEN,2)=U_EASDFN_";"_$G(EIEN(1))
  1. S SUBIEN=$O(^EAS(712,EASAPP,10,"B",29,""))
  1. S:SUBIEN ^EAS(712,EASAPP,10,SUBIEN,2)=U_EASDFN_";"_$G(EIEN(1))
  1. S SUBIEN=$O(^EAS(712,EASAPP,10,"B",30,""))
  1. S:SUBIEN ^EAS(712,EASAPP,10,SUBIEN,2)=U_EASDFN_";"_$G(EIEN(1))
  1. S SUBIEN=$O(^EAS(712,EASAPP,10,"B",31,""))
  1. S:SUBIEN ^EAS(712,EASAPP,10,SUBIEN,2)=U_EASDFN_";"_$G(EIEN(1))
  1. S SUBIEN=$O(^EAS(712,EASAPP,10,"B",32,""))
  1. S:SUBIEN ^EAS(712,EASAPP,10,SUBIEN,2)=U_EASDFN_";"_$G(EIEN(1))
  1. Q