source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASEZC3.m@ 701

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

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1EASEZC3 ;ALB/jap - Compare 1010EZ Data with VistA Database (cont.) ;10/16/00 13:08
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**51**;Mar 15, 2001
3 ;
4SORT(EASAPP) ;resort ^TMP("EZDATA", to prepare for screen display
5 N KEYIEN,DATAKEY,ALL,EZDATA,DISPNM,PTDATA,EASMULT,TRNSFORM,QUES,Q1,QQ,QX,NQ,SECT,FFF,XNAME,MULT
6 K ^TMP("EZTEMP",$J),^TMP("EZDISP",$J)
7 S KEYIEN=.1 F S KEYIEN=$O(^TMP("EZDATA",$J,KEYIEN)) Q:'KEYIEN I $D(^(KEYIEN))>1 D
8 .S DATAKEY=$P(^TMP("EZDATA",$J,KEYIEN),U,4),SECT=$P(DATAKEY,";",1),QUES=$P(DATAKEY,";",2)
9 .;must use variable name EASMULT,EASRTR for any Transform
10 .S EASMULT=0 F S EASMULT=$O(^TMP("EZDATA",$J,KEYIEN,EASMULT)) Q:'EASMULT D
11 ..;here ALL=ezdata^accept^712.01ien
12 ..S ALL=$G(^TMP("EZDATA",$J,KEYIEN,EASMULT,1)),EZDATA=$P(ALL,U,1)
13 ..;ez data conversion for display
14 ..K EASRTR S TRNSFORM=$G(^EAS(711,KEYIEN,"T")) I TRNSFORM'="" X TRNSFORM S EZDATA=$G(EASRTR)
15 ..S PTDATA=$P($G(^TMP("EZDATA",$J,KEYIEN,EASMULT,2)),U,1)
16 ..I EZDATA="" S $P(^TMP("EZDATA",$J,KEYIEN,EASMULT,1),U,1)=""
17 ..Q:(EZDATA="")&(PTDATA="")
18 ..S DISPNM=$P($G(^TMP("EZDATA",$J,KEYIEN)),U,5)
19 ..S ^TMP("EZTEMP",$J,SECT,EASMULT,QUES)=KEYIEN_U_EZDATA_U_$P(ALL,U,2)_U_$P(ALL,U,3)_U_PTDATA
20 ..Q:$$SUPPRESS^EASEZU4(EASAPP,DATAKEY,0,EASVRSN) ;alb/cmf/51
21 ..;set another array so questions fall in proper display order
22 ..I QUES=+QUES D Q
23 ...S ^TMP("EZDISP",$J,SECT,EASMULT,QUES,0)=^TMP("EZTEMP",$J,SECT,EASMULT,QUES)_U_DISPNM
24 ..S Q1=$E(QUES,1) I Q1=+QUES D Q
25 ...S QX=$E(QUES,2,99) S:QX="." QX=0
26 ...S ^TMP("EZDISP",$J,SECT,EASMULT,Q1,QX)=^TMP("EZTEMP",$J,SECT,EASMULT,QUES)_U_DISPNM
27 ..S Q1=$E(QUES,1,2) I Q1=+QUES D
28 ...S QX=$E(QUES,3,99) S:QX="." QX=0
29 ...S ^TMP("EZDISP",$J,SECT,EASMULT,Q1,QX)=^TMP("EZTEMP",$J,SECT,EASMULT,QUES)_U_DISPNM
30 ;rearrange Section IIA
31 S SECT="IIA",MULT=1,QQ="" F S QQ=$O(^TMP("EZDISP",$J,SECT,MULT,QQ)) Q:QQ>99 Q:QQ="" D
32 .S XNAME=$P(^TMP("EZDISP",$J,SECT,MULT,QQ,0),U,6),NQ=$S(XNAME["Sp.":100,1:200)
33 .S ^TMP("EZDISP",$J,SECT,MULT,NQ,QQ)=^TMP("EZDISP",$J,SECT,MULT,QQ,0)
34 .K ^TMP("EZDISP",$J,SECT,MULT,QQ,0)
35 Q
36 ;
37OUT ;output current contents of ^TMP("EZTEMP",
38 ;only used for development from programmer mode
39 N S,M,OLDM,QUES,Q1,QX,KEYIEN,DISPNM,EZDATA,PTDATA,X
40 S S="" F S S=$O(^TMP("EZDISP",$J,S)) Q:S="" D
41 .W !!!,"SECTION "_S
42 .S M=0,OLDM=0 F S M=$O(^TMP("EZDISP",$J,S,M)) Q:'M D
43 ..I M'=OLDM W !
44 ..S OLDM=M
45 ..S Q1="" F S Q1=$O(^TMP("EZDISP",$J,S,M,Q1)) Q:Q1="" S QX="" F S QX=$O(^TMP("EZDISP",$J,S,M,Q1,QX)) Q:QX="" D
46 ...S (EZDATA,PTDATA)=""
47 ...S X=^TMP("EZDISP",$J,S,M,Q1,QX),KEYIEN=$P(X,U,1),EZDATA=$P(X,U,2),PTDATA=$P(X,U,5),DISPNM=$P(X,U,6)
48 ...I Q1>99 S QUES=QX_"."
49 ...E S QUES=Q1_$S(QX=0:".",1:QX)
50 ...W !,"QUESTION "_QUES_" "_DISPNM
51 ...W !,?3,"1010EZ : "_EZDATA
52 ...W !,?3,"VistA : "_PTDATA
53 Q
54 ;
55C202 ;alb/cmf/51 place race info into local711 array
56 N M,B,VDATA,KEY,RAC
57 D GETS^DIQ(2,EASDFN_",","2*","","RAC")
58 Q:'$D(RAC)
59 D D202("APPLICANT RACE - AMERICAN INDIAN OR ALASKA NATIVE","AMERI")
60 D D202("APPLICANT RACE - BLACK OR AFRICAN AMERICAN","BLACK")
61 D D202("APPLICANT RACE - HAWAIIAN OR PAC ISLANDER","NATIV")
62 D D202("APPLICANT RACE - ASIAN","ASIAN")
63 D D202("APPLICANT RACE - WHITE","WHITE")
64 D D202("APPLICANT RACE - UNANSWERED","UNKNO")
65 Q
66 ;
67D202(AKEY,ARACE) ;
68 S KEY=+$$KEY711^EASEZU1(AKEY)
69 S M=0 F S M=$O(^TMP("EZDATA",$J,KEY,M)) Q:'M D
70 .S VDATA=""
71 .S B=$$Q202(ARACE) I +B S VDATA="YES"_$P(B,U,2)
72 .S $P(^TMP("EZDATA",$J,KEY,M,2),U,1)=VDATA
73 Q
74 ;
75Q202(X) ;
76 N I,FLAG
77 S FLAG=0
78 Q:'$D(RAC) FLAG
79 D:'$D(RAC("B"))
80 .S I=""
81 .F S I=$O(RAC(2.02,I)) Q:I="" D
82 ..S RAC("B",$E(RAC(2.02,I,.01),1,5))=$E(RAC(2.02,I,.02),1)
83 I $D(RAC("B",X)) S FLAG=1_U_" ("_RAC("B",X)_")"
84 ;S I=""
85 ;F S I=$O(RAC(2.02,I)) Q:(I="")!(+FLAG) D
86 ;.I $E(RAC(2.02,I,.01),1,5)=X S FLAG=1_U_" ("_$E(RAC(2.02,I,.02),1)_")"
87 Q FLAG
88 ;
89C206 ;alb/cmf/51 place ethnicity info into local711 array
90 N X,M,B,VDATA,KEY,ETH
91 D GETS^DIQ(2,EASDFN_",","6*","","ETH")
92 Q:'$D(ETH)
93 S KEY=+$$KEY711^EASEZU1("APPLICANT SPANISH, HISPANIC, OR LATIN")
94 S M=0 F S M=$O(^TMP("EZDATA",$J,KEY,M)) Q:'M D
95 .S VDATA="",B=""
96 .D S $P(^TMP("EZDATA",$J,KEY,M,2),U,1)=VDATA
97 ..S B=$$Q206("NOT") I +B S VDATA="NO"_$P(B,U,2) Q
98 ..S B=$$Q206("HIS") I +B S VDATA="YES"_$P(B,U,2) Q
99 ..S B=$$Q206("DEC") I +B S VDATA="DECLINED"_$P(B,U,2) Q
100 ..S B=$$Q206("UNK") I +B S VDATA="UNKNOWN"_$P(B,U,2) Q
101 ..Q
102 .Q
103 Q
104 ;
105Q206(X) ;
106 N I,FLAG
107 S FLAG=0
108 Q:'$D(ETH) FLAG
109 D:'$D(ETH("B"))
110 .S I=""
111 .F S I=$O(ETH(2.06,I)) Q:I="" D
112 ..S ETH("B",$E(ETH(2.06,I,.01),1,3))=$E(ETH(2.06,I,.02),1)
113 I $D(ETH("B",X)) S FLAG=1_U_" ("_ETH("B",X)_")"
114 ;S I=""
115 ;F S I=$O(ETH(2.06,I)) Q:(I="")!(+FLAG) D
116 ;.I $E(ETH(2.06,I,.01),1,3)=X S FLAG=1_U_" ("_$E(ETH(2.06,I,.02),1)_")"
117 Q FLAG
118 ;
Note: See TracBrowser for help on using the repository browser.