Routine: AGGPTRGO

AGGPTRGO ;VNGT/HS/BEE-Other Patient Data Triggers ; 09 Apr 2010  7:57 AM

 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010

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)

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)

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)

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)

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)

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)

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)

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)

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)

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"

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

AGGPTRGO.m