AGGFMTRG.m

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