source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASEZF4.m@ 1211

Last change on this file since 1211 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.4 KB
RevLine 
[613]1EASEZF4 ;ALB/jap - Filing 1010EZ Data to Patient Database ;10/31/00 13:07
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**1,51,57**;Mar 15, 2001
3 ;
4CN ;file Dependent/Child data
5 N MULTIPLE,FILE,SUBFILE,FLD,XDATA,ACCEPT,SUBIEN,SEX,SSN,EZDATA,EAS,ERR,X,Y
6 ;process sequence must be 408.13 - 408.12 - 408.21 - 408.22
7 S MULTIPLE=0 F S MULTIPLE=$O(CN(MULTIPLE)) Q:'MULTIPLE F FILE=408.13,408.12,408.21,408.22 D
8 . S SUBFILE=FILE,FLD=""
9 . S XLINK=$G(FLINK("CN",MULTIPLE,FILE))
10 . ;record in file #408.13 is needed for all further data filng
11 . Q:(FILE'=408.13)&('$G(FLINK("CN",MULTIPLE,408.13)))
12 . ;for data elements with link to database,
13 . ;only file 1010EZ data if accepted by user;
14 . ;data in external format
15 . I XLINK D
16 . . ;when #408.12 record exists, don't try to update subfile #408.1275
17 . . S FLD="" F S FLD=$O(CN(MULTIPLE,FILE,SUBFILE,FLD)) Q:FLD="" D
18 . . . S XDATA=CN(MULTIPLE,FILE,SUBFILE,FLD),ACCEPT=$P(XDATA,U,2)
19 . . . I FILE=408.13,FLD=.09 S XDATA=$TR(XDATA,"-","")
20 . . . I ACCEPT D LINK^EASEZF2(XDATA,FILE,FLD,"CN",MULTIPLE)
21 . ;for data elements with no link to database,
22 . ;always create new record(s) to store 1010EZ data;
23 . ;put data in internal format
24 . I 'XLINK D
25 . . K EAS,ERR
26 . . S FLD="" F S FLD=$O(CN(MULTIPLE,FILE,SUBFILE,FLD)) Q:FLD="" D
27 . . . S EZDATA=$P(CN(MULTIPLE,FILE,SUBFILE,FLD),U,1)
28 . . . S EAS(EASAPP,FILE,"+1,",FLD)=EZDATA
29 . . ;supplement data and convert to internal format
30 . . I FILE=408.13 D
31 . . . S X=$G(EAS(EASAPP,FILE,"+1,",".03")) I X'="" D ^%DT S EAS(EASAPP,FILE,"+1,",".03")=Y
32 . . . S X=$G(EAS(EASAPP,FILE,"+1,",".09")) I X'="" D
33 . . . . S SSN=$TR(X,"-","") S EAS(EASAPP,FILE,"+1,",".09")=SSN
34 . . . . I $D(^DGPR(408.13,"SSN",SSN)) S EAS(EASAPP,FILE,"+1,",".09")=""
35 . . . S X=$P($G(CN(MULTIPLE,408.12,408.12,.02)),U,1) S SEX=$S(X["SON":"M",X["DAUGHTER":"F",1:"")
36 . . . I SEX'="" S EAS(EASAPP,FILE,"+1,",".02")=SEX
37 . . I FILE=408.12,$G(FLINK("CN",MULTIPLE,408.13)) D F40812^EASEZF3("CN",MULTIPLE)
38 . . I FILE=408.21,$G(FLINK("CN",MULTIPLE,408.12)) D
39 . . . S EAS(EASAPP,FILE,"+1,",".01")=INCYR
40 . . . S EAS(EASAPP,FILE,"+1,",".02")=FLINK("CN",MULTIPLE,408.12)
41 . . . S EAS(EASAPP,FILE,"+1,","101")=DUZ
42 . . . S EAS(EASAPP,FILE,"+1,","102")=DT
43 . . . S EAS(EASAPP,FILE,"+1,","103")=DUZ
44 . . . S EAS(EASAPP,FILE,"+1,","104")=DT
45 . . I FILE=408.22,$G(FLINK("CN",MULTIPLE,408.21)) D
46 . . . S EAS(EASAPP,FILE,"+1,",".01")=EASDFN
47 . . . S EAS(EASAPP,FILE,"+1,",".02")=FLINK("CN",MULTIPLE,408.21)
48 . . . S X=$P($G(CN(MULTIPLE,FILE,SUBFILE,".1")),U,1) I X S EAS(EASAPP,FILE,"+1,",".1")="Y"
49 . . . ;EAS*1.0*57 - ALLOW NULL VALUES FOR .09 AND .18
50 . . . S X=$P($G(CN(MULTIPLE,FILE,SUBFILE,".09")),U,1),EAS(EASAPP,FILE,"+1,",".09")=$S(X["Y":1,X["N":0,1:"")
51 . . . S X=$P($G(CN(MULTIPLE,408.21,408.21,".14")),U,1) I X S EAS(EASAPP,FILE,"+1,",".11")=1
52 . . . S X=$P($G(CN(MULTIPLE,FILE,SUBFILE,".18")),U,1),EAS(EASAPP,FILE,"+1,",".18")=$S(X["Y":1,X["N":0,1:"")
53 . . . S X=$G(EAS(EASAPP,FILE,"+1,",".1"))
54 . . . S EAS(EASAPP,FILE,"+1,",".1")=$S(X="YES":1,X="NO":0,1:"")
55 . . . S X=$G(EAS(EASAPP,FILE,"+1,",".06"))
56 . . . S EAS(EASAPP,FILE,"+1,",".06")=$S(X="YES":1,X="NO":0,1:"")
57 . . I FILE'=408.12 D
58 . . . S FLINK("CN",MULTIPLE,FILE)=$$NOLINK^EASEZF2(.EAS)
59 . . . S FLD="" F S FLD=$O(CN(MULTIPLE,FILE,SUBFILE,FLD)) Q:FLD="" D
60 . . . . S $P(CN(MULTIPLE,FILE,SUBFILE,FLD),U,5)=FLINK("CN",MULTIPLE,FILE)
61 Q
62 ;
63LINKUP ;
64 N SUBIEN,KEYIEN,MULTIPLE,FILE,SUBFILE,FIELD,DATAKEY,DATANM,TYPE,LINK,X
65 S SUBIEN=0 F S SUBIEN=$O(^EAS(712,EASAPP,10,SUBIEN)) Q:+SUBIEN=0 D
66 . S X=$G(^EAS(712,EASAPP,10,SUBIEN,1))
67 . ;quit if no data to file
68 . Q:(($P(X,U,1)="")&($P(X,U,2)=""))
69 . S TYPE=""
70 . S KEYIEN=$P(^EAS(712,EASAPP,10,SUBIEN,0),U,1),MULTIPLE=$P(^(0),U,2)
71 . 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)
72 . Q:FILE<408
73 . Q:FILE>408.22
74 . I SUBFILE=408.1275 S FILE=SUBFILE
75 . I DATANM["CHILD" S TYPE="CN"
76 . I DATANM["CHILD(N)" D
77 . . ;necessary because some version 6 income data for child1 is brought-in via a child(n) multiple
78 . . S MULTIPLE=MULTIPLE+1
79 . . Q:$G(EASVRSN)<6
80 . . I FILE=408.21,(".08;.14;.17"[FIELD) S MULTIPLE=MULTIPLE-1
81 . I DATANM["SPOUSE" S TYPE="SP"
82 . I TYPE="" S TYPE="AP"
83 . S LINK=$G(FLINK(TYPE,MULTIPLE,FILE))
84 . Q:'LINK
85 . Q:$$SUPPRESS^EASEZU4(EASAPP,DATAKEY,1,$G(EASVRSN))
86 . I FILE=408.1275 S LINK=FLINK(TYPE,MULTIPLE,408.12)_";"_FLINK(TYPE,MULTIPLE,FILE)
87 . S $P(^EAS(712,EASAPP,10,SUBIEN,2),U,2)=LINK
88 Q
Note: See TracBrowser for help on using the repository browser.