AGGPTTRG ;VNGT/HS/ALA-Patient Detail Triggers ; 27 May 2010 4:25 PM
;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
;
;
INIT(DATA,DFN) ;EP -- AGG PERSONAL DETAIL TRIGGER
; Input
; DFN - Patient IEN
;
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,NOSAVE,AGGPTSSV,DOBE,SSNV
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGTRPAT",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 DOBE=$P($G(^AGFAC(DUZ(2),0)),U,13),SSNV=$P(^AUPNPAT(DFN,0),U,23)
F SOURCE="AGGPTLNM","AGGPTFNM","AGGPTMNM","AGGPTSFX" S ABLE="N",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP
I $D(^XUSEC("AGZMGR",DUZ)) D
. S SOURCE="AGGPTHRN",ABLE="Y",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP
. I SSNV'="","XV"[$P(^AUTTSSN(SSNV,0),U) D Q
.. S SOURCE="AGGPTDOB",ABLE="Y",VALUE="",TYPE="D",HELP="The NAME/SSN/DOB have been Verified by the SSA do not change the DOB unless you are certain that it is incorrect!" D UP
. S SOURCE="AGGPTDOB",ABLE="Y",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP
I '$D(^XUSEC("AGZMGR",DUZ)) D
. S SOURCE="AGGPTHRN",ABLE="N",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP
. I SSNV'="","XV"[$P(^AUTTSSN(SSNV,0),U) D Q
.. I DOBE="Y" S SOURCE="AGGPTDOB",ABLE="N",VALUE="",TYPE="D",HELP="DOB must be edited by a supervisor." D UP
.. I DOBE="N" S SOURCE="AGGPTDOB",ABLE="Y",VALUE="",TYPE="D",HELP="The NAME/SSN/DOB have been Verified by the SSA do not change the DOB unless you are certain that it is incorrect!" D UP
. I DOBE="Y" S SOURCE="AGGPTDOB",ABLE="N",VALUE="",TYPE="X",HELP="DOB must be edited by a supervisor.",CLEAR="",NOSAVE="N" D UP
. I DOBE="N" S SOURCE="AGGPTDOB",ABLE="Y",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP
;
S AGGPTSSV=$$GET1^DIQ(9000001,DFN_",",.23,"E")
S AGGNOSSN=$$GET1^DIQ(9000001,DFN_",",.24,"E")
S AGGPTSSN=$$GET1^DIQ(2,DFN_",",.09,"E")
S SSN=$$GET1^DIQ(2,DFN_",",.09,"E")
;
I AGGPTSSN'="",AGGNOSSN="" D
. S SOURCE="AGGNOSSN",ABLE="N",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP
. I AGGPTSSV="P"!(AGGPTSSV="") S SOURCE="AGGPTSSN",ABLE="Y",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP
. I AGGPTSSV'="P",AGGPTSSV'="" S SOURCE="AGGPTSSN",ABLE="N",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="Y" D UP
I AGGPTSSN="",AGGNOSSN'="" D
. S SOURCE="AGGNOSSN",ABLE="Y",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP
. S SOURCE="AGGPTSSN",ABLE="N",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="Y" D UP
I AGGPTSSN="",AGGNOSSN="" D
. S SOURCE="AGGNOSSN",ABLE="Y",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP
. S SOURCE="AGGPTSSN",ABLE="N",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP
;
S HRN=$$HRN^AGGUL1(DFN)
I $E(HRN,1,1)="T",$D(^XUSEC("AGZMGR",DUZ)) S SOURCE="AGGPTHRN",ABLE="Y",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" 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_NOSAVE_U_$G(CFLAG)_U_$G(CLEAR)_U_HELP_$C(30)
Q
;
HDR ;
S HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00001NOSAVE^T00001CLEAR_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT"
Q
;
EMP(DATA,DFN,STATUS) ; EP -- AGG PAT EMPL STATUS TRIGGER
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGEMSTS,PREVSTS,FLAG,AGGPTEPL
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGTREMP",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 FLAG=0
S PREVSTS=$$GET1^DIQ(9000001,DFN_",",.21,"I")
I $G(STATUS)'="",$G(PREVSTS)'=STATUS S FLAG=1
S AGGEMSTS=STATUS
S AGGPTEPL=$$GET1^DIQ(9000001,DFN_",",.19,"I") D
. I 'FLAG S CLEAR="" Q
. I AGGEMSTS'=3&(AGGEMSTS'=5)&(AGGEMSTS'=9)&(PREVSTS'=3)&(PREVSTS'=5)&(PREVSTS'=9) S CLEAR="" Q
. S CLEAR="AGGPTEPL"
I PREVSTS="" S CLEAR="AGGPTEPL"
I AGGEMSTS'=3&(AGGEMSTS'=5)&(AGGEMSTS'=9) S SOURCE="AGGPTEPL",ABLE="Y",VALUE=AGGPTEPL,TYPE="T",HELP="",NOSAVE="N" D UP
E S SOURCE="AGGPTEPL",ABLE="N",TYPE="T",HELP="",CLEAR="",NOSAVE="N" D
. I AGGEMSTS=3 S VALUE=$O(^AUTNEMPL("B","UNEMPLOYED","")) D
.. I VALUE="" S ABLE="Y" Q
.. I VALUE'="" S VALUE=VALUE_$C(28)_"UNEMPLOYED"
. I AGGEMSTS=5 S VALUE=$O(^AUTNEMPL("B","RETIRED","")) D
.. I VALUE="" S ABLE="Y" Q
.. I VALUE'="" S VALUE=VALUE_$C(28)_"RETIRED"
. I AGGEMSTS=9 S VALUE=$O(^AUTNEMPL("B","UNKNOWN","")) D
.. I VALUE="" S ABLE="Y" Q
.. I VALUE'="" S VALUE=VALUE_$C(28)_"UNKNOWN"
. D UP
S II=II+1,@DATA@(II)=$C(31)
Q
;
SSN(DATA,SSN,NOSSN) ; EP -- AGG PAT SSN TRIGGER
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AUPN,AUPIDS
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGTRSSN",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(SSN)="",$G(NOSSN)="" D
. S SOURCE="AGGNOSSN",ABLE="Y",TYPE="T",HELP="",CLEAR="",NOSAVE="N",VALUE="" D UP
. S SOURCE="AGGPTSSN",ABLE="Y",TYPE="X",HELP="",CLEAR="",NOSAVE="N",VALUE="" D UP
I $G(SSN)'="",$G(NOSSN)="" D
. S SOURCE="AGGNOSSN",ABLE="N",TYPE="T",HELP="",CLEAR="AGGNOSSN",NOSAVE="N",VALUE="" D UP
I $G(SSN)="",$G(NOSSN)'="" D
. S SOURCE="AGGNOSSN",ABLE="Y",TYPE="T",HELP="",CLEAR="",NOSAVE="N",VALUE="" D UP
. S SOURCE="AGGPTSSN",ABLE="N",TYPE="X",HELP="",CLEAR="",NOSAVE="N",VALUE="" D UP
S II=II+1,@DATA@(II)=$C(31)
Q
AGGPTTRG ;VNGT/HS/ALA-Patient Detail Triggers ; 27 May 2010 4:25 PM
+1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
+2 ;
+3 ;
INIT(DATA,DFN) ;EP -- AGG PERSONAL DETAIL TRIGGER
+1 ; Input
+2 ; DFN - Patient IEN
+3 ;
+4 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,NOSAVE,AGGPTSSV,DOBE,SSNV
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET DATA=$NAME(^TMP("AGGTRPAT",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 ;
+13 SET DOBE=$PIECE($GET(^AGFAC(DUZ(2),0)),U,13)
SET SSNV=$PIECE(^AUPNPAT(DFN,0),U,23)
+14 FOR SOURCE="AGGPTLNM","AGGPTFNM","AGGPTMNM","AGGPTSFX"
SET ABLE="N"
SET VALUE=""
SET TYPE="X"
SET HELP=""
SET CLEAR=""
SET NOSAVE="N"
DO UP
+15 IF $DATA(^XUSEC("AGZMGR",DUZ))
Begin DoDot:1
+16 SET SOURCE="AGGPTHRN"
SET ABLE="Y"
SET VALUE=""
SET TYPE="X"
SET HELP=""
SET CLEAR=""
SET NOSAVE="N"
DO UP
+17 IF SSNV'=""
IF "XV"[$PIECE(^AUTTSSN(SSNV,0),U)
Begin DoDot:2
+18 SET SOURCE="AGGPTDOB"
SET ABLE="Y"
SET VALUE=""
SET TYPE="D"
SET HELP="The NAME/SSN/DOB have been Verified by the SSA do not change the DOB unless you are certain that it is incorrect!"
DO UP
End DoDot:2
QUIT
+19 SET SOURCE="AGGPTDOB"
SET ABLE="Y"
SET VALUE=""
SET TYPE="X"
SET HELP=""
SET CLEAR=""
SET NOSAVE="N"
DO UP
End DoDot:1
+20 IF '$DATA(^XUSEC("AGZMGR",DUZ))
Begin DoDot:1
+21 SET SOURCE="AGGPTHRN"
SET ABLE="N"
SET VALUE=""
SET TYPE="X"
SET HELP=""
SET CLEAR=""
SET NOSAVE="N"
DO UP
+22 IF SSNV'=""
IF "XV"[$PIECE(^AUTTSSN(SSNV,0),U)
Begin DoDot:2
+23 IF DOBE="Y"
SET SOURCE="AGGPTDOB"
SET ABLE="N"
SET VALUE=""
SET TYPE="D"
SET HELP="DOB must be edited by a supervisor."
DO UP
+24 IF DOBE="N"
SET SOURCE="AGGPTDOB"
SET ABLE="Y"
SET VALUE=""
SET TYPE="D"
SET HELP="The NAME/SSN/DOB have been Verified by the SSA do not change the DOB unless you are certain that it is incorrect!"
DO UP
End DoDot:2
QUIT
+25 IF DOBE="Y"
SET SOURCE="AGGPTDOB"
SET ABLE="N"
SET VALUE=""
SET TYPE="X"
SET HELP="DOB must be edited by a supervisor."
SET CLEAR=""
SET NOSAVE="N"
DO UP
+26 IF DOBE="N"
SET SOURCE="AGGPTDOB"
SET ABLE="Y"
SET VALUE=""
SET TYPE="X"
SET HELP=""
SET CLEAR=""
SET NOSAVE="N"
DO UP
End DoDot:1
+27 ;
+28 SET AGGPTSSV=$$GET1^DIQ(9000001,DFN_",",.23,"E")
+29 SET AGGNOSSN=$$GET1^DIQ(9000001,DFN_",",.24,"E")
+30 SET AGGPTSSN=$$GET1^DIQ(2,DFN_",",.09,"E")
+31 SET SSN=$$GET1^DIQ(2,DFN_",",.09,"E")
+32 ;
+33 IF AGGPTSSN'=""
IF AGGNOSSN=""
Begin DoDot:1
+34 SET SOURCE="AGGNOSSN"
SET ABLE="N"
SET VALUE=""
SET TYPE="X"
SET HELP=""
SET CLEAR=""
SET NOSAVE="N"
DO UP
+35 IF AGGPTSSV="P"!(AGGPTSSV="")
SET SOURCE="AGGPTSSN"
SET ABLE="Y"
SET VALUE=""
SET TYPE="X"
SET HELP=""
SET CLEAR=""
SET NOSAVE="N"
DO UP
+36 IF AGGPTSSV'="P"
IF AGGPTSSV'=""
SET SOURCE="AGGPTSSN"
SET ABLE="N"
SET VALUE=""
SET TYPE="X"
SET HELP=""
SET CLEAR=""
SET NOSAVE="Y"
DO UP
End DoDot:1
+37 IF AGGPTSSN=""
IF AGGNOSSN'=""
Begin DoDot:1
+38 SET SOURCE="AGGNOSSN"
SET ABLE="Y"
SET VALUE=""
SET TYPE="X"
SET HELP=""
SET CLEAR=""
SET NOSAVE="N"
DO UP
+39 SET SOURCE="AGGPTSSN"
SET ABLE="N"
SET VALUE=""
SET TYPE="X"
SET HELP=""
SET CLEAR=""
SET NOSAVE="Y"
DO UP
End DoDot:1
+40 IF AGGPTSSN=""
IF AGGNOSSN=""
Begin DoDot:1
+41 SET SOURCE="AGGNOSSN"
SET ABLE="Y"
SET VALUE=""
SET TYPE="X"
SET HELP=""
SET CLEAR=""
SET NOSAVE="N"
DO UP
+42 SET SOURCE="AGGPTSSN"
SET ABLE="N"
SET VALUE=""
SET TYPE="X"
SET HELP=""
SET CLEAR=""
SET NOSAVE="N"
DO UP
End DoDot:1
+43 ;
+44 SET HRN=$$HRN^AGGUL1(DFN)
+45 IF $EXTRACT(HRN,1,1)="T"
IF $DATA(^XUSEC("AGZMGR",DUZ))
SET SOURCE="AGGPTHRN"
SET ABLE="Y"
SET VALUE=""
SET TYPE="X"
SET HELP=""
SET CLEAR=""
SET NOSAVE="N"
DO UP
+46 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+47 QUIT
+48 ;
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_NOSAVE_U_$GET(CFLAG)_U_$GET(CLEAR)_U_HELP_$CHAR(30)
+2 QUIT
+3 ;
HDR ;
+1 SET HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00001NOSAVE^T00001CLEAR_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT"
+2 QUIT
+3 ;
EMP(DATA,DFN,STATUS) ; EP -- AGG PAT EMPL STATUS TRIGGER
+1 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGEMSTS,PREVSTS,FLAG,AGGPTEPL
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGTREMP",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 FLAG=0
+10 SET PREVSTS=$$GET1^DIQ(9000001,DFN_",",.21,"I")
+11 IF $GET(STATUS)'=""
IF $GET(PREVSTS)'=STATUS
SET FLAG=1
+12 SET AGGEMSTS=STATUS
+13 SET AGGPTEPL=$$GET1^DIQ(9000001,DFN_",",.19,"I")
Begin DoDot:1
+14 IF 'FLAG
SET CLEAR=""
QUIT
+15 IF AGGEMSTS'=3&(AGGEMSTS'=5)&(AGGEMSTS'=9)&(PREVSTS'=3)&(PREVSTS'=5)&(PREVSTS'=9)
SET CLEAR=""
QUIT
+16 SET CLEAR="AGGPTEPL"
End DoDot:1
+17 IF PREVSTS=""
SET CLEAR="AGGPTEPL"
+18 IF AGGEMSTS'=3&(AGGEMSTS'=5)&(AGGEMSTS'=9)
SET SOURCE="AGGPTEPL"
SET ABLE="Y"
SET VALUE=AGGPTEPL
SET TYPE="T"
SET HELP=""
SET NOSAVE="N"
DO UP
+19 IF '$TEST
SET SOURCE="AGGPTEPL"
SET ABLE="N"
SET TYPE="T"
SET HELP=""
SET CLEAR=""
SET NOSAVE="N"
Begin DoDot:1
+20 IF AGGEMSTS=3
SET VALUE=$ORDER(^AUTNEMPL("B","UNEMPLOYED",""))
Begin DoDot:2
+21 IF VALUE=""
SET ABLE="Y"
QUIT
+22 IF VALUE'=""
SET VALUE=VALUE_$CHAR(28)_"UNEMPLOYED"
End DoDot:2
+23 IF AGGEMSTS=5
SET VALUE=$ORDER(^AUTNEMPL("B","RETIRED",""))
Begin DoDot:2
+24 IF VALUE=""
SET ABLE="Y"
QUIT
+25 IF VALUE'=""
SET VALUE=VALUE_$CHAR(28)_"RETIRED"
End DoDot:2
+26 IF AGGEMSTS=9
SET VALUE=$ORDER(^AUTNEMPL("B","UNKNOWN",""))
Begin DoDot:2
+27 IF VALUE=""
SET ABLE="Y"
QUIT
+28 IF VALUE'=""
SET VALUE=VALUE_$CHAR(28)_"UNKNOWN"
End DoDot:2
+29 DO UP
End DoDot:1
+30 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+31 QUIT
+32 ;
SSN(DATA,SSN,NOSSN) ; EP -- AGG PAT SSN TRIGGER
+1 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AUPN,AUPIDS
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGTRSSN",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 ;
+10 IF $GET(SSN)=""
IF $GET(NOSSN)=""
Begin DoDot:1
+11 SET SOURCE="AGGNOSSN"
SET ABLE="Y"
SET TYPE="T"
SET HELP=""
SET CLEAR=""
SET NOSAVE="N"
SET VALUE=""
DO UP
+12 SET SOURCE="AGGPTSSN"
SET ABLE="Y"
SET TYPE="X"
SET HELP=""
SET CLEAR=""
SET NOSAVE="N"
SET VALUE=""
DO UP
End DoDot:1
+13 IF $GET(SSN)'=""
IF $GET(NOSSN)=""
Begin DoDot:1
+14 SET SOURCE="AGGNOSSN"
SET ABLE="N"
SET TYPE="T"
SET HELP=""
SET CLEAR="AGGNOSSN"
SET NOSAVE="N"
SET VALUE=""
DO UP
End DoDot:1
+15 IF $GET(SSN)=""
IF $GET(NOSSN)'=""
Begin DoDot:1
+16 SET SOURCE="AGGNOSSN"
SET ABLE="Y"
SET TYPE="T"
SET HELP=""
SET CLEAR=""
SET NOSAVE="N"
SET VALUE=""
DO UP
+17 SET SOURCE="AGGPTSSN"
SET ABLE="N"
SET TYPE="X"
SET HELP=""
SET CLEAR=""
SET NOSAVE="N"
SET VALUE=""
DO UP
End DoDot:1
+18 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+19 QUIT
