[613] | 1 | EASEZF3 ;ALB/jap - Filing 1010EZ Data to Patient Database ;10/31/00 13:07
|
---|
| 2 | ;;1.0;ENROLLMENT APPLICATION SYSTEM;**1,57**;Mar 15, 2001
|
---|
| 3 | ;
|
---|
| 4 | SP ;file Spouse data
|
---|
| 5 | N C,MULTIPLE,FILE,SUBFILE,FLD,XDATA,ACCEPT,SUBIEN,SEX,EZDATA,EAS,ERR
|
---|
| 6 | N KEY,X,Y,XLINK,DIC
|
---|
| 7 | ;process sequence must be 408.13 - 408.12 - 408.21 - 408.22
|
---|
| 8 | ;set sex of spouse
|
---|
| 9 | S KEY=+$$KEY711^EASEZU1("APPLICANT SEX")
|
---|
| 10 | S X=$$DATA712^EASEZU1(EASAPP,KEY,1),APSEX=$P(X,U,1),SEX=$S(APSEX="M":"FEMALE",1:"MALE")
|
---|
| 11 | S XLINK=$G(FLINK("SP",1,408.13)),PTDATA="" I XLINK D
|
---|
| 12 | .S FFF="408.13^408.13^.02" S PTDATA=$$GET^EASEZC1(XLINK,FFF)
|
---|
| 13 | .S SP(1,408.13,408.13,.02)=SEX_U_2_U_U_PTDATA_U_XLINK
|
---|
| 14 | ;
|
---|
| 15 | F FILE=408.13,408.12,408.21,408.22 D
|
---|
| 16 | .S MULTIPLE=1,SUBFILE=FILE,FLD=""
|
---|
| 17 | .S XLINK=$G(FLINK("SP",MULTIPLE,FILE))
|
---|
| 18 | .;record in file #408.13 is needed for all further data filng
|
---|
| 19 | .Q:(FILE'=408.13)&('$G(FLINK("SP",MULTIPLE,408.13)))
|
---|
| 20 | .;for data elements with link to database,
|
---|
| 21 | .;only file 1010EZ data if accepted by user;
|
---|
| 22 | .;data in external format
|
---|
| 23 | .I XLINK D
|
---|
| 24 | ..;when #408.12 record exists, don't try to update subfile #408.1275
|
---|
| 25 | ..S FLD="" F S FLD=$O(SP(MULTIPLE,FILE,SUBFILE,FLD)) Q:FLD="" D
|
---|
| 26 | ...S XDATA=SP(MULTIPLE,FILE,SUBFILE,FLD),ACCEPT=$P(XDATA,U,2)
|
---|
| 27 | ...I FILE=408.13,FLD=.09 S XDATA=$TR(XDATA,"-","")
|
---|
| 28 | ...I ACCEPT D LINK^EASEZF2(XDATA,FILE,FLD,"SP",MULTIPLE)
|
---|
| 29 | .;for data elements with no link to database,
|
---|
| 30 | .;always create new record(s) to store 1010EZ data;
|
---|
| 31 | .;put data in internal format
|
---|
| 32 | .I 'XLINK D
|
---|
| 33 | ..K EAS,ERR
|
---|
| 34 | ..;supplement data and convert to internal format
|
---|
| 35 | ..S FLD="" F S FLD=$O(SP(MULTIPLE,FILE,SUBFILE,FLD)) Q:FLD="" D
|
---|
| 36 | ...S EZDATA=$P(SP(MULTIPLE,FILE,SUBFILE,FLD),U,1)
|
---|
| 37 | ...S EAS(EASAPP,FILE,"+1,",FLD)=EZDATA
|
---|
| 38 | ..I FILE=408.13 D
|
---|
| 39 | ...S X=$G(EAS(EASAPP,FILE,"+1,",".03")) I X'="" D ^%DT S EAS(EASAPP,FILE,"+1,",".03")=Y
|
---|
| 40 | ...S X=$G(EAS(EASAPP,FILE,"+1,",".09")) I X'="" D
|
---|
| 41 | ....S SSN=$TR(X,"-","") S EAS(EASAPP,FILE,"+1,",".09")=SSN
|
---|
| 42 | ....I $D(^DGPR(408.13,"SSN",SSN)) S EAS(EASAPP,FILE,"+1,",".09")=""
|
---|
| 43 | ...S KEY=+$$KEY711^EASEZU1("APPLICANT SEX")
|
---|
| 44 | ...S X=$P($$DATA712^EASEZU1(EASAPP,KEY,1),U,1),SEX=$S(X="M":"F",1:"M")
|
---|
| 45 | ...S EAS(EASAPP,FILE,"+1,",".02")=SEX
|
---|
| 46 | ...S X=$G(EAS(EASAPP,FILE,"+1,","1.6")) I X'="" D
|
---|
| 47 | ....S DIC=5,DIC(0)="X" D ^DIC
|
---|
| 48 | ....S EAS(EASAPP,FILE,"+1,","1.6")=$S(+Y:+Y,1:"")
|
---|
| 49 | ..I FILE=408.12,$G(FLINK("SP",MULTIPLE,408.13)) D F40812("SP",1)
|
---|
| 50 | ..I FILE=408.21,$G(FLINK("SP",MULTIPLE,408.12)) D
|
---|
| 51 | ...S EAS(EASAPP,FILE,"+1,",".01")=INCYR
|
---|
| 52 | ...S EAS(EASAPP,FILE,"+1,",".02")=FLINK("SP",MULTIPLE,408.12)
|
---|
| 53 | ...S EAS(EASAPP,FILE,"+1,","101")=DUZ
|
---|
| 54 | ...S EAS(EASAPP,FILE,"+1,","102")=DT
|
---|
| 55 | ...S EAS(EASAPP,FILE,"+1,","103")=DUZ
|
---|
| 56 | ...S EAS(EASAPP,FILE,"+1,","104")=DT
|
---|
| 57 | ..I FILE=408.22,$G(FLINK("SP",MULTIPLE,408.21)) D
|
---|
| 58 | ...S EAS(EASAPP,FILE,"+1,",".01")=EASDFN
|
---|
| 59 | ...S EAS(EASAPP,FILE,"+1,",".02")=FLINK("SP",MULTIPLE,408.21)
|
---|
| 60 | ..I FILE'=408.12 D
|
---|
| 61 | ...S FLINK("SP",MULTIPLE,FILE)=$$NOLINK^EASEZF2(.EAS,"SP",MULTIPLE)
|
---|
| 62 | ...S FLD="" F S FLD=$O(SP(MULTIPLE,FILE,SUBFILE,FLD)) Q:FLD="" D
|
---|
| 63 | ....S $P(SP(MULTIPLE,FILE,SUBFILE,FLD),U,5)=FLINK("SP",MULTIPLE,FILE)
|
---|
| 64 | Q
|
---|
| 65 | ;
|
---|
| 66 | F40812(TYPE,MULT) ;create a new record in file #408.12
|
---|
| 67 | ;input TYPE = "SP" for Souse or "CN" for Child
|
---|
| 68 | ; MULT = always 1 for spouse; or
|
---|
| 69 | ; 1st subscript of CN array for child
|
---|
| 70 | ;can't use normal FileMan data entry
|
---|
| 71 | N C,ARR,FILE,SUBFILE,FLD,DGPRIEN,XDATE,SUBIEN,RELATE,XX,X,Y,DA,DIK,EAS,ERR
|
---|
| 72 | S DGPRIEN=""
|
---|
| 73 | S ARR=TYPE
|
---|
| 74 | S FILE=408.12,SUBFILE=408.12
|
---|
| 75 | I TYPE="SP" S RELATE=2
|
---|
| 76 | I TYPE="CN" D
|
---|
| 77 | .S X=$P($G(CN(MULT,FILE,SUBFILE,".02")),U,1)
|
---|
| 78 | .S RELATE=$S(X="SON":3,X="DAUGHTER":4,1:99)
|
---|
| 79 | ;verify that no record points to known file #408.13 record
|
---|
| 80 | S C=FLINK(TYPE,MULT,408.13)_";DGPR(408.13,"
|
---|
| 81 | I $D(^DGPR(408.12,"C",C)) S DGPRIEN=$O(^DGPR(408.12,"C",C,0))
|
---|
| 82 | ;if it does, quit w/o filing
|
---|
| 83 | Q:DGPRIEN
|
---|
| 84 | ;otherwise create a new entry
|
---|
| 85 | L +^DGPR(408.12,0):30
|
---|
| 86 | K DA,DIK
|
---|
| 87 | S DGPRIEN=$P(^DGPR(408.12,0),U,3)+1,$P(^DGPR(408.12,0),U,3)=DGPRIEN
|
---|
| 88 | S ^DGPR(408.12,DGPRIEN,0)=EASDFN_U_RELATE_U_C
|
---|
| 89 | S DA=DGPRIEN,DIK="^DGPR(408.12,",DIK(1)=".01^" D EN^DIK S DIK(1)=".03" D EN^DIK
|
---|
| 90 | S X=$P(^DGPR(408.12,0),U,4),$P(^DGPR(408.12,0),U,4)=X+1
|
---|
| 91 | L -^DGPR(408.12,0)
|
---|
| 92 | S FLINK(TYPE,MULT,408.12)=DGPRIEN
|
---|
| 93 | ;don't continue if file#408.12 record doesn't exist
|
---|
| 94 | Q:'$G(FLINK(TYPE,MULT,408.12))
|
---|
| 95 | ;store the link in subfile #712.01 record
|
---|
| 96 | S FLD="" F S FLD=$O(@ARR@(MULT,FILE,SUBFILE,FLD)) Q:FLD="" D
|
---|
| 97 | .S SUBIEN=$P(@ARR@(MULT,FILE,SUBFILE,FLD),U,3)
|
---|
| 98 | .S $P(@ARR@(MULT,FILE,SUBFILE,FLD),U,5)=FLINK(TYPE,MULT,FILE)
|
---|
| 99 | ;there's never more than one array node for subfile #408.1275; for field #.01;
|
---|
| 100 | S SUBFILE=408.1275,FLD=".01"
|
---|
| 101 | S XX=$G(@ARR@(MULT,FILE,SUBFILE,FLD))
|
---|
| 102 | K EAS
|
---|
| 103 | S XDATE=$P(XX,U,1)
|
---|
| 104 | S SUBIEN=$P(XX,U,3)
|
---|
| 105 | Q:XDATE=""
|
---|
| 106 | S X=XDATE D ^%DT S XDATE=Y
|
---|
| 107 | S EAS(EASAPP,SUBFILE,"+1,"_FLINK(TYPE,MULT,408.12)_",",".01")=XDATE
|
---|
| 108 | S EAS(EASAPP,SUBFILE,"+1,"_FLINK(TYPE,MULT,408.12)_",",".02")=1
|
---|
| 109 | S FLINK(TYPE,MULT,SUBFILE)=$$NOLINK^EASEZF2(.EAS,TYPE,MULT)
|
---|
| 110 | Q:FLINK(TYPE,MULT,SUBFILE)=""
|
---|
| 111 | ;store link to new subrecord in subfile #712.01
|
---|
| 112 | S $P(@ARR@(MULT,FILE,SUBFILE,FLD),U,5)=FLINK(TYPE,MULT,FILE)_";"_FLINK(TYPE,MULT,SUBFILE)
|
---|
| 113 | Q
|
---|