AGGFMTRG ;VNGT/HS/ALA-Family, Contact Triggers ; 26 May 2010 11:06 AM
;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
;
;
EC(DATA,DFN) ; EP -- AGG EMER CONTACT TRIGGER
; Input
; DFN - Patient IEN
;
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGECREL
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGTREC",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
; Other Relationship is disabled, if relationship is not OTHER
S AGGECREL=$$GET1^DIQ(9000001,DFN_",",3102,"E")
I AGGECREL'="OTHER" S SOURCE="AGGECORL",VALUE="",ABLE="N",TYPE="X",CLEAR="",HELP="" D UP
I AGGECREL="OTHER" D
. S VALUE=$$GET1^DIQ(2,DFN_",",.332,"E")
. S SOURCE="AGGECORL",ABLE="Y",TYPE="X",CLEAR="",HELP="Enter the 'other' relationship" D UP
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
ECREL(DATA,AGGECREL) ; EP -- AGG EC RELATION TRIGGER
; Input
; AGGECREL - Emergency Contact Relationship
;
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,ECREL
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGTRECRL",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
; Other Relationship is disabled, if relationship is not OTHER
I AGGECREL?.N S ECREL=$P(^AUTTRLSH(AGGECREL,0),U,1)
I ECREL'="OTHER" S SOURCE="AGGECORL",VALUE="",ABLE="N",TYPE="X",CLEAR="",HELP="" D UP
I ECREL="OTHER" D
. S SOURCE="AGGECORL",ABLE="Y",TYPE="X",CLEAR="",HELP="Enter the 'other' relationship",VALUE="" 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_$C(30)
Q
;
HDR ;
S HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT"
Q
;
NK(DATA,DFN) ; EP -- AGG NEXT OF KIN TRIGGER
; Input
; DFN - Patient IEN
;
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGNKREL
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGTRNK",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
; Other Relationship is disabled, if relationship is not OTHER
S AGGNKREL=$$GET1^DIQ(9000001,DFN_",",2802,"E")
I AGGNKREL'="OTHER" S SOURCE="AGGNKORL",VALUE="",ABLE="N",TYPE="X",CLEAR="",HELP="" D UP
I AGGNKREL="OTHER" D
. S VALUE=$$GET1^DIQ(2,DFN_",",.212,"E")
. S SOURCE="AGGNKORL",ABLE="Y",TYPE="X",CLEAR="",HELP="Enter the 'other' relationship" D UP
S II=II+1,@DATA@(II)=$C(31)
Q
;
NKREL(DATA,AGGNKREL) ; EP -- AGG NK RELATION TRIGGER
; Input
; AGGNKREL - Next of Kin Relationship
;
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,NKREL
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGTRNKRL",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
; Other Relationship is disabled, if relationship is not OTHER
I AGGNKREL?.N S NKREL=$P(^AUTTRLSH(AGGNKREL,0),U,1)
I NKREL'="OTHER" S SOURCE="AGGNKORL",VALUE="",ABLE="N",TYPE="X",CLEAR="",HELP="" D UP
I NKREL="OTHER" D
. S SOURCE="AGGNKORL",ABLE="Y",TYPE="X",CLEAR="",HELP="Enter the 'other' relationship",VALUE="" D UP
S II=II+1,@DATA@(II)=$C(31)
Q
;
INIT(DATA,DFN) ; EP -- AGG FAMILY INITIAL TRIGGER
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,NKREL
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGTRFMY",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
S DOB=$P(^DPT(DFN,0),U,3)
S X=$E(X1,1,3)-$E(X2,1,3)-($E(X1,4,7)<$E(X2,4,7))
I X<18 D
. S SOURCE="AGGFTNME",ABLE="Y",TYPE="X",CLEAR="",HELP="",VALUE="" D UP
. S SOURCE="AGGMTNME",ABLE="Y",TYPE="X",CLEAR="",HELP="",VALUE="" D UP
S II=II+1,@DATA@(II)=$C(31)
Q
;
FTH(DATA,AGGFTNME) ; EP -- AGG FATHER NAME TRIGGER
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGFNMTR",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
I $G(AGGFTNME)="" D
. S SOURCE="AGGFTEMN",ABLE="Y",TYPE="T",CLEAR="AGGFTEMN",HELP="",VALUE="" D UP
S II=II+1,@DATA@(II)=$C(31)
Q
;
MTH(DATA,AGGMTNME) ; EP -- AGG MOTHER NAME TRIGGER
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGMNMTR",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
I $G(AGGMTNME)="" D
. S SOURCE="AGGMTEMN",ABLE="Y",TYPE="T",CLEAR="AGGMTEMN",HELP="",VALUE="" D UP
S II=II+1,@DATA@(II)=$C(31)
Q
AGGFMTRG ;VNGT/HS/ALA-Family, Contact Triggers ; 26 May 2010 11:06 AM
+1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
+2 ;
+3 ;
EC(DATA,DFN) ; EP -- AGG EMER CONTACT TRIGGER
+1 ; Input
+2 ; DFN - Patient IEN
+3 ;
+4 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGECREL
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET DATA=$NAME(^TMP("AGGTREC",UID))
+7 KILL @DATA
+8 SET II=0
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER"
+10 DO HDR
+11 SET @DATA@(II)=HDR_$CHAR(30)
+12 ; Other Relationship is disabled, if relationship is not OTHER
+13 SET AGGECREL=$$GET1^DIQ(9000001,DFN_",",3102,"E")
+14 IF AGGECREL'="OTHER"
SET SOURCE="AGGECORL"
SET VALUE=""
SET ABLE="N"
SET TYPE="X"
SET CLEAR=""
SET HELP=""
DO UP
+15 IF AGGECREL="OTHER"
Begin DoDot:1
+16 SET VALUE=$$GET1^DIQ(2,DFN_",",.332,"E")
+17 SET SOURCE="AGGECORL"
SET ABLE="Y"
SET TYPE="X"
SET CLEAR=""
SET HELP="Enter the 'other' relationship"
DO UP
End DoDot:1
+18 ;
+19 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+20 QUIT
+21 ;
ECREL(DATA,AGGECREL) ; EP -- AGG EC RELATION TRIGGER
+1 ; Input
+2 ; AGGECREL - Emergency Contact Relationship
+3 ;
+4 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,ECREL
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET DATA=$NAME(^TMP("AGGTRECRL",UID))
+7 KILL @DATA
+8 SET II=0
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER"
+10 DO HDR
+11 SET @DATA@(II)=HDR_$CHAR(30)
+12 ; Other Relationship is disabled, if relationship is not OTHER
+13 IF AGGECREL?.N
SET ECREL=$PIECE(^AUTTRLSH(AGGECREL,0),U,1)
+14 IF ECREL'="OTHER"
SET SOURCE="AGGECORL"
SET VALUE=""
SET ABLE="N"
SET TYPE="X"
SET CLEAR=""
SET HELP=""
DO UP
+15 IF ECREL="OTHER"
Begin DoDot:1
+16 SET SOURCE="AGGECORL"
SET ABLE="Y"
SET TYPE="X"
SET CLEAR=""
SET HELP="Enter the 'other' relationship"
SET VALUE=""
DO UP
End DoDot:1
+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_$CHAR(30)
+2 QUIT
+3 ;
HDR ;
+1 SET HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT"
+2 QUIT
+3 ;
NK(DATA,DFN) ; EP -- AGG NEXT OF KIN TRIGGER
+1 ; Input
+2 ; DFN - Patient IEN
+3 ;
+4 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGNKREL
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET DATA=$NAME(^TMP("AGGTRNK",UID))
+7 KILL @DATA
+8 SET II=0
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER"
+10 DO HDR
+11 SET @DATA@(II)=HDR_$CHAR(30)
+12 ; Other Relationship is disabled, if relationship is not OTHER
+13 SET AGGNKREL=$$GET1^DIQ(9000001,DFN_",",2802,"E")
+14 IF AGGNKREL'="OTHER"
SET SOURCE="AGGNKORL"
SET VALUE=""
SET ABLE="N"
SET TYPE="X"
SET CLEAR=""
SET HELP=""
DO UP
+15 IF AGGNKREL="OTHER"
Begin DoDot:1
+16 SET VALUE=$$GET1^DIQ(2,DFN_",",.212,"E")
+17 SET SOURCE="AGGNKORL"
SET ABLE="Y"
SET TYPE="X"
SET CLEAR=""
SET HELP="Enter the 'other' relationship"
DO UP
End DoDot:1
+18 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+19 QUIT
+20 ;
NKREL(DATA,AGGNKREL) ; EP -- AGG NK RELATION TRIGGER
+1 ; Input
+2 ; AGGNKREL - Next of Kin Relationship
+3 ;
+4 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,NKREL
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET DATA=$NAME(^TMP("AGGTRNKRL",UID))
+7 KILL @DATA
+8 SET II=0
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER"
+10 DO HDR
+11 SET @DATA@(II)=HDR_$CHAR(30)
+12 ; Other Relationship is disabled, if relationship is not OTHER
+13 IF AGGNKREL?.N
SET NKREL=$PIECE(^AUTTRLSH(AGGNKREL,0),U,1)
+14 IF NKREL'="OTHER"
SET SOURCE="AGGNKORL"
SET VALUE=""
SET ABLE="N"
SET TYPE="X"
SET CLEAR=""
SET HELP=""
DO UP
+15 IF NKREL="OTHER"
Begin DoDot:1
+16 SET SOURCE="AGGNKORL"
SET ABLE="Y"
SET TYPE="X"
SET CLEAR=""
SET HELP="Enter the 'other' relationship"
SET VALUE=""
DO UP
End DoDot:1
+17 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+18 QUIT
+19 ;
INIT(DATA,DFN) ; EP -- AGG FAMILY INITIAL TRIGGER
+1 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,NKREL
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGTRFMY",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER"
+7 DO HDR
+8 SET @DATA@(II)=HDR_$CHAR(30)
+9 SET DOB=$PIECE(^DPT(DFN,0),U,3)
+10 SET X=$EXTRACT(X1,1,3)-$EXTRACT(X2,1,3)-($EXTRACT(X1,4,7)<$EXTRACT(X2,4,7))
+11 IF X<18
Begin DoDot:1
+12 SET SOURCE="AGGFTNME"
SET ABLE="Y"
SET TYPE="X"
SET CLEAR=""
SET HELP=""
SET VALUE=""
DO UP
+13 SET SOURCE="AGGMTNME"
SET ABLE="Y"
SET TYPE="X"
SET CLEAR=""
SET HELP=""
SET VALUE=""
DO UP
End DoDot:1
+14 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+15 QUIT
+16 ;
FTH(DATA,AGGFTNME) ; EP -- AGG FATHER NAME TRIGGER
+1 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGFNMTR",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER"
+7 DO HDR
+8 SET @DATA@(II)=HDR_$CHAR(30)
+9 IF $GET(AGGFTNME)=""
Begin DoDot:1
+10 SET SOURCE="AGGFTEMN"
SET ABLE="Y"
SET TYPE="T"
SET CLEAR="AGGFTEMN"
SET HELP=""
SET VALUE=""
DO UP
End DoDot:1
+11 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+12 QUIT
+13 ;
MTH(DATA,AGGMTNME) ; EP -- AGG MOTHER NAME TRIGGER
+1 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGMNMTR",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER"
+7 DO HDR
+8 SET @DATA@(II)=HDR_$CHAR(30)
+9 IF $GET(AGGMTNME)=""
Begin DoDot:1
+10 SET SOURCE="AGGMTEMN"
SET ABLE="Y"
SET TYPE="T"
SET CLEAR="AGGMTEMN"
SET HELP=""
SET VALUE=""
DO UP
End DoDot:1
+11 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+12 QUIT
