Routine: AGGDCTRG

AGGDCTRG ;VNGT/HS/ALA-Document Triggers ; 26 May 2010  1:01 PM

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

DOC(DATA,DFN) ; EP -- AGG DOCUMENTS TRIGGER

 ; Input

 ;   DFN      - Patient IEN

 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGPTACK,REQ

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("AGGTRDOC",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),REQ="N"

 S AGGPTNPP=$$GET1^DIQ(9000038,DFN_",",.02,"E")

 I AGGPTNPP="YES" D

 . S VALUE=$$FMTE^AGGUL1($$GET1^DIQ(9000038,DFN_",",.03,"I"))

 . S SOURCE="AGGPTNPD",ABLE="Y",TYPE="D",CLEAR="",HELP="" D UP

 I AGGPTNPP="NO" S SOURCE="AGGPTNPD",ABLE="N",TYPE="D",CLEAR="AGGPTNPD",HELP="",VALUE="N" D UP

 S AGGPTACK=$$GET1^DIQ(9000038,DFN_",",.04,"E")

 I AGGPTACK="NO" D

 . S VALUE=$$GET1^DIQ(9000038,DFN_",",.05,"E")

 . S SOURCE="AGGPTAKN",ABLE="Y",TYPE="X",CLEAR="",HELP="Enter a reason patient did not sign the acknowledgement" D UP

 I AGGPTACK="YES" S SOURCE="AGGPTAKN",ABLE="N",TYPE="X",CLEAR="AGGPTAKN",HELP="",VALUE="" D UP

 S II=II+1,@DATA@(II)=$C(31)

NPP(DATA,AGGPTNPP) ; EP -- AGG NPP TRIGGER

 ; Input

 ;   AGGPTNP - Notice of Privacy Practice

 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,REQ

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("AGGTRNPP",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),REQ="N"

 I $E(AGGPTNPP,1)="Y" D

 . S SOURCE="AGGPTNPD",ABLE="Y",TYPE="D",CLEAR="",HELP="",VALUE="",REQ="R" D UP

 I $E(AGGPTNPP,1)="N" S SOURCE="AGGPTNPD",ABLE="N",TYPE="D",CLEAR="AGGPTNPD",HELP="",VALUE="" D UP

 S II=II+1,@DATA@(II)=$C(31)

ACK(DATA,ACK) ; EP -- AGG ACKNOWLEDGE TRIGGER

 ; Input

 ;   ACK   - Acknowledgement Signed

 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,REQ

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("AGGTRACK",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),REQ="N"

 I $E(ACK,1)="N" D

 . S SOURCE="AGGPTAKN",ABLE="Y",TYPE="X",CLEAR="",HELP="Enter a reason patient did not sign the acknowledgement",VALUE="" D UP

 I $E(ACK,1)="Y" S SOURCE="AGGPTAKN",ABLE="N",TYPE="X",CLEAR="AGGPTAKN",HELP="",VALUE="" 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(REQ)_U_$G(CLEAR)_U_HELP_$C(30)

HDR ;

 S HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00001REQ_OPT^T00100CLEAR_FIELDS^T00200HELP_TEXT"

AGGDCTRG  ;VNGT/HS/ALA-Document Triggers ; 26 May 2010  1:01 PM

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

 +2       ;

 +3       ;

DOC(DATA,DFN) ; EP -- AGG DOCUMENTS TRIGGER

 +1       ; Input

 +2       ;   DFN      - Patient IEN

 +3       ;

 +4        NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGPTACK,REQ

 +5        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +6        SET DATA=$NAME(^TMP("AGGTRDOC",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)

           SET REQ="N"

 +12      ;

 +13       SET AGGPTNPP=$$GET1^DIQ(9000038,DFN_",",.02,"E")

 +14       IF AGGPTNPP="YES"

               Begin DoDot:1

 +15               SET VALUE=$$FMTE^AGGUL1($$GET1^DIQ(9000038,DFN_",",.03,"I"))

 +16               SET SOURCE="AGGPTNPD"

                   SET ABLE="Y"

                   SET TYPE="D"

                   SET CLEAR=""

                   SET HELP=""

                   DO UP

               End DoDot:1

 +17       IF AGGPTNPP="NO"

               SET SOURCE="AGGPTNPD"

               SET ABLE="N"

               SET TYPE="D"

               SET CLEAR="AGGPTNPD"

               SET HELP=""

               SET VALUE="N"

               DO UP

 +18      ;

 +19       SET AGGPTACK=$$GET1^DIQ(9000038,DFN_",",.04,"E")

 +20       IF AGGPTACK="NO"

               Begin DoDot:1

 +21               SET VALUE=$$GET1^DIQ(9000038,DFN_",",.05,"E")

 +22               SET SOURCE="AGGPTAKN"

                   SET ABLE="Y"

                   SET TYPE="X"

                   SET CLEAR=""

                   SET HELP="Enter a reason patient did not sign the acknowledgement"

                   DO UP

               End DoDot:1

 +23       IF AGGPTACK="YES"

               SET SOURCE="AGGPTAKN"

               SET ABLE="N"

               SET TYPE="X"

               SET CLEAR="AGGPTAKN"

               SET HELP=""

               SET VALUE=""

               DO UP

 +24       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +25       QUIT

 +26      ;

NPP(DATA,AGGPTNPP) ; EP -- AGG NPP TRIGGER

 +1       ; Input

 +2       ;   AGGPTNP - Notice of Privacy Practice

 +3       ;

 +4        NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,REQ

 +5        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +6        SET DATA=$NAME(^TMP("AGGTRNPP",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)

           SET REQ="N"

 +12       IF $EXTRACT(AGGPTNPP,1)="Y"

               Begin DoDot:1

 +13               SET SOURCE="AGGPTNPD"

                   SET ABLE="Y"

                   SET TYPE="D"

                   SET CLEAR=""

                   SET HELP=""

                   SET VALUE=""

                   SET REQ="R"

                   DO UP

               End DoDot:1

 +14       IF $EXTRACT(AGGPTNPP,1)="N"

               SET SOURCE="AGGPTNPD"

               SET ABLE="N"

               SET TYPE="D"

               SET CLEAR="AGGPTNPD"

               SET HELP=""

               SET VALUE=""

               DO UP

 +15       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +16       QUIT

 +17      ;

ACK(DATA,ACK) ; EP -- AGG ACKNOWLEDGE TRIGGER

 +1       ; Input

 +2       ;   ACK   - Acknowledgement Signed

 +3       ;

 +4        NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,REQ

 +5        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +6        SET DATA=$NAME(^TMP("AGGTRACK",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)

           SET REQ="N"

 +12       IF $EXTRACT(ACK,1)="N"

               Begin DoDot:1

 +13               SET SOURCE="AGGPTAKN"

                   SET ABLE="Y"

                   SET TYPE="X"

                   SET CLEAR=""

                   SET HELP="Enter a reason patient did not sign the acknowledgement"

                   SET VALUE=""

                   DO UP

               End DoDot:1

 +14       IF $EXTRACT(ACK,1)="Y"

               SET SOURCE="AGGPTAKN"

               SET ABLE="N"

               SET TYPE="X"

               SET CLEAR="AGGPTAKN"

               SET HELP=""

               SET VALUE=""

               DO UP

 +15      ;

 +16       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +17       QUIT

 +18      ;

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(REQ)_U_$GET(CLEAR)_U_HELP_$CHAR(30)

 +2        QUIT

 +3       ;

HDR       ;

 +1        SET HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00001REQ_OPT^T00100CLEAR_FIELDS^T00200HELP_TEXT"

 +2        QUIT

AGGDCTRG.m