EASEZC3 ;ALB/jap/pjh - Compare 1010EZ Data with VistA Database (cont.) ; 11/5/09 4:49pm
;;1.0;ENROLLMENT APPLICATION SYSTEM;**51,92**;Mar 15, 2001;Build 20
;
SORT(EASAPP) ;resort ^TMP("EZDATA", to prepare for screen display
N KEYIEN,DATAKEY,ALL,EZDATA,DISPNM,PTDATA,EASMULT,TRNSFORM,QUES,Q1,QQ,QX,NQ,SECT,FFF,XNAME,MULT
K ^TMP("EZTEMP",$J),^TMP("EZDISP",$J)
S KEYIEN=.1 F S KEYIEN=$O(^TMP("EZDATA",$J,KEYIEN)) Q:'KEYIEN I $D(^(KEYIEN))>1 D
.S DATAKEY=$P(^TMP("EZDATA",$J,KEYIEN),U,4),SECT=$P(DATAKEY,";",1),QUES=$P(DATAKEY,";",2)
.;must use variable name EASMULT,EASRTR for any Transform
.S EASMULT=0 F S EASMULT=$O(^TMP("EZDATA",$J,KEYIEN,EASMULT)) Q:'EASMULT D
..;here ALL=ezdata^accept^712.01ien
..S ALL=$G(^TMP("EZDATA",$J,KEYIEN,EASMULT,1)),EZDATA=$P(ALL,U,1)
..;ez data conversion for display
..K EASRTR S TRNSFORM=$G(^EAS(711,KEYIEN,"T")) I TRNSFORM'="" X TRNSFORM S EZDATA=$G(EASRTR)
..S PTDATA=$P($G(^TMP("EZDATA",$J,KEYIEN,EASMULT,2)),U,1)
..I EZDATA="" S $P(^TMP("EZDATA",$J,KEYIEN,EASMULT,1),U,1)=""
..Q:(EZDATA="")&(PTDATA="")
..S DISPNM=$P($G(^TMP("EZDATA",$J,KEYIEN)),U,5)
..S ^TMP("EZTEMP",$J,SECT,EASMULT,QUES)=KEYIEN_U_EZDATA_U_$P(ALL,U,2)_U_$P(ALL,U,3)_U_PTDATA
..Q:$$SUPPRESS^EASEZU4(EASAPP,DATAKEY,0,EASVRSN) ;alb/cmf/51
..;set another array so questions fall in proper display order
..I QUES=+QUES D Q
...S ^TMP("EZDISP",$J,SECT,EASMULT,QUES,0)=^TMP("EZTEMP",$J,SECT,EASMULT,QUES)_U_DISPNM
..S Q1=$E(QUES,1) I Q1=+QUES D Q
...S QX=$E(QUES,2,99) S:QX="." QX=0
...S ^TMP("EZDISP",$J,SECT,EASMULT,Q1,QX)=^TMP("EZTEMP",$J,SECT,EASMULT,QUES)_U_DISPNM
..S Q1=$E(QUES,1,2) I Q1=+QUES D
...S QX=$E(QUES,3,99) S:QX="." QX=0
...S ^TMP("EZDISP",$J,SECT,EASMULT,Q1,QX)=^TMP("EZTEMP",$J,SECT,EASMULT,QUES)_U_DISPNM
;rearrange Section IIA
S SECT="IIA",MULT=1,QQ="" F S QQ=$O(^TMP("EZDISP",$J,SECT,MULT,QQ)) Q:QQ>99 Q:QQ="" D
.S XNAME=$P(^TMP("EZDISP",$J,SECT,MULT,QQ,0),U,6),NQ=$S(XNAME["Sp.":100,1:200)
.S ^TMP("EZDISP",$J,SECT,MULT,NQ,QQ)=^TMP("EZDISP",$J,SECT,MULT,QQ,0)
.K ^TMP("EZDISP",$J,SECT,MULT,QQ,0)
Q
;
OUT ;output current contents of ^TMP("EZTEMP",
;only used for development from programmer mode
N S,M,OLDM,QUES,Q1,QX,KEYIEN,DISPNM,EZDATA,PTDATA,X
S S="" F S S=$O(^TMP("EZDISP",$J,S)) Q:S="" D
.W !!!,"SECTION "_S
.S M=0,OLDM=0 F S M=$O(^TMP("EZDISP",$J,S,M)) Q:'M D
..I M'=OLDM W !
..S OLDM=M
..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
...S (EZDATA,PTDATA)=""
...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)
...I Q1>99 S QUES=QX_"."
...E S QUES=Q1_$S(QX=0:".",1:QX)
...W !,"QUESTION "_QUES_" "_DISPNM
...W !,?3,"1010EZ : "_EZDATA
...W !,?3,"VistA : "_PTDATA
Q
;
C202 ;alb/cmf/51 place race info into local711 array
N M,B,VDATA,KEY,RAC
D GETS^DIQ(2,EASDFN_",","2*","","RAC")
Q:'$D(RAC)
D D202("APPLICANT RACE - AMERICAN INDIAN OR ALASKA NATIVE","AMERI")
D D202("APPLICANT RACE - BLACK OR AFRICAN AMERICAN","BLACK")
D D202("APPLICANT RACE - HAWAIIAN OR PAC ISLANDER","NATIV")
D D202("APPLICANT RACE - ASIAN","ASIAN")
D D202("APPLICANT RACE - WHITE","WHITE")
D D202("APPLICANT RACE - UNANSWERED","UNKNO")
Q
;
D202(AKEY,ARACE) ;
S KEY=+$$KEY711^EASEZU1(AKEY)
S M=0 F S M=$O(^TMP("EZDATA",$J,KEY,M)) Q:'M D
.S VDATA=""
.S B=$$Q202(ARACE) I +B S VDATA="YES"_$P(B,U,2)
.S $P(^TMP("EZDATA",$J,KEY,M,2),U,1)=VDATA
Q
;
Q202(X) ;
N I,FLAG
S FLAG=0
Q:'$D(RAC) FLAG
D:'$D(RAC("B"))
.S I=""
.F S I=$O(RAC(2.02,I)) Q:I="" D
..S RAC("B",$E(RAC(2.02,I,.01),1,5))=$E(RAC(2.02,I,.02),1)
I $D(RAC("B",X)) S FLAG=1_U_" ("_RAC("B",X)_")"
;S I=""
;F S I=$O(RAC(2.02,I)) Q:(I="")!(+FLAG) D
;.I $E(RAC(2.02,I,.01),1,5)=X S FLAG=1_U_" ("_$E(RAC(2.02,I,.02),1)_")"
Q FLAG
;
C206 ;alb/cmf/51 place ethnicity info into local711 array
N X,M,B,VDATA,KEY,ETH
D GETS^DIQ(2,EASDFN_",","6*","","ETH")
Q:'$D(ETH)
S KEY=+$$KEY711^EASEZU1("APPLICANT SPANISH, HISPANIC, OR LATIN")
S M=0 F S M=$O(^TMP("EZDATA",$J,KEY,M)) Q:'M D
.S VDATA="",B=""
.D S $P(^TMP("EZDATA",$J,KEY,M,2),U,1)=VDATA
..S B=$$Q206("NOT") I +B S VDATA="NO"_$P(B,U,2) Q
..S B=$$Q206("HIS") I +B S VDATA="YES"_$P(B,U,2) Q
..S B=$$Q206("DEC") I +B S VDATA="DECLINED"_$P(B,U,2) Q
..S B=$$Q206("UNK") I +B S VDATA="UNKNOWN"_$P(B,U,2) Q
..Q
.Q
Q
;
Q206(X) ;
N I,FLAG
S FLAG=0
Q:'$D(ETH) FLAG
D:'$D(ETH("B"))
.S I=""
.F S I=$O(ETH(2.06,I)) Q:I="" D
..S ETH("B",$E(ETH(2.06,I,.01),1,3))=$E(ETH(2.06,I,.02),1)
I $D(ETH("B",X)) S FLAG=1_U_" ("_ETH("B",X)_")"
;S I=""
;F S I=$O(ETH(2.06,I)) Q:(I="")!(+FLAG) D
;.I $E(ETH(2.06,I,.01),1,3)=X S FLAG=1_U_" ("_$E(ETH(2.06,I,.02),1)_")"
Q FLAG
;
C3216 ;Military Service
;
;Use old VistA data if no new format data present
I '$D(^DPT(EASDFN,.3216)) D MOVMSE^DGMSEUTL(EASDFN)
;Get most recent episode
S X=$O(^DPT(EASDFN,.3216,"B",""),-1) Q:'X
S X=$O(^DPT(EASDFN,.3216,"B",X,"")) Q:'X
;Extract fields from most recent episode as [LAST]
S KEY=+$$KEY711^EASEZU1("LAST ENTRY DATE")
S VDATA=$$GET^EASEZC1(EASDFN_";"_+X,"2^2.3216^.01")
I (VDATA=-1)!(VDATA="") S VDATA="UNKNOWN"
S ^TMP("EZDATA",$J,KEY,1,2)=VDATA
S KEY=+$$KEY711^EASEZU1("LAST DISCHARGE DATE")
S VDATA=$$GET^EASEZC1(EASDFN_";"_+X,"2^2.3216^.02")
I (VDATA=-1)!(VDATA="") S VDATA="UNKNOWN"
S ^TMP("EZDATA",$J,KEY,1,2)=VDATA
S KEY=+$$KEY711^EASEZU1("LAST BRANCH OF SERVICE")
S VDATA=$$GET^EASEZC1(EASDFN_";"_+X,"2^2.3216^.03")
I (VDATA=-1)!(VDATA="") S VDATA="UNKNOWN"
S ^TMP("EZDATA",$J,KEY,1,2)=VDATA
S KEY=+$$KEY711^EASEZU1("SERVICE NUMBER")
S VDATA=$$GET^EASEZC1(EASDFN_";"_+X,"2^2.3216^.05")
I (VDATA=-1)!(VDATA="") S VDATA="UNKNOWN"
S ^TMP("EZDATA",$J,KEY,1,2)=VDATA
S KEY=+$$KEY711^EASEZU1("LAST DISCHARGE TYPE")
S VDATA=$$GET^EASEZC1(EASDFN_";"_+X,"2^2.3216^.06")
I (VDATA=-1)!(VDATA="") S VDATA="UNKNOWN"
S ^TMP("EZDATA",$J,KEY,1,2)=VDATA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASEZC3 6050 printed Dec 13, 2024@01:54:25 Page 2
EASEZC3 ;ALB/jap/pjh - Compare 1010EZ Data with VistA Database (cont.) ; 11/5/09 4:49pm
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**51,92**;Mar 15, 2001;Build 20
+2 ;
SORT(EASAPP) ;resort ^TMP("EZDATA", to prepare for screen display
+1 NEW KEYIEN,DATAKEY,ALL,EZDATA,DISPNM,PTDATA,EASMULT,TRNSFORM,QUES,Q1,QQ,QX,NQ,SECT,FFF,XNAME,MULT
+2 KILL ^TMP("EZTEMP",$JOB),^TMP("EZDISP",$JOB)
+3 SET KEYIEN=.1
FOR
SET KEYIEN=$ORDER(^TMP("EZDATA",$JOB,KEYIEN))
if 'KEYIEN
QUIT
IF $DATA(^(KEYIEN))>1
Begin DoDot:1
+4 SET DATAKEY=$PIECE(^TMP("EZDATA",$JOB,KEYIEN),U,4)
SET SECT=$PIECE(DATAKEY,";",1)
SET QUES=$PIECE(DATAKEY,";",2)
+5 ;must use variable name EASMULT,EASRTR for any Transform
+6 SET EASMULT=0
FOR
SET EASMULT=$ORDER(^TMP("EZDATA",$JOB,KEYIEN,EASMULT))
if 'EASMULT
QUIT
Begin DoDot:2
+7 ;here ALL=ezdata^accept^712.01ien
+8 SET ALL=$GET(^TMP("EZDATA",$JOB,KEYIEN,EASMULT,1))
SET EZDATA=$PIECE(ALL,U,1)
+9 ;ez data conversion for display
+10 KILL EASRTR
SET TRNSFORM=$GET(^EAS(711,KEYIEN,"T"))
IF TRNSFORM'=""
XECUTE TRNSFORM
SET EZDATA=$GET(EASRTR)
+11 SET PTDATA=$PIECE($GET(^TMP("EZDATA",$JOB,KEYIEN,EASMULT,2)),U,1)
+12 IF EZDATA=""
SET $PIECE(^TMP("EZDATA",$JOB,KEYIEN,EASMULT,1),U,1)=""
+13 if (EZDATA="")&(PTDATA="")
QUIT
+14 SET DISPNM=$PIECE($GET(^TMP("EZDATA",$JOB,KEYIEN)),U,5)
+15 SET ^TMP("EZTEMP",$JOB,SECT,EASMULT,QUES)=KEYIEN_U_EZDATA_U_$PIECE(ALL,U,2)_U_$PIECE(ALL,U,3)_U_PTDATA
+16 ;alb/cmf/51
if $$SUPPRESS^EASEZU4(EASAPP,DATAKEY,0,EASVRSN)
QUIT
+17 ;set another array so questions fall in proper display order
+18 IF QUES=+QUES
Begin DoDot:3
+19 SET ^TMP("EZDISP",$JOB,SECT,EASMULT,QUES,0)=^TMP("EZTEMP",$JOB,SECT,EASMULT,QUES)_U_DISPNM
End DoDot:3
QUIT
+20 SET Q1=$EXTRACT(QUES,1)
IF Q1=+QUES
Begin DoDot:3
+21 SET QX=$EXTRACT(QUES,2,99)
if QX="."
SET QX=0
+22 SET ^TMP("EZDISP",$JOB,SECT,EASMULT,Q1,QX)=^TMP("EZTEMP",$JOB,SECT,EASMULT,QUES)_U_DISPNM
End DoDot:3
QUIT
+23 SET Q1=$EXTRACT(QUES,1,2)
IF Q1=+QUES
Begin DoDot:3
+24 SET QX=$EXTRACT(QUES,3,99)
if QX="."
SET QX=0
+25 SET ^TMP("EZDISP",$JOB,SECT,EASMULT,Q1,QX)=^TMP("EZTEMP",$JOB,SECT,EASMULT,QUES)_U_DISPNM
End DoDot:3
End DoDot:2
End DoDot:1
+26 ;rearrange Section IIA
+27 SET SECT="IIA"
SET MULT=1
SET QQ=""
FOR
SET QQ=$ORDER(^TMP("EZDISP",$JOB,SECT,MULT,QQ))
if QQ>99
QUIT
if QQ=""
QUIT
Begin DoDot:1
+28 SET XNAME=$PIECE(^TMP("EZDISP",$JOB,SECT,MULT,QQ,0),U,6)
SET NQ=$SELECT(XNAME["Sp.":100,1:200)
+29 SET ^TMP("EZDISP",$JOB,SECT,MULT,NQ,QQ)=^TMP("EZDISP",$JOB,SECT,MULT,QQ,0)
+30 KILL ^TMP("EZDISP",$JOB,SECT,MULT,QQ,0)
End DoDot:1
+31 QUIT
+32 ;
OUT ;output current contents of ^TMP("EZTEMP",
+1 ;only used for development from programmer mode
+2 NEW S,M,OLDM,QUES,Q1,QX,KEYIEN,DISPNM,EZDATA,PTDATA,X
+3 SET S=""
FOR
SET S=$ORDER(^TMP("EZDISP",$JOB,S))
if S=""
QUIT
Begin DoDot:1
+4 WRITE !!!,"SECTION "_S
+5 SET M=0
SET OLDM=0
FOR
SET M=$ORDER(^TMP("EZDISP",$JOB,S,M))
if 'M
QUIT
Begin DoDot:2
+6 IF M'=OLDM
WRITE !
+7 SET OLDM=M
+8 SET Q1=""
FOR
SET Q1=$ORDER(^TMP("EZDISP",$JOB,S,M,Q1))
if Q1=""
QUIT
SET QX=""
FOR
SET QX=$ORDER(^TMP("EZDISP",$JOB,S,M,Q1,QX))
if QX=""
QUIT
Begin DoDot:3
+9 SET (EZDATA,PTDATA)=""
+10 SET X=^TMP("EZDISP",$JOB,S,M,Q1,QX)
SET KEYIEN=$PIECE(X,U,1)
SET EZDATA=$PIECE(X,U,2)
SET PTDATA=$PIECE(X,U,5)
SET DISPNM=$PIECE(X,U,6)
+11 IF Q1>99
SET QUES=QX_"."
+12 IF '$TEST
SET QUES=Q1_$SELECT(QX=0:".",1:QX)
+13 WRITE !,"QUESTION "_QUES_" "_DISPNM
+14 WRITE !,?3,"1010EZ : "_EZDATA
+15 WRITE !,?3,"VistA : "_PTDATA
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
C202 ;alb/cmf/51 place race info into local711 array
+1 NEW M,B,VDATA,KEY,RAC
+2 DO GETS^DIQ(2,EASDFN_",","2*","","RAC")
+3 if '$DATA(RAC)
QUIT
+4 DO D202("APPLICANT RACE - AMERICAN INDIAN OR ALASKA NATIVE","AMERI")
+5 DO D202("APPLICANT RACE - BLACK OR AFRICAN AMERICAN","BLACK")
+6 DO D202("APPLICANT RACE - HAWAIIAN OR PAC ISLANDER","NATIV")
+7 DO D202("APPLICANT RACE - ASIAN","ASIAN")
+8 DO D202("APPLICANT RACE - WHITE","WHITE")
+9 DO D202("APPLICANT RACE - UNANSWERED","UNKNO")
+10 QUIT
+11 ;
D202(AKEY,ARACE) ;
+1 SET KEY=+$$KEY711^EASEZU1(AKEY)
+2 SET M=0
FOR
SET M=$ORDER(^TMP("EZDATA",$JOB,KEY,M))
if 'M
QUIT
Begin DoDot:1
+3 SET VDATA=""
+4 SET B=$$Q202(ARACE)
IF +B
SET VDATA="YES"_$PIECE(B,U,2)
+5 SET $PIECE(^TMP("EZDATA",$JOB,KEY,M,2),U,1)=VDATA
End DoDot:1
+6 QUIT
+7 ;
Q202(X) ;
+1 NEW I,FLAG
+2 SET FLAG=0
+3 if '$DATA(RAC)
QUIT FLAG
+4 if '$DATA(RAC("B"))
Begin DoDot:1
+5 SET I=""
+6 FOR
SET I=$ORDER(RAC(2.02,I))
if I=""
QUIT
Begin DoDot:2
+7 SET RAC("B",$EXTRACT(RAC(2.02,I,.01),1,5))=$EXTRACT(RAC(2.02,I,.02),1)
End DoDot:2
End DoDot:1
+8 IF $DATA(RAC("B",X))
SET FLAG=1_U_" ("_RAC("B",X)_")"
+9 ;S I=""
+10 ;F S I=$O(RAC(2.02,I)) Q:(I="")!(+FLAG) D
+11 ;.I $E(RAC(2.02,I,.01),1,5)=X S FLAG=1_U_" ("_$E(RAC(2.02,I,.02),1)_")"
+12 QUIT FLAG
+13 ;
C206 ;alb/cmf/51 place ethnicity info into local711 array
+1 NEW X,M,B,VDATA,KEY,ETH
+2 DO GETS^DIQ(2,EASDFN_",","6*","","ETH")
+3 if '$DATA(ETH)
QUIT
+4 SET KEY=+$$KEY711^EASEZU1("APPLICANT SPANISH, HISPANIC, OR LATIN")
+5 SET M=0
FOR
SET M=$ORDER(^TMP("EZDATA",$JOB,KEY,M))
if 'M
QUIT
Begin DoDot:1
+6 SET VDATA=""
SET B=""
+7 Begin DoDot:2
+8 SET B=$$Q206("NOT")
IF +B
SET VDATA="NO"_$PIECE(B,U,2)
QUIT
+9 SET B=$$Q206("HIS")
IF +B
SET VDATA="YES"_$PIECE(B,U,2)
QUIT
+10 SET B=$$Q206("DEC")
IF +B
SET VDATA="DECLINED"_$PIECE(B,U,2)
QUIT
+11 SET B=$$Q206("UNK")
IF +B
SET VDATA="UNKNOWN"_$PIECE(B,U,2)
QUIT
+12 QUIT
End DoDot:2
SET $PIECE(^TMP("EZDATA",$JOB,KEY,M,2),U,1)=VDATA
+13 QUIT
End DoDot:1
+14 QUIT
+15 ;
Q206(X) ;
+1 NEW I,FLAG
+2 SET FLAG=0
+3 if '$DATA(ETH)
QUIT FLAG
+4 if '$DATA(ETH("B"))
Begin DoDot:1
+5 SET I=""
+6 FOR
SET I=$ORDER(ETH(2.06,I))
if I=""
QUIT
Begin DoDot:2
+7 SET ETH("B",$EXTRACT(ETH(2.06,I,.01),1,3))=$EXTRACT(ETH(2.06,I,.02),1)
End DoDot:2
End DoDot:1
+8 IF $DATA(ETH("B",X))
SET FLAG=1_U_" ("_ETH("B",X)_")"
+9 ;S I=""
+10 ;F S I=$O(ETH(2.06,I)) Q:(I="")!(+FLAG) D
+11 ;.I $E(ETH(2.06,I,.01),1,3)=X S FLAG=1_U_" ("_$E(ETH(2.06,I,.02),1)_")"
+12 QUIT FLAG
+13 ;
C3216 ;Military Service
+1 ;
+2 ;Use old VistA data if no new format data present
+3 IF '$DATA(^DPT(EASDFN,.3216))
DO MOVMSE^DGMSEUTL(EASDFN)
+4 ;Get most recent episode
+5 SET X=$ORDER(^DPT(EASDFN,.3216,"B",""),-1)
if 'X
QUIT
+6 SET X=$ORDER(^DPT(EASDFN,.3216,"B",X,""))
if 'X
QUIT
+7 ;Extract fields from most recent episode as [LAST]
+8 SET KEY=+$$KEY711^EASEZU1("LAST ENTRY DATE")
+9 SET VDATA=$$GET^EASEZC1(EASDFN_";"_+X,"2^2.3216^.01")
+10 IF (VDATA=-1)!(VDATA="")
SET VDATA="UNKNOWN"
+11 SET ^TMP("EZDATA",$JOB,KEY,1,2)=VDATA
+12 SET KEY=+$$KEY711^EASEZU1("LAST DISCHARGE DATE")
+13 SET VDATA=$$GET^EASEZC1(EASDFN_";"_+X,"2^2.3216^.02")
+14 IF (VDATA=-1)!(VDATA="")
SET VDATA="UNKNOWN"
+15 SET ^TMP("EZDATA",$JOB,KEY,1,2)=VDATA
+16 SET KEY=+$$KEY711^EASEZU1("LAST BRANCH OF SERVICE")
+17 SET VDATA=$$GET^EASEZC1(EASDFN_";"_+X,"2^2.3216^.03")
+18 IF (VDATA=-1)!(VDATA="")
SET VDATA="UNKNOWN"
+19 SET ^TMP("EZDATA",$JOB,KEY,1,2)=VDATA
+20 SET KEY=+$$KEY711^EASEZU1("SERVICE NUMBER")
+21 SET VDATA=$$GET^EASEZC1(EASDFN_";"_+X,"2^2.3216^.05")
+22 IF (VDATA=-1)!(VDATA="")
SET VDATA="UNKNOWN"
+23 SET ^TMP("EZDATA",$JOB,KEY,1,2)=VDATA
+24 SET KEY=+$$KEY711^EASEZU1("LAST DISCHARGE TYPE")
+25 SET VDATA=$$GET^EASEZC1(EASDFN_";"_+X,"2^2.3216^.06")
+26 IF (VDATA=-1)!(VDATA="")
SET VDATA="UNKNOWN"
+27 SET ^TMP("EZDATA",$JOB,KEY,1,2)=VDATA
+28 QUIT
