AGGPOLCY ;VNGT/HS/ALA-Policy Members ; 28 Jun 2010 4:58 PM
;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
;
;
EN(DATA,INSN,POLH) ; EP -- AGG GET POLICY MEMBERS
; Input
; INSN - Insurer IEN
; POLH - Policy Holder IEN
;
NEW UID,II,MM,IN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGPOLCY",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWDISP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="I00010MBDFN^I00010AGGPIIEN^T00035AGGPLMNM^T00010AGGPMPCD^T00020AGGPINUM^T00006AGGPMHRN^T00050AGGPMREL^D00015AGGPHESD^"
S @DATA@(II)=@DATA@(II)_"D00015AGGPHEED^I00010AGGPLIEN^I00010AGGPIINS^T00003PROC^T00040AGGPICOV^T00035AGGPIHLN^T00035AGGPMPCP^"
S @DATA@(II)=@DATA@(II)_"T00007AGGPICCF^D00015AGGPICRD^T00020AGGPMNUM"_$C(30)
S MM=""
F S MM=$O(^AUPNPRVT("C",POLH,MM)) Q:MM="" D
. S IN=""
. F S IN=$O(^AUPNPRVT("C",POLH,MM,IN)) Q:IN="" D
.. I $P(^AUPNPRVT(MM,11,IN,0),U,1)'=INSN Q
.. NEW DA,IENS,REL,FROM,THRU,MEM,PC,MBNM,PCP,CCF,CCFD
.. S DA(1)=MM,DA=IN,IENS=$$IENS^DILF(.DA)
.. S REL=$$GET1^DIQ(9000006.11,IENS,.05,"I")
.. S FROM=$$GET1^DIQ(9000006.11,IENS,.06,"I")
.. S THRU=$$GET1^DIQ(9000006.11,IENS,.07,"I")
.. S MEM=$$GET1^DIQ(9000006.11,IENS,.02,"E")
.. S PC=$$GET1^DIQ(9000006.11,IENS,.12,"E")
.. S MBNM=$$GET1^DIQ(9000006.11,IENS,21,"E") I MBNM="" S MBNM=$$GET1^DIQ(9000003.1,POLH_",",.04,"E")
.. S PCP=$$GET1^DIQ(9000006.11,IENS,.14,"E")
.. S CCF=$$GET1^DIQ(9000006.11,IENS,.15,"I")
.. S CCFD=$$GET1^DIQ(9000006.11,IENS,.16,"I")
.. S II=II+1,@DATA@(II)=MM_U_IN_U_$P(^DPT(MM,0),U,1)_U_PC_U_MEM_U_$$HRN^AGGUL1(MM)_U
.. S @DATA@(II)=@DATA@(II)_REL_U_$$FMTE^AGGUL1(FROM)_U_$$FMTE^AGGUL1(THRU)_U_POLH_U_INSN_U_U_U_U_$G(PCP)_U_CCF_U_$$FMTE^AGGUL1(CCFD)_U_MBNM_$C(30)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
Q
;
UPOL(DATA,MBDFN,AGGPIINS,AGGPLHIN,PROC,PARMS) ; EP - AGG UPDATE POLICY MEMBER
; Input
; PROC - 'A' to add, 'E' to edit, 'D' to delete
; MBDFN - Selected Member IEN
; AGGPIINS - Insurer IEN
; AGGPLHIN - Policy Holder IEN
; PARMS - Parameters
NEW UID,II,AGIEN,AGGRIEN,LIST,BN,IENS,AGGPIIEN,ERROR,MBIEN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGUPOL",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPTUPD D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010RESULT^T01024ERROR^I00010AGGPIIEN"_$C(30)
;
S AGIEN=$O(^AGG(9009068.3,"B","Policy Members",""))
I AGIEN="" D Q
. S II=II+1,@DATA@(II)="-1^"_"RPC Call Failed: "_DEF_" Definition does not exist."_$C(30)
. S II=II+1,@DATA@(II)=$C(31)
;
S FILE=$P(^AGG(9009068.3,AGIEN,0),U,2)
;
I $G(AGGPIINS)="" S AGGPIINS=$$GET1^DIQ(9000003.1,AGGPLHIN_",",.03,"I")
I $G(AGGPIIEN)="" D
. S IN=""
. F S IN=$O(^AUPNPRVT("C",AGGPLHIN,MBDFN,IN)) Q:IN="" D
.. I $P(^AUPNPRVT(MBDFN,11,IN,0),U,1)'=AGGPIINS Q
.. S AGGPIIEN=IN
;
;if deleting a Member
I $G(PROC)="D" D G DNE
. NEW DA,IENS
. I $G(AGGPIIEN)="" Q
. S DA(1)=MBDFN,DA=AGGPIIEN,IENS=$$IENS^DILF(.DA)
. S AGGUPD(FILE,IENS,.01)="@"
. D FILE^DIE("","AGGUPD","ERROR")
;
S PARMS=$G(PARMS,"")
I PARMS="" D
. S LIST="",BN=""
. F S BN=$O(PARMS(BN)) Q:BN="" S LIST=LIST_PARMS(BN)
. K PARMS
. S PARMS=LIST
. K LIST
;
I PARMS="" D Q
. S II=II+1,@DATA@(II)=1_$C(30)
. S II=II+1,@DATA@(II)=$C(31)
;
; If selected member does not exist
I $G(^AUPNPRVT(MBDFN,0))="" D
. NEW DIC,X,DINUM
. S DIC="^AUPNPRVT(",DLAYGO=9000006,DIC(0)="L",X=MBDFN,DINUM=X
. K DO,DD D FILE^DICN
;
NEW DIC,X,Y
I $G(AGGPIIEN)="" D
. I $G(^AUPNPRVT(MBDFN,11,0))="" S ^AUPNPRVT(MBDFN,11,0)="^9000006.11P^^"
. S DIC="^AUPNPRVT("_MBDFN_",11,"
. S DIC("P")=$P(^DD(9000006,1101,0),U,2),DIC(0)="L",DA(1)=MBDFN,X="`"_AGGPIINS
. D ^DIC S AGGPIIEN=+Y
;
S MBIEN=AGGPIIEN
D PARS^AGGUPPVT
S AGGPIIEN=MBIEN
;
;if editing a Policy Member
S DA(1)=MBDFN,DA=AGGPIIEN,IENS=$$IENS^DILF(.DA)
;
F BQ=1:1:$L(PARMS,$C(28)) D
. S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
. S NAME=$P(PDATA,"=",1)
. S PFIEN=$O(^AGG(9009068.3,AGIEN,10,"AC",NAME,""))
. I PFIEN="" Q
. S FIELD=$P($G(^AGG(9009068.3,AGIEN,10,PFIEN,3)),U,1)
. S SECFLD=$P($G(^AGG(9009068.3,AGIEN,10,PFIEN,3)),U,7)
. S EXEC=$G(^AGG(9009068.3,AGIEN,10,PFIEN,7))
. I EXEC'="" X EXEC Q
. I FIELD="",SECFLD="" Q
. I FIELD=".001"!(SECFLD=".001") Q
. S PTYP=$P($G(^AGG(9009068.3,AGIEN,10,PFIEN,1)),U,1)
. ;
. I PTYP="C"!(PTYP="T")!(PTYP="K") D Q
.. I FIELD'="" D
... S DA(1)=MBDFN,DA=AGGPIIEN,IENS=$$IENS^DILF(.DA)
... S AGGDATAI(FILE,IENS,FIELD)=@NAME
. I FIELD'="" D
.. S DA(1)=MBDFN,DA=AGGPIIEN,IENS=$$IENS^DILF(.DA)
.. I PTYP="D" S AGGDATAI(FILE,IENS,FIELD)=$$DATE^AGGUL1(@NAME) Q
.. S AGGDATA(FILE,IENS,FIELD)=@NAME
S AGGDATAI(FILE,IENS,.08)=$G(AGGPLHIN)
;
I PROC="A" D
. S AGGDATAI(FILE,IENS,.06)=$$GET1^DIQ(9000003.1,AGGPLHIN_",",.17,"I")
. S AGGDATAI(FILE,IENS,.07)=$$GET1^DIQ(9000003.1,AGGPLHIN_",",.18,"I")
. S AGGDATA(FILE,IENS,.02)=$$GET1^DIQ(9000003.1,AGGPLHIN_",",.04,"E")
. S AGGDATA(FILE,IENS,21)=$$GET1^DIQ(9000003.1,AGGPLHIN_",",.04,"E")
;
I $G(AGGPMREL)="" S AGGPMREL=$$GET1^DIQ(FILE,IENS,.05,"I")
I $G(AGGPMREL)'="",$P(^AUTTRLSH(AGGPMREL,0),U,1)="SELF" D
. S AGGDATAI(9000003.1,AGGPLHIN_",",.18)=AGGPHEED
;
I $D(AGGDATA) D FILE^DIE("","AGGDATA","ERROR")
I $D(AGGDATAI) D FILE^DIE("I","AGGDATAI","ERROR")
;
DNE ;
S RESULT=1_U_U_AGGPIIEN
I $D(ERROR) S RESULT="-1"_U_$G(ERROR("DIERR",1,"TEXT",1))_U
S II=II+1,@DATA@(II)=RESULT_$C(30)
S II=II+1,@DATA@(II)=$C(31)
;
; Set last date updated and updated by
I $P(RESULT,U,1)=1 D
. S AGGDATAI(9000001,MBDFN_",",.03)=DT,AGGDATAI(9000001,MBDFN_",",.12)=DUZ
. D FILE^DIE("I","AGGDATAI","ERROR")
. D EDIT^AGGEXPRT(MBDFN)
;
S NAME=""
F S NAME=$O(^AGG(9009068.3,AGIEN,10,"AC",NAME)) Q:NAME="" K @NAME
K AGGDATA,AGGDATAI,ERROR,AGGPMREL
Q
;
INIT(DATA,TRANSTYP,AGGPLIEN) ;EP -- AGG POLICY MEMBER TRIGGER
NEW UID,II,HDR,SOURCE,VALUE,TYPE,ABLE,CLEAR,HELP,VISIBLE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGPMTRG",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 SOURCE="AGGPMREL",VALUE="",TYPE="T",ABLE="Y",CLEAR="",HELP="",VISIBLE=$S(TRANSTYP="A":"",1:"N"),REQ=$S(VISIBLE="":"R",1:"") D UP
S SOURCE="AGGPMREL",VALUE="",TYPE="T",ABLE="Y",CLEAR="",HELP="",VISIBLE="",REQ="R" D UP
S SOURCE="AGGPMPCD",VALUE="",TYPE="X",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE="" D UP
S SOURCE="AGGPICCF",VALUE="",TYPE="C",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE="" D UP
S SOURCE="AGGPICRD",VALUE="",TYPE="D",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE="" D UP
S SOURCE="AGGPMNUM",TYPE="X",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE="" D D UP
. S VALUE=$$GET1^DIQ(9000003.1,AGGPLIEN_",",.04,"E")
;S SOURCE="AGGPHESD",TYPE="D",ABLE="Y",CLEAR="",HELP="",REQ=$S(TRANSTYP="A":"O",1:"R"),VISIBLE=$S(TRANSTYP="A":"N",1:"") D D UP
S SOURCE="AGGPHESD",TYPE="D",ABLE=$S(TRANSTYP="A":"N",1:"Y"),CLEAR="",HELP="",REQ=$S(TRANSTYP="A":"O",1:"R"),VISIBLE="" D D UP
. S VALUE=""
. I TRANSTYP="A" S VALUE=$$FMTE^AGGUL1($$GET1^DIQ(9000003.1,AGGPLIEN_",",.17,"I"))
;S SOURCE="AGGPHEED",TYPE="D",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE=$S(TRANSTYP="A":"N",1:"") D D UP
S SOURCE="AGGPHEED",TYPE="D",ABLE=$S(TRANSTYP="A":"N",1:"Y"),CLEAR="",HELP="",REQ="",VISIBLE="" D D UP
. S VALUE=""
. I TRANSTYP="A" S VALUE=$$FMTE^AGGUL1($$GET1^DIQ(9000003.1,AGGPLIEN_",",.18,"I"))
S SOURCE="AGGPMPCP",VALUE="",TYPE="X",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE="" D UP
S II=II+1,@DATA@(II)=$C(31)
Q
;
HDR ;
S HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT^T00001REQ_OPT^T00001VISIBLE"
Q
;
UP ;
S II=II+1,@DATA@(II)=SOURCE_U_TYPE_U_VALUE_U_ABLE_U_$G(CLEAR)_U_HELP_U_$G(REQ)_U_$G(VISIBLE)_$C(30)
Q
;
MBTR(DATA,MBDFN) ;EP -- AGG MEMBER TRIGGER
NEW UID,II,HDR,SOURCE,VALUE,TYPE,ABLE,CLEAR,HELP
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGMBTRG",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 SOURCE="MBDFN",VALUE=MBDFN,TYPE="N",ABLE="Y",CLEAR="AGGPLMNM;AGGPMHRN",HELP="",REQ="",VISIBLE="" D UP
S SOURCE="AGGPLMNM",VALUE=$P(^DPT(MBDFN,0),U,1),TYPE="X",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE="" D UP
S SOURCE="AGGPMHRN",VALUE=$$HRN^AGGUL1(MBDFN),TYPE="X",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE="" D UP
S II=II+1,@DATA@(II)=$C(31)
Q
;
DATE(DATA,AGGPLIEN) ;EP -- AGG HOLDER DATES
NEW UID,II,HDR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGPHDATE",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="D00015AGGPHESD^D00015AGGPHEED"
S @DATA@(II)=HDR_$C(30)
S AGGPHESD=$$FMTE^AGGUL1($$GET1^DIQ(9000003.1,AGGPLIEN_",",.17,"I"))
S AGGPHEED=$$FMTE^AGGUL1($$GET1^DIQ(9000003.1,AGGPLIEN_",",.18,"I"))
S II=II+1,@DATA@(II)=AGGPHESD_U_AGGPHEED_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
AGGPOLCY ;VNGT/HS/ALA-Policy Members ; 28 Jun 2010 4:58 PM
+1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
+2 ;
+3 ;
EN(DATA,INSN,POLH) ; EP -- AGG GET POLICY MEMBERS
+1 ; Input
+2 ; INSN - Insurer IEN
+3 ; POLH - Policy Holder IEN
+4 ;
+5 NEW UID,II,MM,IN
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("AGGPOLCY",UID))
+8 KILL @DATA
+9 SET II=0
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGWDISP D UNWIND^%ZTER"
+11 ;
+12 SET @DATA@(II)="I00010MBDFN^I00010AGGPIIEN^T00035AGGPLMNM^T00010AGGPMPCD^T00020AGGPINUM^T00006AGGPMHRN^T00050AGGPMREL^D00015AGGPHESD^"
+13 SET @DATA@(II)=@DATA@(II)_"D00015AGGPHEED^I00010AGGPLIEN^I00010AGGPIINS^T00003PROC^T00040AGGPICOV^T00035AGGPIHLN^T00035AGGPMPCP^"
+14 SET @DATA@(II)=@DATA@(II)_"T00007AGGPICCF^D00015AGGPICRD^T00020AGGPMNUM"_$CHAR(30)
+15 SET MM=""
+16 FOR
SET MM=$ORDER(^AUPNPRVT("C",POLH,MM))
IF MM=""
QUIT
Begin DoDot:1
+17 SET IN=""
+18 FOR
SET IN=$ORDER(^AUPNPRVT("C",POLH,MM,IN))
IF IN=""
QUIT
Begin DoDot:2
+19 IF $PIECE(^AUPNPRVT(MM,11,IN,0),U,1)'=INSN
QUIT
+20 NEW DA,IENS,REL,FROM,THRU,MEM,PC,MBNM,PCP,CCF,CCFD
+21 SET DA(1)=MM
SET DA=IN
SET IENS=$$IENS^DILF(.DA)
+22 SET REL=$$GET1^DIQ(9000006.11,IENS,.05,"I")
+23 SET FROM=$$GET1^DIQ(9000006.11,IENS,.06,"I")
+24 SET THRU=$$GET1^DIQ(9000006.11,IENS,.07,"I")
+25 SET MEM=$$GET1^DIQ(9000006.11,IENS,.02,"E")
+26 SET PC=$$GET1^DIQ(9000006.11,IENS,.12,"E")
+27 SET MBNM=$$GET1^DIQ(9000006.11,IENS,21,"E")
IF MBNM=""
SET MBNM=$$GET1^DIQ(9000003.1,POLH_",",.04,"E")
+28 SET PCP=$$GET1^DIQ(9000006.11,IENS,.14,"E")
+29 SET CCF=$$GET1^DIQ(9000006.11,IENS,.15,"I")
+30 SET CCFD=$$GET1^DIQ(9000006.11,IENS,.16,"I")
+31 SET II=II+1
SET @DATA@(II)=MM_U_IN_U_$PIECE(^DPT(MM,0),U,1)_U_PC_U_MEM_U_$$HRN^AGGUL1(MM)_U
+32 SET @DATA@(II)=@DATA@(II)_REL_U_$$FMTE^AGGUL1(FROM)_U_$$FMTE^AGGUL1(THRU)_U_POLH_U_INSN_U_U_U_U_$GET(PCP)_U_CCF_U_$$FMTE^AGGUL1(CCFD)_U_MBNM_$CHAR(30)
End DoDot:2
End DoDot:1
+33 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
UPOL(DATA,MBDFN,AGGPIINS,AGGPLHIN,PROC,PARMS) ; EP - AGG UPDATE POLICY MEMBER
+1 ; Input
+2 ; PROC - 'A' to add, 'E' to edit, 'D' to delete
+3 ; MBDFN - Selected Member IEN
+4 ; AGGPIINS - Insurer IEN
+5 ; AGGPLHIN - Policy Holder IEN
+6 ; PARMS - Parameters
+7 NEW UID,II,AGIEN,AGGRIEN,LIST,BN,IENS,AGGPIIEN,ERROR,MBIEN
+8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+9 SET DATA=$NAME(^TMP("AGGUPOL",UID))
+10 KILL @DATA
+11 ;
+12 SET II=0
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGPTUPD D UNWIND^%ZTER"
+14 SET @DATA@(II)="I00010RESULT^T01024ERROR^I00010AGGPIIEN"_$CHAR(30)
+15 ;
+16 SET AGIEN=$ORDER(^AGG(9009068.3,"B","Policy Members",""))
+17 IF AGIEN=""
Begin DoDot:1
+18 SET II=II+1
SET @DATA@(II)="-1^"_"RPC Call Failed: "_DEF_" Definition does not exist."_$CHAR(30)
+19 SET II=II+1
SET @DATA@(II)=$CHAR(31)
End DoDot:1
QUIT
+20 ;
+21 SET FILE=$PIECE(^AGG(9009068.3,AGIEN,0),U,2)
+22 ;
+23 IF $GET(AGGPIINS)=""
SET AGGPIINS=$$GET1^DIQ(9000003.1,AGGPLHIN_",",.03,"I")
+24 IF $GET(AGGPIIEN)=""
Begin DoDot:1
+25 SET IN=""
+26 FOR
SET IN=$ORDER(^AUPNPRVT("C",AGGPLHIN,MBDFN,IN))
IF IN=""
QUIT
Begin DoDot:2
+27 IF $PIECE(^AUPNPRVT(MBDFN,11,IN,0),U,1)'=AGGPIINS
QUIT
+28 SET AGGPIIEN=IN
End DoDot:2
End DoDot:1
+29 ;
+30 ;if deleting a Member
+31 IF $GET(PROC)="D"
Begin DoDot:1
+32 NEW DA,IENS
+33 IF $GET(AGGPIIEN)=""
QUIT
+34 SET DA(1)=MBDFN
SET DA=AGGPIIEN
SET IENS=$$IENS^DILF(.DA)
+35 SET AGGUPD(FILE,IENS,.01)="@"
+36 DO FILE^DIE("","AGGUPD","ERROR")
End DoDot:1
GOTO DNE
+37 ;
+38 SET PARMS=$GET(PARMS,"")
+39 IF PARMS=""
Begin DoDot:1
+40 SET LIST=""
SET BN=""
+41 FOR
SET BN=$ORDER(PARMS(BN))
IF BN=""
QUIT
SET LIST=LIST_PARMS(BN)
+42 KILL PARMS
+43 SET PARMS=LIST
+44 KILL LIST
End DoDot:1
+45 ;
+46 IF PARMS=""
Begin DoDot:1
+47 SET II=II+1
SET @DATA@(II)=1_$CHAR(30)
+48 SET II=II+1
SET @DATA@(II)=$CHAR(31)
End DoDot:1
QUIT
+49 ;
+50 ; If selected member does not exist
+51 IF $GET(^AUPNPRVT(MBDFN,0))=""
Begin DoDot:1
+52 NEW DIC,X,DINUM
+53 SET DIC="^AUPNPRVT("
SET DLAYGO=9000006
SET DIC(0)="L"
SET X=MBDFN
SET DINUM=X
+54 KILL DO,DD
DO FILE^DICN
End DoDot:1
+55 ;
+56 NEW DIC,X,Y
+57 IF $GET(AGGPIIEN)=""
Begin DoDot:1
+58 IF $GET(^AUPNPRVT(MBDFN,11,0))=""
SET ^AUPNPRVT(MBDFN,11,0)="^9000006.11P^^"
+59 SET DIC="^AUPNPRVT("_MBDFN_",11,"
+60 SET DIC("P")=$PIECE(^DD(9000006,1101,0),U,2)
SET DIC(0)="L"
SET DA(1)=MBDFN
SET X="`"_AGGPIINS
+61 DO ^DIC
SET AGGPIIEN=+Y
End DoDot:1
+62 ;
+63 SET MBIEN=AGGPIIEN
+64 DO PARS^AGGUPPVT
+65 SET AGGPIIEN=MBIEN
+66 ;
+67 ;if editing a Policy Member
+68 SET DA(1)=MBDFN
SET DA=AGGPIIEN
SET IENS=$$IENS^DILF(.DA)
+69 ;
+70 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+71 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+72 SET NAME=$PIECE(PDATA,"=",1)
+73 SET PFIEN=$ORDER(^AGG(9009068.3,AGIEN,10,"AC",NAME,""))
+74 IF PFIEN=""
QUIT
+75 SET FIELD=$PIECE($GET(^AGG(9009068.3,AGIEN,10,PFIEN,3)),U,1)
+76 SET SECFLD=$PIECE($GET(^AGG(9009068.3,AGIEN,10,PFIEN,3)),U,7)
+77 SET EXEC=$GET(^AGG(9009068.3,AGIEN,10,PFIEN,7))
+78 IF EXEC'=""
XECUTE EXEC
QUIT
+79 IF FIELD=""
IF SECFLD=""
QUIT
+80 IF FIELD=".001"!(SECFLD=".001")
QUIT
+81 SET PTYP=$PIECE($GET(^AGG(9009068.3,AGIEN,10,PFIEN,1)),U,1)
+82 ;
+83 IF PTYP="C"!(PTYP="T")!(PTYP="K")
Begin DoDot:2
+84 IF FIELD'=""
Begin DoDot:3
+85 SET DA(1)=MBDFN
SET DA=AGGPIIEN
SET IENS=$$IENS^DILF(.DA)
+86 SET AGGDATAI(FILE,IENS,FIELD)=@NAME
End DoDot:3
End DoDot:2
QUIT
+87 IF FIELD'=""
Begin DoDot:2
+88 SET DA(1)=MBDFN
SET DA=AGGPIIEN
SET IENS=$$IENS^DILF(.DA)
+89 IF PTYP="D"
SET AGGDATAI(FILE,IENS,FIELD)=$$DATE^AGGUL1(@NAME)
QUIT
+90 SET AGGDATA(FILE,IENS,FIELD)=@NAME
End DoDot:2
End DoDot:1
+91 SET AGGDATAI(FILE,IENS,.08)=$GET(AGGPLHIN)
+92 ;
+93 IF PROC="A"
Begin DoDot:1
+94 SET AGGDATAI(FILE,IENS,.06)=$$GET1^DIQ(9000003.1,AGGPLHIN_",",.17,"I")
+95 SET AGGDATAI(FILE,IENS,.07)=$$GET1^DIQ(9000003.1,AGGPLHIN_",",.18,"I")
+96 SET AGGDATA(FILE,IENS,.02)=$$GET1^DIQ(9000003.1,AGGPLHIN_",",.04,"E")
+97 SET AGGDATA(FILE,IENS,21)=$$GET1^DIQ(9000003.1,AGGPLHIN_",",.04,"E")
End DoDot:1
+98 ;
+99 IF $GET(AGGPMREL)=""
SET AGGPMREL=$$GET1^DIQ(FILE,IENS,.05,"I")
+100 IF $GET(AGGPMREL)'=""
IF $PIECE(^AUTTRLSH(AGGPMREL,0),U,1)="SELF"
Begin DoDot:1
+101 SET AGGDATAI(9000003.1,AGGPLHIN_",",.18)=AGGPHEED
End DoDot:1
+102 ;
+103 IF $DATA(AGGDATA)
DO FILE^DIE("","AGGDATA","ERROR")
+104 IF $DATA(AGGDATAI)
DO FILE^DIE("I","AGGDATAI","ERROR")
+105 ;
DNE ;
+1 SET RESULT=1_U_U_AGGPIIEN
+2 IF $DATA(ERROR)
SET RESULT="-1"_U_$GET(ERROR("DIERR",1,"TEXT",1))_U
+3 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
+4 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+5 ;
+6 ; Set last date updated and updated by
+7 IF $PIECE(RESULT,U,1)=1
Begin DoDot:1
+8 SET AGGDATAI(9000001,MBDFN_",",.03)=DT
SET AGGDATAI(9000001,MBDFN_",",.12)=DUZ
+9 DO FILE^DIE("I","AGGDATAI","ERROR")
+10 DO EDIT^AGGEXPRT(MBDFN)
End DoDot:1
+11 ;
+12 SET NAME=""
+13 FOR
SET NAME=$ORDER(^AGG(9009068.3,AGIEN,10,"AC",NAME))
IF NAME=""
QUIT
KILL @NAME
+14 KILL AGGDATA,AGGDATAI,ERROR,AGGPMREL
+15 QUIT
+16 ;
INIT(DATA,TRANSTYP,AGGPLIEN) ;EP -- AGG POLICY MEMBER TRIGGER
+1 NEW UID,II,HDR,SOURCE,VALUE,TYPE,ABLE,CLEAR,HELP,VISIBLE
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGPMTRG",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 ;
+8 DO HDR
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 ;S SOURCE="AGGPMREL",VALUE="",TYPE="T",ABLE="Y",CLEAR="",HELP="",VISIBLE=$S(TRANSTYP="A":"",1:"N"),REQ=$S(VISIBLE="":"R",1:"") D UP
+11 SET SOURCE="AGGPMREL"
SET VALUE=""
SET TYPE="T"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
SET VISIBLE=""
SET REQ="R"
DO UP
+12 SET SOURCE="AGGPMPCD"
SET VALUE=""
SET TYPE="X"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
SET REQ=""
SET VISIBLE=""
DO UP
+13 SET SOURCE="AGGPICCF"
SET VALUE=""
SET TYPE="C"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
SET REQ=""
SET VISIBLE=""
DO UP
+14 SET SOURCE="AGGPICRD"
SET VALUE=""
SET TYPE="D"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
SET REQ=""
SET VISIBLE=""
DO UP
+15 SET SOURCE="AGGPMNUM"
SET TYPE="X"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
SET REQ=""
SET VISIBLE=""
Begin DoDot:1
+16 SET VALUE=$$GET1^DIQ(9000003.1,AGGPLIEN_",",.04,"E")
End DoDot:1
DO UP
+17 ;S SOURCE="AGGPHESD",TYPE="D",ABLE="Y",CLEAR="",HELP="",REQ=$S(TRANSTYP="A":"O",1:"R"),VISIBLE=$S(TRANSTYP="A":"N",1:"") D D UP
+18 SET SOURCE="AGGPHESD"
SET TYPE="D"
SET ABLE=$SELECT(TRANSTYP="A":"N",1:"Y")
SET CLEAR=""
SET HELP=""
SET REQ=$SELECT(TRANSTYP="A":"O",1:"R")
SET VISIBLE=""
Begin DoDot:1
+19 SET VALUE=""
+20 IF TRANSTYP="A"
SET VALUE=$$FMTE^AGGUL1($$GET1^DIQ(9000003.1,AGGPLIEN_",",.17,"I"))
End DoDot:1
DO UP
+21 ;S SOURCE="AGGPHEED",TYPE="D",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE=$S(TRANSTYP="A":"N",1:"") D D UP
+22 SET SOURCE="AGGPHEED"
SET TYPE="D"
SET ABLE=$SELECT(TRANSTYP="A":"N",1:"Y")
SET CLEAR=""
SET HELP=""
SET REQ=""
SET VISIBLE=""
Begin DoDot:1
+23 SET VALUE=""
+24 IF TRANSTYP="A"
SET VALUE=$$FMTE^AGGUL1($$GET1^DIQ(9000003.1,AGGPLIEN_",",.18,"I"))
End DoDot:1
DO UP
+25 SET SOURCE="AGGPMPCP"
SET VALUE=""
SET TYPE="X"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
SET REQ=""
SET VISIBLE=""
DO UP
+26 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+27 QUIT
+28 ;
HDR ;
+1 SET HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT^T00001REQ_OPT^T00001VISIBLE"
+2 QUIT
+3 ;
UP ;
+1 SET II=II+1
SET @DATA@(II)=SOURCE_U_TYPE_U_VALUE_U_ABLE_U_$GET(CLEAR)_U_HELP_U_$GET(REQ)_U_$GET(VISIBLE)_$CHAR(30)
+2 QUIT
+3 ;
MBTR(DATA,MBDFN) ;EP -- AGG MEMBER TRIGGER
+1 NEW UID,II,HDR,SOURCE,VALUE,TYPE,ABLE,CLEAR,HELP
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGMBTRG",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 ;
+8 DO HDR
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 SET SOURCE="MBDFN"
SET VALUE=MBDFN
SET TYPE="N"
SET ABLE="Y"
SET CLEAR="AGGPLMNM;AGGPMHRN"
SET HELP=""
SET REQ=""
SET VISIBLE=""
DO UP
+11 SET SOURCE="AGGPLMNM"
SET VALUE=$PIECE(^DPT(MBDFN,0),U,1)
SET TYPE="X"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
SET REQ=""
SET VISIBLE=""
DO UP
+12 SET SOURCE="AGGPMHRN"
SET VALUE=$$HRN^AGGUL1(MBDFN)
SET TYPE="X"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
SET REQ=""
SET VISIBLE=""
DO UP
+13 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+14 QUIT
+15 ;
DATE(DATA,AGGPLIEN) ;EP -- AGG HOLDER DATES
+1 NEW UID,II,HDR
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGPHDATE",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 ;
+8 SET HDR="D00015AGGPHESD^D00015AGGPHEED"
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 SET AGGPHESD=$$FMTE^AGGUL1($$GET1^DIQ(9000003.1,AGGPLIEN_",",.17,"I"))
+11 SET AGGPHEED=$$FMTE^AGGUL1($$GET1^DIQ(9000003.1,AGGPLIEN_",",.18,"I"))
+12 SET II=II+1
SET @DATA@(II)=AGGPHESD_U_AGGPHEED_$CHAR(30)
+13 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+14 QUIT
