AGGPTRGO ;VNGT/HS/BEE-Other Patient Data Triggers ; 09 Apr 2010 7:57 AM
;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
;
Q
;
INIT(DATA,DFN) ; EP -- AGG OTHER PATIENT INIT TRG
; Input
; DFN - Patient IEN
;
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGECREL,VISIBLE,EFND,EIEN,VAR,LIEN,LDT,AGOPT,HDR,HIN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGPTRGO",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPTRGO D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
;
;Method of Collection (disabled if Ethnicity is blank)
I $$ETHN^AGGPTDMG(DFN,.01)="" S SOURCE="AGMETH",ABLE="N",TYPE="T",CLEAR="",CLFLAG="",VALUE="",HELP="",REQ="O",VISIBLE="" D UP
;
;Other Languages
S SOURCE="OTHLNG",ABLE="Y",TYPE="M",CLEAR="",VALUE="",HELP="",REQ="O",VISIBLE="",CLFLAG="" D UP
;
;Interpreter Required? (disabled if Primary Language is English)
I $$MUL^AGGWDISP(DFN,9000001,8601,.02,"E")="ENGLISH" S SOURCE="AGGINTRP",ABLE="N",TYPE="C",CLEAR="",VALUE="",HELP="",REQ="O",VISIBLE="",CLFLAG="",CLFLAG="",CLFLAG="" D UP
;
;English Proficiency (disabled if Primary Language or Other Languages not English)
S LIEN="",LDT=$O(^AUPNPAT(DFN,86,"B",""),-1)
I LDT]"" S LIEN=$O(^AUPNPAT(DFN,86,"B",LDT,""),-1)
D GETS^DIQ(9000001.86,LIEN_","_DFN_",",".05*","E","VAR") ;Pull Other Languages
S EFND=0,EIEN="" F S EIEN=$O(VAR(9000001.8605,EIEN)) Q:EIEN="" I $G(VAR(9000001.8605,EIEN,".01","E"))="ENGLISH" S EFND=1 Q
I $$MUL^AGGWDISP(DFN,9000001,8601,.02,"E")'="ENGLISH",EFND=0 S SOURCE="AGGLGEPF",ABLE="N",TYPE="C",CLEAR="",VALUE="",HELP="",REQ="O",VISIBLE="",CLFLAG="" D UP ;NEED TO ADD IN CHECK FOR OTHER LANGUAGE
;
;Migrant Worker Type (disabled if Migrant Status is not 'Yes')
I $$MUL^AGGWDISP(DFN,9000001,8401,.02,"I")'="Y" S SOURCE="AGGMGTYP",ABLE="N",TYPE="C",CLEAR="",VALUE="",HELP="",REQ="O",VISIBLE="",CLFLAG="" D UP
;
;Homeless Type (disabled if Homeless Status is not 'Yes')
I $$MUL^AGGWDISP(DFN,9000001,8501,.02,"I")'="Y" S SOURCE="AGGHMTYP",ABLE="N",TYPE="C",CLEAR="",VALUE="",HELP="",REQ="O",VISIBLE="",CLFLAG="" D UP
;
;Household Income
S HIN=$$GET1^DIQ(9000001,DFN_",",.36,"E") I HIN>0 S HIN=$$NUMB(HIN),SOURCE="AGGTHINC",ABLE="Y",TYPE="T",CLEAR="",VALUE=HIN,HELP="",REQ="O",VISIBLE="",CLFLAG="" D UP
;
;Household Income Period
I $$GET1^DIQ(9000001,DFN_",",.36,"E")'>0 S SOURCE="AGGHINP",ABLE="N",TYPE="C",CLEAR="",VALUE="",HELP="",REQ="O",VISIBLE="",CLFLAG="" D UP
;
;Enable Internet Access Where Field
I $$MUL^AGGWDISP(DFN,9000001,8101,.02,"I")=1 S SOURCE="AGGWEBF",VALUE="",HELP="",ABLE="Y",REQ="O",CLEAR="",CLFLAG="",TYPE="C",VISIBLE="",CLFLAG="" D UP
I $$MUL^AGGWDISP(DFN,9000001,8101,.02,"I")'=1 S SOURCE="AGGWEBF",VALUE="",HELP="",ABLE="N",REQ="O",CLEAR="AGGWEBF",CLFLAG="Y",TYPE="C",VISIBLE="",CLFLAG="" D UP
;
D ^AGVAR
I AGOPT(22)="N" D
. S SOURCE="AGRACE",VALUE=$$RCE^AGGPTDMG(DFN,.01),ABLE="N",TYPE="T",CLEAR="",HELP="",REQ="O",VISIBLE="N",CLFLAG="" D UP
. S SOURCE="AGGTHNUM",VALUE=$$GET1^DIQ(9000001,DFN_",",.35,"E"),ABLE="N",TYPE="X",CLEAR="",HELP="",REQ="O",VISIBLE="N",CLFLAG="" D UP
. S SOURCE="AGGTHINC",VALUE=$$GET1^DIQ(9000001,DFN_",",.36,"E"),ABLE="N",TYPE="X",CLEAR="",HELP="",REQ="O",VISIBLE="N",CLFLAG="" D UP
. S SOURCE="AGGHINP",VALUE=$$GET1^DIQ(9000001,DFN_",",8701,"E"),ABLE="N",TYPE="C",CLEAR="",HELP="",REQ="O",VISIBLE="N",CLFLAG="" D UP
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
ETH(DATA,AGETH) ; EP -- AGG OTH PAT ETH TRG
; Input
; DFN - Patient IEN
;
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGECREL,HDR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGPTRGO",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPTRGO D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
;
;Enable Method of Collection
I $G(AGETH)]"" S SOURCE="AGMETH",VALUE="",HELP="",ABLE="Y",REQ="R",CLEAR="",CLFLAG="",TYPE="T",VISIBLE="" D UP
I $G(AGETH)="" S SOURCE="AGMETH",VALUE="",HELP="",ABLE="N",REQ="O",CLEAR="",CLFLAG="",TYPE="T",VISIBLE="" D UP
S II=II+1,@DATA@(II)=$C(31)
Q
;
PLNG(DATA,AGGLGPRI,AGGINTRP,AGGLGEPF,OTHLNG) ; EP -- AGG OTH PAT PRM TRG
; Input
; DFN - Patient IEN
;
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGECREL,AGGLGOTH,BQ,ENGIEN,EFND,HDR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGPTRGO",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPTRGO D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
;
;Determine the English IEN
S ENGIEN=$O(^AUTTLANG("B","ENGLISH",""))
;
;Parse Other Language Multiple
S AGGLGOTH="",EFND=0
F BQ=1:1:$L(OTHLNG,$C(28)) D
. N PDATA,NAME,VALUE,BP,BV
. S PDATA=$P(OTHLNG,$C(28),BQ) Q:PDATA=""
. S NAME=$P(PDATA,"=",1)
. S VALUE=$P(PDATA,"=",2,99) Q:VALUE=""
. F BP=1:1:$L(VALUE,$C(29)) S BV=$P(VALUE,$C(29),BP),@NAME=$G(@NAME)_$S(BP=1:"",1:$C(29))_BV
;
;Look for English in the Other Languages
I AGGLGOTH]"" D
. N I,VAL,CVAL
. S CVAL="" F I=1:1:$L(AGGLGOTH,$C(29)) S CVAL=$P($G(AGGLGOTH),$C(29),I) I CVAL]"",CVAL=ENGIEN S EFND=1
;
;Enable/Disable Interpreter Required
I $G(AGGLGPRI)]"",AGGLGPRI'=ENGIEN D
. S SOURCE="AGGINTRP",VALUE=$G(AGGINTRP),HELP="",ABLE="Y",REQ="R",CLEAR="",CLFLAG="",TYPE="T",VISIBLE="" D UP
I $G(AGGLGPRI)]"",AGGLGPRI=ENGIEN D
. S SOURCE="AGGINTRP",VALUE="",HELP="",ABLE="N",REQ="R",CLEAR="",CLFLAG="",TYPE="T",VISIBLE="" D UP
;
;Enable/Disable English Proficiency
I (($G(AGGLGPRI)="")!(($G(AGGLGPRI)]"")&(AGGLGPRI'=ENGIEN)))&(EFND=0) D
. S SOURCE="AGGLGEPF",VALUE="",HELP="",ABLE="N",REQ="O",CLEAR="",CLFLAG="",TYPE="C",VISIBLE="" D UP
I ($G(AGGLGPRI)]""&(AGGLGPRI=ENGIEN))!(EFND=1) D
. S SOURCE="AGGLGEPF",VALUE=$G(AGGLGEPF),HELP="",ABLE="Y",REQ="R",CLEAR="",CLFLAG="",TYPE="C",VISIBLE="" D UP
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
MSTS(DATA,AGGMGSTS,AGGMGTYP) ; EP -- AGG MIGRNT TRIGGER
; Input
; AGGMGSTS - Migrant Status (Y/N)
; AGGMGTYP - Migrant Type (S/M)
;
NEW UID,II,VALUE,SOURCE,HELP,TYPE,ABLE,REQ,CLEAR,CLFLAG,HDR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGPTRGO",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPTRGO D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
;
;Enable Migrant Type Field
I $G(AGGMGSTS)="Y" S SOURCE="AGGMGTYP",VALUE=$G(AGGMGTYP),HELP="",ABLE="Y",REQ="R",CLEAR="",CLFLAG="",TYPE="C",VISIBLE="" D UP
I $G(AGGMGSTS)'="Y" S SOURCE="AGGMGTYP",VALUE="",HELP="",ABLE="N",REQ="O",CLEAR="",CLFLAG="",TYPE="C",VISIBLE="" D UP
S II=II+1,@DATA@(II)=$C(31)
Q
;
HSTS(DATA,AGGHMSTS,AGGHMTYP) ; EP -- AGG HOMELESS TRIGGER
; Input
; AGGHMSTS - Homeless Status (Y/N)
; AGGHMTYP - Homeless Type (H/T/D/S/U)
;
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,REQ,CLEAR,CLFLAG,HDR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGPTRGO",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPTRGO D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
;
;Enable Homeless Type Field
I $G(AGGHMSTS)="Y" S SOURCE="AGGHMTYP",VALUE=$G(AGGHMTYP),HELP="",ABLE="Y",REQ="R",CLEAR="",CLFLAG="",TYPE="C",VISIBLE="" D UP
I $G(AGGHMSTS)'="Y" S SOURCE="AGGHMTYP",VALUE="",HELP="",ABLE="N",REQ="O",CLEAR="",CLFLAG="",TYPE="C",VISIBLE="" D UP
S II=II+1,@DATA@(II)=$C(31)
Q
;
HINC(DATA,AGGHINC,AGGHINP) ; EP -- AGG HSHLD INCOME TRIGGER
; Input
; AGGHINC - Household Income
; AGGHINP - Household Income Period (Y/M/W/B)
;
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,REQ,CLEAR,CLFLAG,HDR,HIN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGPTRGO",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPTRGO D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
;
;Add comma to Household Income
I $TR($G(AGGHINC),",")>0 S HIN=$$NUMB(AGGHINC),SOURCE="AGGTHINC",ABLE="Y",TYPE="T",CLEAR="",VALUE=HIN,HELP="",REQ="O",VISIBLE="" D UP
;
;Enable Household Income Period Field
I $TR($G(AGGHINC),",")>0 S SOURCE="AGGHINP",VALUE="",HELP="",ABLE="Y",REQ="R",CLEAR="",CLFLAG="",TYPE="C",VISIBLE="" D UP
I $TR($G(AGGHINC),",")'>0 S SOURCE="AGGHINP",VALUE="",HELP="",ABLE="N",REQ="O",CLEAR="",CLFLAG="",TYPE="C",VISIBLE="" D UP
S II=II+1,@DATA@(II)=$C(31)
Q
;
INTR(DATA,AGGINTNT,AGGWEBF) ; EP -- AGG INTERNET ACCESS TRIGGER
; Input
; AGGINTNT - Internet Access (Y/N)
; AGGWEBF - Access Internet From (H/W/S/HC/L/T/M)
;
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,REQ,CLEAR,CLFLAG,HDR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGPTRGO",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPTRGO D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
;
;Enable Internet Access Where Field
I $G(AGGINTNT)=1 S SOURCE="AGGWEBF",VALUE="",HELP="",ABLE="Y",REQ="O",CLEAR="",CLFLAG="N",TYPE="C",VISIBLE="" D UP
I $G(AGGINTNT)'=1 S SOURCE="AGGWEBF",VALUE="",HELP="",ABLE="N",REQ="O",CLEAR="AGGWEBF",CLFLAG="Y",TYPE="C",VISIBLE="" D UP
S II=II+1,@DATA@(II)=$C(31)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
UP ;
S II=II+1,@DATA@(II)=SOURCE_U_TYPE_U_VALUE_U_ABLE_U_$G(CLEAR)_U_HELP_U_REQ_U_$G(VISIBLE)_U_$G(CLFLAG)_$C(30)
Q
;
NUMB(X) ;Format number with commas
N Y,I
S X=$TR(X,",")
I X'?4N.N Q X
S Y=""
F I=0:1:($L(X)-1) S Y=$E(X,$L(X)-I)_$S(((I>0)&(I#3=0)):",",1:"")_Y
Q Y
;
HDR ;
S HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT^T00001REQ_OPT^T00001VISIBLE^T00001CLEAR_FLAG"
Q
AGGPTRGO ;VNGT/HS/BEE-Other Patient Data Triggers ; 09 Apr 2010 7:57 AM
+1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
+2 ;
+3 QUIT
+4 ;
INIT(DATA,DFN) ; EP -- AGG OTHER PATIENT INIT TRG
+1 ; Input
+2 ; DFN - Patient IEN
+3 ;
+4 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGECREL,VISIBLE,EFND,EIEN,VAR,LIEN,LDT,AGOPT,HDR,HIN
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET DATA=$NAME(^TMP("AGGPTRGO",UID))
+7 KILL @DATA
+8 SET II=0
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGPTRGO D UNWIND^%ZTER"
+10 DO HDR
+11 SET @DATA@(II)=HDR_$CHAR(30)
+12 ;
+13 ;Method of Collection (disabled if Ethnicity is blank)
+14 IF $$ETHN^AGGPTDMG(DFN,.01)=""
SET SOURCE="AGMETH"
SET ABLE="N"
SET TYPE="T"
SET CLEAR=""
SET CLFLAG=""
SET VALUE=""
SET HELP=""
SET REQ="O"
SET VISIBLE=""
DO UP
+15 ;
+16 ;Other Languages
+17 SET SOURCE="OTHLNG"
SET ABLE="Y"
SET TYPE="M"
SET CLEAR=""
SET VALUE=""
SET HELP=""
SET REQ="O"
SET VISIBLE=""
SET CLFLAG=""
DO UP
+18 ;
+19 ;Interpreter Required? (disabled if Primary Language is English)
+20 IF $$MUL^AGGWDISP(DFN,9000001,8601,.02,"E")="ENGLISH"
SET SOURCE="AGGINTRP"
SET ABLE="N"
SET TYPE="C"
SET CLEAR=""
SET VALUE=""
SET HELP=""
SET REQ="O"
SET VISIBLE=""
SET CLFLAG=""
SET CLFLAG=""
SET CLFLAG=""
DO UP
+21 ;
+22 ;English Proficiency (disabled if Primary Language or Other Languages not English)
+23 SET LIEN=""
SET LDT=$ORDER(^AUPNPAT(DFN,86,"B",""),-1)
+24 IF LDT]""
SET LIEN=$ORDER(^AUPNPAT(DFN,86,"B",LDT,""),-1)
+25 ;Pull Other Languages
DO GETS^DIQ(9000001.86,LIEN_","_DFN_",",".05*","E","VAR")
+26 SET EFND=0
SET EIEN=""
FOR
SET EIEN=$ORDER(VAR(9000001.8605,EIEN))
IF EIEN=""
QUIT
IF $GET(VAR(9000001.8605,EIEN,".01","E"))="ENGLISH"
SET EFND=1
QUIT
+27 ;NEED TO ADD IN CHECK FOR OTHER LANGUAGE
IF $$MUL^AGGWDISP(DFN,9000001,8601,.02,"E")'="ENGLISH"
IF EFND=0
SET SOURCE="AGGLGEPF"
SET ABLE="N"
SET TYPE="C"
SET CLEAR=""
SET VALUE=""
SET HELP=""
SET REQ="O"
SET VISIBLE=""
SET CLFLAG=""
DO UP
+28 ;
+29 ;Migrant Worker Type (disabled if Migrant Status is not 'Yes')
+30 IF $$MUL^AGGWDISP(DFN,9000001,8401,.02,"I")'="Y"
SET SOURCE="AGGMGTYP"
SET ABLE="N"
SET TYPE="C"
SET CLEAR=""
SET VALUE=""
SET HELP=""
SET REQ="O"
SET VISIBLE=""
SET CLFLAG=""
DO UP
+31 ;
+32 ;Homeless Type (disabled if Homeless Status is not 'Yes')
+33 IF $$MUL^AGGWDISP(DFN,9000001,8501,.02,"I")'="Y"
SET SOURCE="AGGHMTYP"
SET ABLE="N"
SET TYPE="C"
SET CLEAR=""
SET VALUE=""
SET HELP=""
SET REQ="O"
SET VISIBLE=""
SET CLFLAG=""
DO UP
+34 ;
+35 ;Household Income
+36 SET HIN=$$GET1^DIQ(9000001,DFN_",",.36,"E")
IF HIN>0
SET HIN=$$NUMB(HIN)
SET SOURCE="AGGTHINC"
SET ABLE="Y"
SET TYPE="T"
SET CLEAR=""
SET VALUE=HIN
SET HELP=""
SET REQ="O"
SET VISIBLE=""
SET CLFLAG=""
DO UP
+37 ;
+38 ;Household Income Period
+39 IF $$GET1^DIQ(9000001,DFN_",",.36,"E")'>0
SET SOURCE="AGGHINP"
SET ABLE="N"
SET TYPE="C"
SET CLEAR=""
SET VALUE=""
SET HELP=""
SET REQ="O"
SET VISIBLE=""
SET CLFLAG=""
DO UP
+40 ;
+41 ;Enable Internet Access Where Field
+42 IF $$MUL^AGGWDISP(DFN,9000001,8101,.02,"I")=1
SET SOURCE="AGGWEBF"
SET VALUE=""
SET HELP=""
SET ABLE="Y"
SET REQ="O"
SET CLEAR=""
SET CLFLAG=""
SET TYPE="C"
SET VISIBLE=""
SET CLFLAG=""
DO UP
+43 IF $$MUL^AGGWDISP(DFN,9000001,8101,.02,"I")'=1
SET SOURCE="AGGWEBF"
SET VALUE=""
SET HELP=""
SET ABLE="N"
SET REQ="O"
SET CLEAR="AGGWEBF"
SET CLFLAG="Y"
SET TYPE="C"
SET VISIBLE=""
SET CLFLAG=""
DO UP
+44 ;
+45 DO ^AGVAR
+46 IF AGOPT(22)="N"
Begin DoDot:1
+47 SET SOURCE="AGRACE"
SET VALUE=$$RCE^AGGPTDMG(DFN,.01)
SET ABLE="N"
SET TYPE="T"
SET CLEAR=""
SET HELP=""
SET REQ="O"
SET VISIBLE="N"
SET CLFLAG=""
DO UP
+48 SET SOURCE="AGGTHNUM"
SET VALUE=$$GET1^DIQ(9000001,DFN_",",.35,"E")
SET ABLE="N"
SET TYPE="X"
SET CLEAR=""
SET HELP=""
SET REQ="O"
SET VISIBLE="N"
SET CLFLAG=""
DO UP
+49 SET SOURCE="AGGTHINC"
SET VALUE=$$GET1^DIQ(9000001,DFN_",",.36,"E")
SET ABLE="N"
SET TYPE="X"
SET CLEAR=""
SET HELP=""
SET REQ="O"
SET VISIBLE="N"
SET CLFLAG=""
DO UP
+50 SET SOURCE="AGGHINP"
SET VALUE=$$GET1^DIQ(9000001,DFN_",",8701,"E")
SET ABLE="N"
SET TYPE="C"
SET CLEAR=""
SET HELP=""
SET REQ="O"
SET VISIBLE="N"
SET CLFLAG=""
DO UP
End DoDot:1
+51 ;
+52 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+53 QUIT
+54 ;
ETH(DATA,AGETH) ; EP -- AGG OTH PAT ETH TRG
+1 ; Input
+2 ; DFN - Patient IEN
+3 ;
+4 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGECREL,HDR
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET DATA=$NAME(^TMP("AGGPTRGO",UID))
+7 KILL @DATA
+8 SET II=0
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGPTRGO D UNWIND^%ZTER"
+10 DO HDR
+11 SET @DATA@(II)=HDR_$CHAR(30)
+12 ;
+13 ;Enable Method of Collection
+14 IF $GET(AGETH)]""
SET SOURCE="AGMETH"
SET VALUE=""
SET HELP=""
SET ABLE="Y"
SET REQ="R"
SET CLEAR=""
SET CLFLAG=""
SET TYPE="T"
SET VISIBLE=""
DO UP
+15 IF $GET(AGETH)=""
SET SOURCE="AGMETH"
SET VALUE=""
SET HELP=""
SET ABLE="N"
SET REQ="O"
SET CLEAR=""
SET CLFLAG=""
SET TYPE="T"
SET VISIBLE=""
DO UP
+16 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+17 QUIT
+18 ;
PLNG(DATA,AGGLGPRI,AGGINTRP,AGGLGEPF,OTHLNG) ; EP -- AGG OTH PAT PRM TRG
+1 ; Input
+2 ; DFN - Patient IEN
+3 ;
+4 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGECREL,AGGLGOTH,BQ,ENGIEN,EFND,HDR
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET DATA=$NAME(^TMP("AGGPTRGO",UID))
+7 KILL @DATA
+8 SET II=0
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGPTRGO D UNWIND^%ZTER"
+10 DO HDR
+11 SET @DATA@(II)=HDR_$CHAR(30)
+12 ;
+13 ;Determine the English IEN
+14 SET ENGIEN=$ORDER(^AUTTLANG("B","ENGLISH",""))
+15 ;
+16 ;Parse Other Language Multiple
+17 SET AGGLGOTH=""
SET EFND=0
+18 FOR BQ=1:1:$LENGTH(OTHLNG,$CHAR(28))
Begin DoDot:1
+19 NEW PDATA,NAME,VALUE,BP,BV
+20 SET PDATA=$PIECE(OTHLNG,$CHAR(28),BQ)
IF PDATA=""
QUIT
+21 SET NAME=$PIECE(PDATA,"=",1)
+22 SET VALUE=$PIECE(PDATA,"=",2,99)
IF VALUE=""
QUIT
+23 FOR BP=1:1:$LENGTH(VALUE,$CHAR(29))
SET BV=$PIECE(VALUE,$CHAR(29),BP)
SET @NAME=$GET(@NAME)_$SELECT(BP=1:"",1:$CHAR(29))_BV
End DoDot:1
+24 ;
+25 ;Look for English in the Other Languages
+26 IF AGGLGOTH]""
Begin DoDot:1
+27 NEW I,VAL,CVAL
+28 SET CVAL=""
FOR I=1:1:$LENGTH(AGGLGOTH,$CHAR(29))
SET CVAL=$PIECE($GET(AGGLGOTH),$CHAR(29),I)
IF CVAL]""
IF CVAL=ENGIEN
SET EFND=1
End DoDot:1
+29 ;
+30 ;Enable/Disable Interpreter Required
+31 IF $GET(AGGLGPRI)]""
IF AGGLGPRI'=ENGIEN
Begin DoDot:1
+32 SET SOURCE="AGGINTRP"
SET VALUE=$GET(AGGINTRP)
SET HELP=""
SET ABLE="Y"
SET REQ="R"
SET CLEAR=""
SET CLFLAG=""
SET TYPE="T"
SET VISIBLE=""
DO UP
End DoDot:1
+33 IF $GET(AGGLGPRI)]""
IF AGGLGPRI=ENGIEN
Begin DoDot:1
+34 SET SOURCE="AGGINTRP"
SET VALUE=""
SET HELP=""
SET ABLE="N"
SET REQ="R"
SET CLEAR=""
SET CLFLAG=""
SET TYPE="T"
SET VISIBLE=""
DO UP
End DoDot:1
+35 ;
+36 ;Enable/Disable English Proficiency
+37 IF (($GET(AGGLGPRI)="")!(($GET(AGGLGPRI)]"")&(AGGLGPRI'=ENGIEN)))&(EFND=0)
Begin DoDot:1
+38 SET SOURCE="AGGLGEPF"
SET VALUE=""
SET HELP=""
SET ABLE="N"
SET REQ="O"
SET CLEAR=""
SET CLFLAG=""
SET TYPE="C"
SET VISIBLE=""
DO UP
End DoDot:1
+39 IF ($GET(AGGLGPRI)]""&(AGGLGPRI=ENGIEN))!(EFND=1)
Begin DoDot:1
+40 SET SOURCE="AGGLGEPF"
SET VALUE=$GET(AGGLGEPF)
SET HELP=""
SET ABLE="Y"
SET REQ="R"
SET CLEAR=""
SET CLFLAG=""
SET TYPE="C"
SET VISIBLE=""
DO UP
End DoDot:1
+41 ;
+42 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+43 QUIT
+44 ;
MSTS(DATA,AGGMGSTS,AGGMGTYP) ; EP -- AGG MIGRNT TRIGGER
+1 ; Input
+2 ; AGGMGSTS - Migrant Status (Y/N)
+3 ; AGGMGTYP - Migrant Type (S/M)
+4 ;
+5 NEW UID,II,VALUE,SOURCE,HELP,TYPE,ABLE,REQ,CLEAR,CLFLAG,HDR
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("AGGPTRGO",UID))
+8 KILL @DATA
+9 SET II=0
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGPTRGO D UNWIND^%ZTER"
+11 DO HDR
+12 SET @DATA@(II)=HDR_$CHAR(30)
+13 ;
+14 ;Enable Migrant Type Field
+15 IF $GET(AGGMGSTS)="Y"
SET SOURCE="AGGMGTYP"
SET VALUE=$GET(AGGMGTYP)
SET HELP=""
SET ABLE="Y"
SET REQ="R"
SET CLEAR=""
SET CLFLAG=""
SET TYPE="C"
SET VISIBLE=""
DO UP
+16 IF $GET(AGGMGSTS)'="Y"
SET SOURCE="AGGMGTYP"
SET VALUE=""
SET HELP=""
SET ABLE="N"
SET REQ="O"
SET CLEAR=""
SET CLFLAG=""
SET TYPE="C"
SET VISIBLE=""
DO UP
+17 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+18 QUIT
+19 ;
HSTS(DATA,AGGHMSTS,AGGHMTYP) ; EP -- AGG HOMELESS TRIGGER
+1 ; Input
+2 ; AGGHMSTS - Homeless Status (Y/N)
+3 ; AGGHMTYP - Homeless Type (H/T/D/S/U)
+4 ;
+5 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,REQ,CLEAR,CLFLAG,HDR
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("AGGPTRGO",UID))
+8 KILL @DATA
+9 SET II=0
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGPTRGO D UNWIND^%ZTER"
+11 DO HDR
+12 SET @DATA@(II)=HDR_$CHAR(30)
+13 ;
+14 ;Enable Homeless Type Field
+15 IF $GET(AGGHMSTS)="Y"
SET SOURCE="AGGHMTYP"
SET VALUE=$GET(AGGHMTYP)
SET HELP=""
SET ABLE="Y"
SET REQ="R"
SET CLEAR=""
SET CLFLAG=""
SET TYPE="C"
SET VISIBLE=""
DO UP
+16 IF $GET(AGGHMSTS)'="Y"
SET SOURCE="AGGHMTYP"
SET VALUE=""
SET HELP=""
SET ABLE="N"
SET REQ="O"
SET CLEAR=""
SET CLFLAG=""
SET TYPE="C"
SET VISIBLE=""
DO UP
+17 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+18 QUIT
+19 ;
HINC(DATA,AGGHINC,AGGHINP) ; EP -- AGG HSHLD INCOME TRIGGER
+1 ; Input
+2 ; AGGHINC - Household Income
+3 ; AGGHINP - Household Income Period (Y/M/W/B)
+4 ;
+5 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,REQ,CLEAR,CLFLAG,HDR,HIN
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("AGGPTRGO",UID))
+8 KILL @DATA
+9 SET II=0
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGPTRGO D UNWIND^%ZTER"
+11 DO HDR
+12 SET @DATA@(II)=HDR_$CHAR(30)
+13 ;
+14 ;Add comma to Household Income
+15 IF $TRANSLATE($GET(AGGHINC),",")>0
SET HIN=$$NUMB(AGGHINC)
SET SOURCE="AGGTHINC"
SET ABLE="Y"
SET TYPE="T"
SET CLEAR=""
SET VALUE=HIN
SET HELP=""
SET REQ="O"
SET VISIBLE=""
DO UP
+16 ;
+17 ;Enable Household Income Period Field
+18 IF $TRANSLATE($GET(AGGHINC),",")>0
SET SOURCE="AGGHINP"
SET VALUE=""
SET HELP=""
SET ABLE="Y"
SET REQ="R"
SET CLEAR=""
SET CLFLAG=""
SET TYPE="C"
SET VISIBLE=""
DO UP
+19 IF $TRANSLATE($GET(AGGHINC),",")'>0
SET SOURCE="AGGHINP"
SET VALUE=""
SET HELP=""
SET ABLE="N"
SET REQ="O"
SET CLEAR=""
SET CLFLAG=""
SET TYPE="C"
SET VISIBLE=""
DO UP
+20 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+21 QUIT
+22 ;
INTR(DATA,AGGINTNT,AGGWEBF) ; EP -- AGG INTERNET ACCESS TRIGGER
+1 ; Input
+2 ; AGGINTNT - Internet Access (Y/N)
+3 ; AGGWEBF - Access Internet From (H/W/S/HC/L/T/M)
+4 ;
+5 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,REQ,CLEAR,CLFLAG,HDR
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("AGGPTRGO",UID))
+8 KILL @DATA
+9 SET II=0
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGPTRGO D UNWIND^%ZTER"
+11 DO HDR
+12 SET @DATA@(II)=HDR_$CHAR(30)
+13 ;
+14 ;Enable Internet Access Where Field
+15 IF $GET(AGGINTNT)=1
SET SOURCE="AGGWEBF"
SET VALUE=""
SET HELP=""
SET ABLE="Y"
SET REQ="O"
SET CLEAR=""
SET CLFLAG="N"
SET TYPE="C"
SET VISIBLE=""
DO UP
+16 IF $GET(AGGINTNT)'=1
SET SOURCE="AGGWEBF"
SET VALUE=""
SET HELP=""
SET ABLE="N"
SET REQ="O"
SET CLEAR="AGGWEBF"
SET CLFLAG="Y"
SET TYPE="C"
SET VISIBLE=""
DO UP
+17 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+18 QUIT
+19 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
UP ;
+1 SET II=II+1
SET @DATA@(II)=SOURCE_U_TYPE_U_VALUE_U_ABLE_U_$GET(CLEAR)_U_HELP_U_REQ_U_$GET(VISIBLE)_U_$GET(CLFLAG)_$CHAR(30)
+2 QUIT
+3 ;
NUMB(X) ;Format number with commas
+1 NEW Y,I
+2 SET X=$TRANSLATE(X,",")
+3 IF X'?4N.N
QUIT X
+4 SET Y=""
+5 FOR I=0:1:($LENGTH(X)-1)
SET Y=$EXTRACT(X,$LENGTH(X)-I)_$SELECT(((I>0)&(I#3=0)):",",1:"")_Y
+6 QUIT Y
+7 ;
HDR ;
+1 SET HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT^T00001REQ_OPT^T00001VISIBLE^T00001CLEAR_FLAG"
+2 QUIT
