AGGETRIG ;VNGT/HS/ALA - Eligibility Triggers ; 24 May 2010 4:51 PM
;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
;
;
INIT(DATA,DFN) ; EP -- AGG PATIENT ELIG TRIGGER
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGPTCLB,AGGPTELG,AGGPTTRI,AGGPTBLQ,AGGPTTRQ
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGETRIG",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGETRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
S SOURCE="AGGPTCLB",TYPE="T",ABLE="Y",REQ="Y"
S DVAL=$$TBL^AGGWDEF(9999999.25,"INDIAN/ALASKA NATIVE")
S AGGPTCLB=$$GET1^DIQ(9000001,DFN_",",1111,"I")
I AGGPTCLB="" S VALUE=DVAL
I AGGPTCLB'="" S VALUE=AGGPTCLB_$C(28)_$$GET1^DIQ(9000001,DFN_",",1111,"E")
S AGGPTCLB=VALUE
S REQ="Y",HELP="" D UP
;
K AGOPT
F AG=2,3,9 S AGOPT(AG-1)=$P(^AGFAC(DUZ(2),0),U,AG)
;
S SOURCE="AGGPTELG",ABLE="Y",TYPE="C",REQ="",CLEAR="",HELP="" D
. S AGGPTELG=$$GET1^DIQ(9000001,DFN_",",1112,"I")
. I AGGPTELG'="" S AGGPTELG=AGGPTELG_$C(28)_$$GET1^DIQ(9000001,DFN_",",1112,"E")
. S VALUE=AGGPTELG D UP
;
I AGGPTCLB'=DVAL D G XINIT
. ;
. ;S SOURCE="AGGPTBLQ",ABLE="N",TYPE="X",REQ="",CLEAR="",HELP="",VALUE="NONE" D UP
. ;S SOURCE="AGGPTTRQ",ABLE="N",TYPE="X",REQ="",CLEAR="",HELP="",VALUE="NONE" D UP
. ;S SOURCE="AGGPTTRI",ABLE="N",TYPE="T",REQ="",CLEAR="",HELP="",VALUE="" D UP
. ;S SOURCE="AGGPTTEN",ABLE="N",TYPE="X",REQ="",CLEAR="",HELP="",VALUE="" D UP
. ;S SOURCE="OTHTRIB",ABLE="N",TYPE="M",REQ="",CLEAR="OTHTRIB",HELP="",VALUE="" D UP
;
;
S SOURCE="OTHTRIB",ABLE=$S(AGOPT(8)="Y":"Y",1:"N"),TYPE="M",VALUE="",CLEAR="",REQ="" D D UP
. I ABLE="N" S HELP="OTHER TRIBES is not turned on for "_$P(^DIC(4,DUZ(2),0),U,1) Q
. S HELP=""
S SOURCE="AGGPTTEN",ABLE=$S(AGOPT(2)="Y":"Y",1:"N"),TYPE="X",VALUE="",CLEAR="",REQ="" D D UP
. I ABLE="N" S HELP="TRIBAL ENROLLMENT NUMBER is not turned on for "_$P(^DIC(4,DUZ(2),0),U,1) Q
. S HELP=""
S SOURCE="AGGPTTRQ",ABLE=$S(AGOPT(1)="Y":"Y",1:"N"),TYPE="X",CLEAR="",REQ="" D D UP
. I ABLE="N" S HELP="TRIBAL BLOOD QUANTUM is not turned on for "_$P(^DIC(4,DUZ(2),0),U,1) Q
. S HELP=""
. S AGGPTTRQ=$$GET1^DIQ(9000001,DFN_",",1109,"E"),VALUE=AGGPTTRQ
S SOURCE="AGGPTTRI",ABLE="Y",TYPE="T",REQ="",CLEAR="",HELP="" D
. S AGGPTTRI=$$GET1^DIQ(9000001,DFN_",",1108,"I")
. I AGGPTTRI'="" S AGGPTTRI=AGGPTTRI_$C(28)_$$GET1^DIQ(9000001,DFN_",",1108,"E")
. S VALUE=AGGPTTRI D UP
S SOURCE="AGGPTBLQ",ABLE="Y",TYPE="X",REQ="",CLEAR="",HELP="" D
. S AGGPTBLQ=$$GET1^DIQ(9000001,DFN_",",1110,"E")
. S VALUE=AGGPTBLQ D UP
;
XINIT S II=II+1,@DATA@(II)=$C(31)
Q
;
INITOTH(DATA,AGGOTTRI) ; EP -- AGG OTH TRB INIT TRIG
NEW UID,II,VALUE,SOURCE,ABLE,TYPE,CLEAR,REQ,HELP,HDR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGETRIG",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGETRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
;
I $P($G(^AGFAC(DUZ(2),0)),U,2)'="Y"!($G(AGGOTTRI)="") S SOURCE="AGGOTTRQ",VALUE="",ABLE="N",TYPE="X",CLEAR="",REQ="" D D UP
. I ABLE="N" S HELP="TRIBAL BLOOD QUANTUM is not turned on for "_$P(^DIC(4,DUZ(2),0),U,1) Q
;
;I $P($G(^AGFAC(DUZ(2),0)),U,2)'="Y" S SOURCE="AGGOTTRQ",VALUE="",ABLE="N",TYPE="X",CLEAR="",REQ="" D D UP
;. I ABLE="N" S HELP="TRIBAL BLOOD QUANTUM is not turned on for "_$P(^DIC(4,DUZ(2),0),U,1) Q
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
CLASS(DATA,AGGPTCLB) ; EP -- AGG PATIENT CLASS TRIGGER
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,CLBEN,AGOPT,AG
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGETRIG",UID))
K @DATA
S II=0
S AGGPTCLB=$G(AGGPTCLB)
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGETRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
;
F AG=2,3,9 S AGOPT(AG-1)=$P(^AGFAC(DUZ(2),0),U,AG)
;
S CLBEN=$P($$TBL^AGGWDEF(9999999.25,"INDIAN/ALASKA NATIVE"),$C(28)) ;Get Classification IEN
;
S SOURCE="AGGPTTEN",ABLE=$S(AGOPT(2)="Y":"Y",1:"N"),TYPE="X",VALUE="",CLEAR="",REQ="" D D UP
. I ABLE="N" S HELP="TRIBAL ENROLLMENT NUMBER is not turned on for "_$P(^DIC(4,DUZ(2),0),U,1) Q
. S HELP=""
;
S SOURCE="OTHTRIB",ABLE=$S(AGOPT(8)="Y":"Y",1:"N"),TYPE="M",VALUE="",CLEAR="",REQ="" D D UP
. I ABLE="N" S HELP="OTHER TRIBES is not turned on for "_$P(^DIC(4,DUZ(2),0),U,1) Q
. S HELP=""
;
I AGGPTCLB'=CLBEN D G XCLASS
. ;
. S SOURCE="AGGPTBLQ",ABLE="Y",TYPE="X",REQ="",CLEAR="",HELP="",VALUE="NONE" D UP
. S SOURCE="AGGPTTRQ",ABLE=$S(AGOPT(1)="Y":"Y",1:"N"),TYPE="X",VALUE="NONE",CLEAR="",REQ="" D D UP
.. I ABLE="N" S HELP="TRIBAL BLOOD QUANTUM is not turned on for "_$P(^DIC(4,DUZ(2),0),U,1) Q
.. S HELP=""
. ;
. S SOURCE="AGGPTTRI",ABLE="Y",TYPE="T",REQ="",CLEAR="",HELP="" D D UP
.. S VALUE=$O(^AUTTTRI("B","NON-INDIAN(NONFEDERALLY RECOGN",""))
.. I VALUE'="" S VALUE=VALUE_$C(28)_"NON-INDIAN(NONFEDERALLY RECOGN"
;
I AGGPTCLB=CLBEN D
. ;
. S SOURCE="AGGPTTRQ",ABLE=$S(AGOPT(1)="Y":"Y",1:"N"),TYPE="X",VALUE="",CLEAR="",REQ="" D D UP
.. I ABLE="N" S HELP="TRIBAL BLOOD QUANTUM is not turned on for "_$P(^DIC(4,DUZ(2),0),U,1) Q
.. S HELP=""
. ;
. S SOURCE="AGGPTTRI",ABLE="Y",TYPE="T",REQ="",CLEAR="",HELP="",VALUE="" D UP
. ;
. S SOURCE="AGGPTBLQ",ABLE="Y",TYPE="X",REQ="",CLEAR="",HELP="",VALUE="" D UP
;
XCLASS S II=II+1,@DATA@(II)=$C(31)
Q
;
NCLASS(DATA,AGGPTCLB) ; EP -- AGG NEW PATIENT CLASS TRIG
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,CLBEN,AGOPT,AG
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGETRIG",UID))
K @DATA
S II=0
S AGGPTCLB=$G(AGGPTCLB)
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGETRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
;
F AG=2,3,9 S AGOPT(AG-1)=$P(^AGFAC(DUZ(2),0),U,AG)
;
S CLBEN=$P($$TBL^AGGWDEF(9999999.25,"INDIAN/ALASKA NATIVE"),$C(28)) ;Get Classification IEN
;
S SOURCE="AGGPTTEN",ABLE=$S(AGOPT(2)="Y":"Y",1:"N"),TYPE="X",VALUE="",CLEAR="",REQ="" D D UP
. I ABLE="N" S HELP="TRIBAL ENROLLMENT NUMBER is not turned on for "_$P(^DIC(4,DUZ(2),0),U,1) Q
. S HELP=""
;
I AGGPTCLB'=CLBEN D G XNCLASS
. ;
. S SOURCE="AGGPTBLQ",ABLE="Y",TYPE="X",REQ="",CLEAR="",HELP="",VALUE="NONE" D UP
. S SOURCE="AGGPTTRQ",ABLE=$S(AGOPT(1)="Y":"Y",1:"N"),TYPE="X",VALUE="NONE",CLEAR="",REQ="" D D UP
.. I ABLE="N" S HELP="TRIBAL BLOOD QUANTUM is not turned on for "_$P(^DIC(4,DUZ(2),0),U,1) Q
.. S HELP=""
. ;
. S SOURCE="AGGPTTRI",ABLE="Y",TYPE="T",REQ="",CLEAR="",HELP="" D D UP
.. S VALUE=$O(^AUTTTRI("B","NON-INDIAN(NONFEDERALLY RECOGN",""))
.. I VALUE'="" S VALUE=VALUE_$C(28)_"NON-INDIAN(NONFEDERALLY RECOGN"
;
I AGGPTCLB=CLBEN D
. ;
. S SOURCE="AGGPTTRQ",ABLE=$S(AGOPT(1)="Y":"Y",1:"N"),TYPE="X",VALUE="",CLEAR="",REQ="" D D UP
.. I ABLE="N" S HELP="TRIBAL BLOOD QUANTUM is not turned on for "_$P(^DIC(4,DUZ(2),0),U,1) Q
.. S HELP=""
. ;
. S SOURCE="AGGPTTRI",ABLE="Y",TYPE="T",REQ="",CLEAR="",HELP="",VALUE="" D UP
. ;
. S SOURCE="AGGPTBLQ",ABLE="Y",TYPE="X",REQ="",CLEAR="",HELP="",VALUE="" D UP
;
XNCLASS S II=II+1,@DATA@(II)=$C(31)
Q
;
OTRB(DATA,AGGOTTRI,AGGOTTRQ) ; EP -- AGG OTHER TRIBE TRIGGER
NEW UID,II,VALUE,SOURCE,HELP,TYPE,ABLE,HDR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGETRIG",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGETRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
;
;Quit if quantum entry is disabled
I $$GET1^DIQ(9009061,DUZ(2)_",",1,"I")="N" G XOTRB
;
;No Other Tribe - Disable Quantum
I $G(AGGOTTRI)="" D G XOTRB
. S SOURCE="AGGOTTRQ",ABLE="N",HELP="",VALUE="",TYPE="X",CLEAR="AGGPTTRQ",REQ="" D UP
;
;Other Tribe - Enable Quantum
I $G(AGGOTTRI)]"" D
. S SOURCE="AGGOTTRQ",ABLE="Y",HELP="",VALUE=$G(AGGOTTRQ),TYPE="X",CLEAR="",REQ="" D UP
;
XOTRB S II=II+1,@DATA@(II)=$C(31)
Q
;
HDR ;
S HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00001REQ_OPT^T00100CLEAR_FIELDS^T00200HELP_TEXT"
Q
;
UP ;
S II=II+1,@DATA@(II)=SOURCE_U_TYPE_U_VALUE_U_ABLE_U_$G(REQ)_U_$G(CLEAR)_U_HELP_$C(30)
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
AGGETRIG ;VNGT/HS/ALA - Eligibility Triggers ; 24 May 2010 4:51 PM
+1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
+2 ;
+3 ;
INIT(DATA,DFN) ; EP -- AGG PATIENT ELIG TRIGGER
+1 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGPTCLB,AGGPTELG,AGGPTTRI,AGGPTBLQ,AGGPTTRQ
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGETRIG",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGETRIG D UNWIND^%ZTER"
+7 DO HDR
+8 SET @DATA@(II)=HDR_$CHAR(30)
+9 SET SOURCE="AGGPTCLB"
SET TYPE="T"
SET ABLE="Y"
SET REQ="Y"
+10 SET DVAL=$$TBL^AGGWDEF(9999999.25,"INDIAN/ALASKA NATIVE")
+11 SET AGGPTCLB=$$GET1^DIQ(9000001,DFN_",",1111,"I")
+12 IF AGGPTCLB=""
SET VALUE=DVAL
+13 IF AGGPTCLB'=""
SET VALUE=AGGPTCLB_$CHAR(28)_$$GET1^DIQ(9000001,DFN_",",1111,"E")
+14 SET AGGPTCLB=VALUE
+15 SET REQ="Y"
SET HELP=""
DO UP
+16 ;
+17 KILL AGOPT
+18 FOR AG=2,3,9
SET AGOPT(AG-1)=$PIECE(^AGFAC(DUZ(2),0),U,AG)
+19 ;
+20 SET SOURCE="AGGPTELG"
SET ABLE="Y"
SET TYPE="C"
SET REQ=""
SET CLEAR=""
SET HELP=""
Begin DoDot:1
+21 SET AGGPTELG=$$GET1^DIQ(9000001,DFN_",",1112,"I")
+22 IF AGGPTELG'=""
SET AGGPTELG=AGGPTELG_$CHAR(28)_$$GET1^DIQ(9000001,DFN_",",1112,"E")
+23 SET VALUE=AGGPTELG
DO UP
End DoDot:1
+24 ;
+25 IF AGGPTCLB'=DVAL
Begin DoDot:1
+26 ;
+27 ;S SOURCE="AGGPTBLQ",ABLE="N",TYPE="X",REQ="",CLEAR="",HELP="",VALUE="NONE" D UP
+28 ;S SOURCE="AGGPTTRQ",ABLE="N",TYPE="X",REQ="",CLEAR="",HELP="",VALUE="NONE" D UP
+29 ;S SOURCE="AGGPTTRI",ABLE="N",TYPE="T",REQ="",CLEAR="",HELP="",VALUE="" D UP
+30 ;S SOURCE="AGGPTTEN",ABLE="N",TYPE="X",REQ="",CLEAR="",HELP="",VALUE="" D UP
+31 ;S SOURCE="OTHTRIB",ABLE="N",TYPE="M",REQ="",CLEAR="OTHTRIB",HELP="",VALUE="" D UP
End DoDot:1
GOTO XINIT
+32 ;
+33 ;
+34 SET SOURCE="OTHTRIB"
SET ABLE=$SELECT(AGOPT(8)="Y":"Y",1:"N")
SET TYPE="M"
SET VALUE=""
SET CLEAR=""
SET REQ=""
Begin DoDot:1
+35 IF ABLE="N"
SET HELP="OTHER TRIBES is not turned on for "_$PIECE(^DIC(4,DUZ(2),0),U,1)
QUIT
+36 SET HELP=""
End DoDot:1
DO UP
+37 SET SOURCE="AGGPTTEN"
SET ABLE=$SELECT(AGOPT(2)="Y":"Y",1:"N")
SET TYPE="X"
SET VALUE=""
SET CLEAR=""
SET REQ=""
Begin DoDot:1
+38 IF ABLE="N"
SET HELP="TRIBAL ENROLLMENT NUMBER is not turned on for "_$PIECE(^DIC(4,DUZ(2),0),U,1)
QUIT
+39 SET HELP=""
End DoDot:1
DO UP
+40 SET SOURCE="AGGPTTRQ"
SET ABLE=$SELECT(AGOPT(1)="Y":"Y",1:"N")
SET TYPE="X"
SET CLEAR=""
SET REQ=""
Begin DoDot:1
+41 IF ABLE="N"
SET HELP="TRIBAL BLOOD QUANTUM is not turned on for "_$PIECE(^DIC(4,DUZ(2),0),U,1)
QUIT
+42 SET HELP=""
+43 SET AGGPTTRQ=$$GET1^DIQ(9000001,DFN_",",1109,"E")
SET VALUE=AGGPTTRQ
End DoDot:1
DO UP
+44 SET SOURCE="AGGPTTRI"
SET ABLE="Y"
SET TYPE="T"
SET REQ=""
SET CLEAR=""
SET HELP=""
Begin DoDot:1
+45 SET AGGPTTRI=$$GET1^DIQ(9000001,DFN_",",1108,"I")
+46 IF AGGPTTRI'=""
SET AGGPTTRI=AGGPTTRI_$CHAR(28)_$$GET1^DIQ(9000001,DFN_",",1108,"E")
+47 SET VALUE=AGGPTTRI
DO UP
End DoDot:1
+48 SET SOURCE="AGGPTBLQ"
SET ABLE="Y"
SET TYPE="X"
SET REQ=""
SET CLEAR=""
SET HELP=""
Begin DoDot:1
+49 SET AGGPTBLQ=$$GET1^DIQ(9000001,DFN_",",1110,"E")
+50 SET VALUE=AGGPTBLQ
DO UP
End DoDot:1
+51 ;
XINIT SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
INITOTH(DATA,AGGOTTRI) ; EP -- AGG OTH TRB INIT TRIG
+1 NEW UID,II,VALUE,SOURCE,ABLE,TYPE,CLEAR,REQ,HELP,HDR
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGETRIG",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGETRIG D UNWIND^%ZTER"
+7 DO HDR
+8 SET @DATA@(II)=HDR_$CHAR(30)
+9 ;
+10 IF $PIECE($GET(^AGFAC(DUZ(2),0)),U,2)'="Y"!($GET(AGGOTTRI)="")
SET SOURCE="AGGOTTRQ"
SET VALUE=""
SET ABLE="N"
SET TYPE="X"
SET CLEAR=""
SET REQ=""
Begin DoDot:1
+11 IF ABLE="N"
SET HELP="TRIBAL BLOOD QUANTUM is not turned on for "_$PIECE(^DIC(4,DUZ(2),0),U,1)
QUIT
End DoDot:1
DO UP
+12 ;
+13 ;I $P($G(^AGFAC(DUZ(2),0)),U,2)'="Y" S SOURCE="AGGOTTRQ",VALUE="",ABLE="N",TYPE="X",CLEAR="",REQ="" D D UP
+14 ;. I ABLE="N" S HELP="TRIBAL BLOOD QUANTUM is not turned on for "_$P(^DIC(4,DUZ(2),0),U,1) Q
+15 ;
+16 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+17 QUIT
+18 ;
CLASS(DATA,AGGPTCLB) ; EP -- AGG PATIENT CLASS TRIGGER
+1 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,CLBEN,AGOPT,AG
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGETRIG",UID))
+4 KILL @DATA
+5 SET II=0
+6 SET AGGPTCLB=$GET(AGGPTCLB)
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGETRIG D UNWIND^%ZTER"
+8 DO HDR
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 ;
+11 FOR AG=2,3,9
SET AGOPT(AG-1)=$PIECE(^AGFAC(DUZ(2),0),U,AG)
+12 ;
+13 ;Get Classification IEN
SET CLBEN=$PIECE($$TBL^AGGWDEF(9999999.25,"INDIAN/ALASKA NATIVE"),$CHAR(28))
+14 ;
+15 SET SOURCE="AGGPTTEN"
SET ABLE=$SELECT(AGOPT(2)="Y":"Y",1:"N")
SET TYPE="X"
SET VALUE=""
SET CLEAR=""
SET REQ=""
Begin DoDot:1
+16 IF ABLE="N"
SET HELP="TRIBAL ENROLLMENT NUMBER is not turned on for "_$PIECE(^DIC(4,DUZ(2),0),U,1)
QUIT
+17 SET HELP=""
End DoDot:1
DO UP
+18 ;
+19 SET SOURCE="OTHTRIB"
SET ABLE=$SELECT(AGOPT(8)="Y":"Y",1:"N")
SET TYPE="M"
SET VALUE=""
SET CLEAR=""
SET REQ=""
Begin DoDot:1
+20 IF ABLE="N"
SET HELP="OTHER TRIBES is not turned on for "_$PIECE(^DIC(4,DUZ(2),0),U,1)
QUIT
+21 SET HELP=""
End DoDot:1
DO UP
+22 ;
+23 IF AGGPTCLB'=CLBEN
Begin DoDot:1
+24 ;
+25 SET SOURCE="AGGPTBLQ"
SET ABLE="Y"
SET TYPE="X"
SET REQ=""
SET CLEAR=""
SET HELP=""
SET VALUE="NONE"
DO UP
+26 SET SOURCE="AGGPTTRQ"
SET ABLE=$SELECT(AGOPT(1)="Y":"Y",1:"N")
SET TYPE="X"
SET VALUE="NONE"
SET CLEAR=""
SET REQ=""
Begin DoDot:2
+27 IF ABLE="N"
SET HELP="TRIBAL BLOOD QUANTUM is not turned on for "_$PIECE(^DIC(4,DUZ(2),0),U,1)
QUIT
+28 SET HELP=""
End DoDot:2
DO UP
+29 ;
+30 SET SOURCE="AGGPTTRI"
SET ABLE="Y"
SET TYPE="T"
SET REQ=""
SET CLEAR=""
SET HELP=""
Begin DoDot:2
+31 SET VALUE=$ORDER(^AUTTTRI("B","NON-INDIAN(NONFEDERALLY RECOGN",""))
+32 IF VALUE'=""
SET VALUE=VALUE_$CHAR(28)_"NON-INDIAN(NONFEDERALLY RECOGN"
End DoDot:2
DO UP
End DoDot:1
GOTO XCLASS
+33 ;
+34 IF AGGPTCLB=CLBEN
Begin DoDot:1
+35 ;
+36 SET SOURCE="AGGPTTRQ"
SET ABLE=$SELECT(AGOPT(1)="Y":"Y",1:"N")
SET TYPE="X"
SET VALUE=""
SET CLEAR=""
SET REQ=""
Begin DoDot:2
+37 IF ABLE="N"
SET HELP="TRIBAL BLOOD QUANTUM is not turned on for "_$PIECE(^DIC(4,DUZ(2),0),U,1)
QUIT
+38 SET HELP=""
End DoDot:2
DO UP
+39 ;
+40 SET SOURCE="AGGPTTRI"
SET ABLE="Y"
SET TYPE="T"
SET REQ=""
SET CLEAR=""
SET HELP=""
SET VALUE=""
DO UP
+41 ;
+42 SET SOURCE="AGGPTBLQ"
SET ABLE="Y"
SET TYPE="X"
SET REQ=""
SET CLEAR=""
SET HELP=""
SET VALUE=""
DO UP
End DoDot:1
+43 ;
XCLASS SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
NCLASS(DATA,AGGPTCLB) ; EP -- AGG NEW PATIENT CLASS TRIG
+1 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,CLBEN,AGOPT,AG
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGETRIG",UID))
+4 KILL @DATA
+5 SET II=0
+6 SET AGGPTCLB=$GET(AGGPTCLB)
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGETRIG D UNWIND^%ZTER"
+8 DO HDR
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 ;
+11 FOR AG=2,3,9
SET AGOPT(AG-1)=$PIECE(^AGFAC(DUZ(2),0),U,AG)
+12 ;
+13 ;Get Classification IEN
SET CLBEN=$PIECE($$TBL^AGGWDEF(9999999.25,"INDIAN/ALASKA NATIVE"),$CHAR(28))
+14 ;
+15 SET SOURCE="AGGPTTEN"
SET ABLE=$SELECT(AGOPT(2)="Y":"Y",1:"N")
SET TYPE="X"
SET VALUE=""
SET CLEAR=""
SET REQ=""
Begin DoDot:1
+16 IF ABLE="N"
SET HELP="TRIBAL ENROLLMENT NUMBER is not turned on for "_$PIECE(^DIC(4,DUZ(2),0),U,1)
QUIT
+17 SET HELP=""
End DoDot:1
DO UP
+18 ;
+19 IF AGGPTCLB'=CLBEN
Begin DoDot:1
+20 ;
+21 SET SOURCE="AGGPTBLQ"
SET ABLE="Y"
SET TYPE="X"
SET REQ=""
SET CLEAR=""
SET HELP=""
SET VALUE="NONE"
DO UP
+22 SET SOURCE="AGGPTTRQ"
SET ABLE=$SELECT(AGOPT(1)="Y":"Y",1:"N")
SET TYPE="X"
SET VALUE="NONE"
SET CLEAR=""
SET REQ=""
Begin DoDot:2
+23 IF ABLE="N"
SET HELP="TRIBAL BLOOD QUANTUM is not turned on for "_$PIECE(^DIC(4,DUZ(2),0),U,1)
QUIT
+24 SET HELP=""
End DoDot:2
DO UP
+25 ;
+26 SET SOURCE="AGGPTTRI"
SET ABLE="Y"
SET TYPE="T"
SET REQ=""
SET CLEAR=""
SET HELP=""
Begin DoDot:2
+27 SET VALUE=$ORDER(^AUTTTRI("B","NON-INDIAN(NONFEDERALLY RECOGN",""))
+28 IF VALUE'=""
SET VALUE=VALUE_$CHAR(28)_"NON-INDIAN(NONFEDERALLY RECOGN"
End DoDot:2
DO UP
End DoDot:1
GOTO XNCLASS
+29 ;
+30 IF AGGPTCLB=CLBEN
Begin DoDot:1
+31 ;
+32 SET SOURCE="AGGPTTRQ"
SET ABLE=$SELECT(AGOPT(1)="Y":"Y",1:"N")
SET TYPE="X"
SET VALUE=""
SET CLEAR=""
SET REQ=""
Begin DoDot:2
+33 IF ABLE="N"
SET HELP="TRIBAL BLOOD QUANTUM is not turned on for "_$PIECE(^DIC(4,DUZ(2),0),U,1)
QUIT
+34 SET HELP=""
End DoDot:2
DO UP
+35 ;
+36 SET SOURCE="AGGPTTRI"
SET ABLE="Y"
SET TYPE="T"
SET REQ=""
SET CLEAR=""
SET HELP=""
SET VALUE=""
DO UP
+37 ;
+38 SET SOURCE="AGGPTBLQ"
SET ABLE="Y"
SET TYPE="X"
SET REQ=""
SET CLEAR=""
SET HELP=""
SET VALUE=""
DO UP
End DoDot:1
+39 ;
XNCLASS SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
OTRB(DATA,AGGOTTRI,AGGOTTRQ) ; EP -- AGG OTHER TRIBE TRIGGER
+1 NEW UID,II,VALUE,SOURCE,HELP,TYPE,ABLE,HDR
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGETRIG",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGETRIG D UNWIND^%ZTER"
+7 DO HDR
+8 SET @DATA@(II)=HDR_$CHAR(30)
+9 ;
+10 ;Quit if quantum entry is disabled
+11 IF $$GET1^DIQ(9009061,DUZ(2)_",",1,"I")="N"
GOTO XOTRB
+12 ;
+13 ;No Other Tribe - Disable Quantum
+14 IF $GET(AGGOTTRI)=""
Begin DoDot:1
+15 SET SOURCE="AGGOTTRQ"
SET ABLE="N"
SET HELP=""
SET VALUE=""
SET TYPE="X"
SET CLEAR="AGGPTTRQ"
SET REQ=""
DO UP
End DoDot:1
GOTO XOTRB
+16 ;
+17 ;Other Tribe - Enable Quantum
+18 IF $GET(AGGOTTRI)]""
Begin DoDot:1
+19 SET SOURCE="AGGOTTRQ"
SET ABLE="Y"
SET HELP=""
SET VALUE=$GET(AGGOTTRQ)
SET TYPE="X"
SET CLEAR=""
SET REQ=""
DO UP
End DoDot:1
+20 ;
XOTRB SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
HDR ;
+1 SET HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00001REQ_OPT^T00100CLEAR_FIELDS^T00200HELP_TEXT"
+2 QUIT
+3 ;
UP ;
+1 SET II=II+1
SET @DATA@(II)=SOURCE_U_TYPE_U_VALUE_U_ABLE_U_$GET(REQ)_U_$GET(CLEAR)_U_HELP_$CHAR(30)
+2 QUIT
+3 ;
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
