EASEZF4 ;ALB/jap - Filing 1010EZ Data to Patient Database ;10/31/00 13:07
;;1.0;ENROLLMENT APPLICATION SYSTEM;**1,51,57,70**;Mar 15, 2001;Build 26
;
CN ;file Dependent/Child data
N MULTIPLE,FILE,SUBFILE,FLD,XDATA,ACCEPT,SUBIEN,SEX,SSN,EZDATA,EAS,ERR,X,Y
;process sequence must be 408.13 - 408.12 - 408.21 - 408.22
S MULTIPLE=0 F S MULTIPLE=$O(CN(MULTIPLE)) Q:'MULTIPLE F FILE=408.13,408.12,408.21,408.22 D
. S SUBFILE=FILE,FLD=""
. S XLINK=$G(FLINK("CN",MULTIPLE,FILE))
. ;record in file #408.13 is needed for all further data filng
. Q:(FILE'=408.13)&('$G(FLINK("CN",MULTIPLE,408.13)))
. ;for data elements with link to database,
. ;only file 1010EZ data if accepted by user;
. ;data in external format
. I XLINK D
. . ;when #408.12 record exists, don't try to update subfile #408.1275
. . S FLD="" F S FLD=$O(CN(MULTIPLE,FILE,SUBFILE,FLD)) Q:FLD="" D
. . . S XDATA=CN(MULTIPLE,FILE,SUBFILE,FLD),ACCEPT=$P(XDATA,U,2)
. . . I FILE=408.13,FLD=.09 S XDATA=$TR(XDATA,"-","")
. . . I ACCEPT D LINK^EASEZF2(XDATA,FILE,FLD,"CN",MULTIPLE)
. ;for data elements with no link to database,
. ;always create new record(s) to store 1010EZ data;
. ;put data in internal format
. I 'XLINK D
. . K EAS,ERR
. . S FLD="" F S FLD=$O(CN(MULTIPLE,FILE,SUBFILE,FLD)) Q:FLD="" D
. . . S EZDATA=$P(CN(MULTIPLE,FILE,SUBFILE,FLD),U,1)
. . . S EAS(EASAPP,FILE,"+1,",FLD)=EZDATA
. . ;supplement data and convert to internal format
. . I FILE=408.13 D
. . . S X=$G(EAS(EASAPP,FILE,"+1,",".03")) I X'="" D ^%DT S EAS(EASAPP,FILE,"+1,",".03")=Y
. . . S X=$G(EAS(EASAPP,FILE,"+1,",".09")) I X'="" D
. . . . S SSN=$TR(X,"-","") S EAS(EASAPP,FILE,"+1,",".09")=SSN
. . . . I $D(^DGPR(408.13,"SSN",SSN)) S EAS(EASAPP,FILE,"+1,",".09")=""
. . . S X=$P($G(CN(MULTIPLE,408.12,408.12,.02)),U,1) S SEX=$S(X["SON":"M",X["DAUGHTER":"F",1:"")
. . . I SEX'="" S EAS(EASAPP,FILE,"+1,",".02")=SEX
. . I FILE=408.12,$G(FLINK("CN",MULTIPLE,408.13)) D F40812^EASEZF3("CN",MULTIPLE)
. . I FILE=408.21,$G(FLINK("CN",MULTIPLE,408.12)) D
. . . S EAS(EASAPP,FILE,"+1,",".01")=INCYR
. . . S EAS(EASAPP,FILE,"+1,",".02")=FLINK("CN",MULTIPLE,408.12)
. . . S EAS(EASAPP,FILE,"+1,","101")=DUZ
. . . S EAS(EASAPP,FILE,"+1,","102")=DT
. . . S EAS(EASAPP,FILE,"+1,","103")=DUZ
. . . S EAS(EASAPP,FILE,"+1,","104")=DT
. . I FILE=408.22,$G(FLINK("CN",MULTIPLE,408.21)) D
. . . S EAS(EASAPP,FILE,"+1,",".01")=EASDFN
. . . S EAS(EASAPP,FILE,"+1,",".02")=FLINK("CN",MULTIPLE,408.21)
. . . S X=$P($G(CN(MULTIPLE,FILE,SUBFILE,".1")),U,1) I X S EAS(EASAPP,FILE,"+1,",".1")="Y"
. . . ;EAS*1.0*57 - ALLOW NULL VALUES FOR .09 AND .18
. . . S X=$P($G(CN(MULTIPLE,FILE,SUBFILE,".09")),U,1),EAS(EASAPP,FILE,"+1,",".09")=$S(X["Y":1,X["N":0,1:"")
. . . S X=$P($G(CN(MULTIPLE,408.21,408.21,".14")),U,1) I X S EAS(EASAPP,FILE,"+1,",".11")=1
. . . S X=$P($G(CN(MULTIPLE,FILE,SUBFILE,".18")),U,1),EAS(EASAPP,FILE,"+1,",".18")=$S(X["Y":1,X["N":0,1:"")
. . . S X=$G(EAS(EASAPP,FILE,"+1,",".1"))
. . . S EAS(EASAPP,FILE,"+1,",".1")=$S(X="YES":1,X="NO":0,1:"")
. . . S X=$G(EAS(EASAPP,FILE,"+1,",".06"))
. . . S EAS(EASAPP,FILE,"+1,",".06")=$S(X="YES":1,X="NO":0,1:"")
. . I FILE'=408.12 D
. . . S FLINK("CN",MULTIPLE,FILE)=$$NOLINK^EASEZF2(.EAS)
. . . S FLD="" F S FLD=$O(CN(MULTIPLE,FILE,SUBFILE,FLD)) Q:FLD="" D
. . . . S $P(CN(MULTIPLE,FILE,SUBFILE,FLD),U,5)=FLINK("CN",MULTIPLE,FILE)
Q
;
LINKUP ;
N SUBIEN,KEYIEN,MULTIPLE,FILE,SUBFILE,FIELD,DATAKEY,DATANM,TYPE,LINK,X
S SUBIEN=0 F S SUBIEN=$O(^EAS(712,EASAPP,10,SUBIEN)) Q:+SUBIEN=0 D
. S X=$G(^EAS(712,EASAPP,10,SUBIEN,1))
. ;quit if no data to file
. Q:(($P(X,U,1)="")&($P(X,U,2)=""))
. S TYPE=""
. S KEYIEN=$P(^EAS(712,EASAPP,10,SUBIEN,0),U,1),MULTIPLE=$P(^(0),U,2)
. S DATANM=$P(^EAS(711,KEYIEN,0),U,1),DATAKEY=$P(^(0),U,2),FILE=$P(^EAS(711,KEYIEN,1),U,1),SUBFILE=$P(^(1),U,2),FIELD=$P(^(1),U,3)
. Q:FILE<408
. Q:FILE>408.22
. I SUBFILE=408.1275 S FILE=SUBFILE
. I DATANM["CHILD" S TYPE="CN"
. I DATANM["ASSET(N)" S TYPE="CN" ;EAS*1.0*70
. I DATANM["CHILD(N)" D
. . ;necessary because some version 6 income data for child1 is brought-in via a child(n) multiple
. . S MULTIPLE=MULTIPLE+1
. . Q:$G(EASVRSN)<6
. . ;EAS*1.0*70 -- added up-arrows on next line
. . I FILE=408.21,("^.08^.14^.17^"[("^"_FIELD_"^")) S MULTIPLE=MULTIPLE-1
. I DATANM["SPOUSE" S TYPE="SP"
. I TYPE="" S TYPE="AP"
. S LINK=$G(FLINK(TYPE,MULTIPLE,FILE))
. Q:'LINK
. Q:$$SUPPRESS^EASEZU4(EASAPP,DATAKEY,1,$G(EASVRSN))
. I FILE=408.1275 S LINK=FLINK(TYPE,MULTIPLE,408.12)_";"_FLINK(TYPE,MULTIPLE,FILE)
. S $P(^EAS(712,EASAPP,10,SUBIEN,2),U,2)=LINK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASEZF4 4682 printed Dec 13, 2024@01:54:32 Page 2
EASEZF4 ;ALB/jap - Filing 1010EZ Data to Patient Database ;10/31/00 13:07
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**1,51,57,70**;Mar 15, 2001;Build 26
+2 ;
CN ;file Dependent/Child data
+1 NEW MULTIPLE,FILE,SUBFILE,FLD,XDATA,ACCEPT,SUBIEN,SEX,SSN,EZDATA,EAS,ERR,X,Y
+2 ;process sequence must be 408.13 - 408.12 - 408.21 - 408.22
+3 SET MULTIPLE=0
FOR
SET MULTIPLE=$ORDER(CN(MULTIPLE))
if 'MULTIPLE
QUIT
FOR FILE=408.13,408.12,408.21,408.22
Begin DoDot:1
+4 SET SUBFILE=FILE
SET FLD=""
+5 SET XLINK=$GET(FLINK("CN",MULTIPLE,FILE))
+6 ;record in file #408.13 is needed for all further data filng
+7 if (FILE'=408.13)&('$GET(FLINK("CN",MULTIPLE,408.13)))
QUIT
+8 ;for data elements with link to database,
+9 ;only file 1010EZ data if accepted by user;
+10 ;data in external format
+11 IF XLINK
Begin DoDot:2
+12 ;when #408.12 record exists, don't try to update subfile #408.1275
+13 SET FLD=""
FOR
SET FLD=$ORDER(CN(MULTIPLE,FILE,SUBFILE,FLD))
if FLD=""
QUIT
Begin DoDot:3
+14 SET XDATA=CN(MULTIPLE,FILE,SUBFILE,FLD)
SET ACCEPT=$PIECE(XDATA,U,2)
+15 IF FILE=408.13
IF FLD=.09
SET XDATA=$TRANSLATE(XDATA,"-","")
+16 IF ACCEPT
DO LINK^EASEZF2(XDATA,FILE,FLD,"CN",MULTIPLE)
End DoDot:3
End DoDot:2
+17 ;for data elements with no link to database,
+18 ;always create new record(s) to store 1010EZ data;
+19 ;put data in internal format
+20 IF 'XLINK
Begin DoDot:2
+21 KILL EAS,ERR
+22 SET FLD=""
FOR
SET FLD=$ORDER(CN(MULTIPLE,FILE,SUBFILE,FLD))
if FLD=""
QUIT
Begin DoDot:3
+23 SET EZDATA=$PIECE(CN(MULTIPLE,FILE,SUBFILE,FLD),U,1)
+24 SET EAS(EASAPP,FILE,"+1,",FLD)=EZDATA
End DoDot:3
+25 ;supplement data and convert to internal format
+26 IF FILE=408.13
Begin DoDot:3
+27 SET X=$GET(EAS(EASAPP,FILE,"+1,",".03"))
IF X'=""
DO ^%DT
SET EAS(EASAPP,FILE,"+1,",".03")=Y
+28 SET X=$GET(EAS(EASAPP,FILE,"+1,",".09"))
IF X'=""
Begin DoDot:4
+29 SET SSN=$TRANSLATE(X,"-","")
SET EAS(EASAPP,FILE,"+1,",".09")=SSN
+30 IF $DATA(^DGPR(408.13,"SSN",SSN))
SET EAS(EASAPP,FILE,"+1,",".09")=""
End DoDot:4
+31 SET X=$PIECE($GET(CN(MULTIPLE,408.12,408.12,.02)),U,1)
SET SEX=$SELECT(X["SON":"M",X["DAUGHTER":"F",1:"")
+32 IF SEX'=""
SET EAS(EASAPP,FILE,"+1,",".02")=SEX
End DoDot:3
+33 IF FILE=408.12
IF $GET(FLINK("CN",MULTIPLE,408.13))
DO F40812^EASEZF3("CN",MULTIPLE)
+34 IF FILE=408.21
IF $GET(FLINK("CN",MULTIPLE,408.12))
Begin DoDot:3
+35 SET EAS(EASAPP,FILE,"+1,",".01")=INCYR
+36 SET EAS(EASAPP,FILE,"+1,",".02")=FLINK("CN",MULTIPLE,408.12)
+37 SET EAS(EASAPP,FILE,"+1,","101")=DUZ
+38 SET EAS(EASAPP,FILE,"+1,","102")=DT
+39 SET EAS(EASAPP,FILE,"+1,","103")=DUZ
+40 SET EAS(EASAPP,FILE,"+1,","104")=DT
End DoDot:3
+41 IF FILE=408.22
IF $GET(FLINK("CN",MULTIPLE,408.21))
Begin DoDot:3
+42 SET EAS(EASAPP,FILE,"+1,",".01")=EASDFN
+43 SET EAS(EASAPP,FILE,"+1,",".02")=FLINK("CN",MULTIPLE,408.21)
+44 SET X=$PIECE($GET(CN(MULTIPLE,FILE,SUBFILE,".1")),U,1)
IF X
SET EAS(EASAPP,FILE,"+1,",".1")="Y"
+45 ;EAS*1.0*57 - ALLOW NULL VALUES FOR .09 AND .18
+46 SET X=$PIECE($GET(CN(MULTIPLE,FILE,SUBFILE,".09")),U,1)
SET EAS(EASAPP,FILE,"+1,",".09")=$SELECT(X["Y":1,X["N":0,1:"")
+47 SET X=$PIECE($GET(CN(MULTIPLE,408.21,408.21,".14")),U,1)
IF X
SET EAS(EASAPP,FILE,"+1,",".11")=1
+48 SET X=$PIECE($GET(CN(MULTIPLE,FILE,SUBFILE,".18")),U,1)
SET EAS(EASAPP,FILE,"+1,",".18")=$SELECT(X["Y":1,X["N":0,1:"")
+49 SET X=$GET(EAS(EASAPP,FILE,"+1,",".1"))
+50 SET EAS(EASAPP,FILE,"+1,",".1")=$SELECT(X="YES":1,X="NO":0,1:"")
+51 SET X=$GET(EAS(EASAPP,FILE,"+1,",".06"))
+52 SET EAS(EASAPP,FILE,"+1,",".06")=$SELECT(X="YES":1,X="NO":0,1:"")
End DoDot:3
+53 IF FILE'=408.12
Begin DoDot:3
+54 SET FLINK("CN",MULTIPLE,FILE)=$$NOLINK^EASEZF2(.EAS)
+55 SET FLD=""
FOR
SET FLD=$ORDER(CN(MULTIPLE,FILE,SUBFILE,FLD))
if FLD=""
QUIT
Begin DoDot:4
+56 SET $PIECE(CN(MULTIPLE,FILE,SUBFILE,FLD),U,5)=FLINK("CN",MULTIPLE,FILE)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+57 QUIT
+58 ;
LINKUP ;
+1 NEW SUBIEN,KEYIEN,MULTIPLE,FILE,SUBFILE,FIELD,DATAKEY,DATANM,TYPE,LINK,X
+2 SET SUBIEN=0
FOR
SET SUBIEN=$ORDER(^EAS(712,EASAPP,10,SUBIEN))
if +SUBIEN=0
QUIT
Begin DoDot:1
+3 SET X=$GET(^EAS(712,EASAPP,10,SUBIEN,1))
+4 ;quit if no data to file
+5 if (($PIECE(X,U,1)="")&($PIECE(X,U,2)=""))
QUIT
+6 SET TYPE=""
+7 SET KEYIEN=$PIECE(^EAS(712,EASAPP,10,SUBIEN,0),U,1)
SET MULTIPLE=$PIECE(^(0),U,2)
+8 SET DATANM=$PIECE(^EAS(711,KEYIEN,0),U,1)
SET DATAKEY=$PIECE(^(0),U,2)
SET FILE=$PIECE(^EAS(711,KEYIEN,1),U,1)
SET SUBFILE=$PIECE(^(1),U,2)
SET FIELD=$PIECE(^(1),U,3)
+9 if FILE<408
QUIT
+10 if FILE>408.22
QUIT
+11 IF SUBFILE=408.1275
SET FILE=SUBFILE
+12 IF DATANM["CHILD"
SET TYPE="CN"
+13 ;EAS*1.0*70
IF DATANM["ASSET(N)"
SET TYPE="CN"
+14 IF DATANM["CHILD(N)"
Begin DoDot:2
+15 ;necessary because some version 6 income data for child1 is brought-in via a child(n) multiple
+16 SET MULTIPLE=MULTIPLE+1
+17 if $GET(EASVRSN)<6
QUIT
+18 ;EAS*1.0*70 -- added up-arrows on next line
+19 IF FILE=408.21
IF ("^.08^.14^.17^"[("^"_FIELD_"^"))
SET MULTIPLE=MULTIPLE-1
End DoDot:2
+20 IF DATANM["SPOUSE"
SET TYPE="SP"
+21 IF TYPE=""
SET TYPE="AP"
+22 SET LINK=$GET(FLINK(TYPE,MULTIPLE,FILE))
+23 if 'LINK
QUIT
+24 if $$SUPPRESS^EASEZU4(EASAPP,DATAKEY,1,$GET(EASVRSN))
QUIT
+25 IF FILE=408.1275
SET LINK=FLINK(TYPE,MULTIPLE,408.12)_";"_FLINK(TYPE,MULTIPLE,FILE)
+26 SET $PIECE(^EAS(712,EASAPP,10,SUBIEN,2),U,2)=LINK
End DoDot:1
+27 QUIT
