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)
Q
;
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)
Q
;
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)
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(REQ)_U_$G(CLEAR)_U_HELP_$C(30)
Q
;
HDR ;
S HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00001REQ_OPT^T00100CLEAR_FIELDS^T00200HELP_TEXT"
Q
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