Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AGGPOLCY

AGGPOLCY.m

Go to the documentation of this file. 
  1. AGGPOLCY ;VNGT/HS/ALA-Policy Members ; 28 Jun 2010  4:58 PM
  1.  ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
  1.  ;
  1.  ;
  1. EN(DATA,INSN,POLH) ; EP -- AGG GET POLICY MEMBERS
  1.  ; Input
  1.  ;   INSN - Insurer IEN
  1.  ;   POLH - Policy Holder IEN
  1.  ;
  1.  NEW UID,II,MM,IN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGPOLCY",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWDISP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="I00010MBDFN^I00010AGGPIIEN^T00035AGGPLMNM^T00010AGGPMPCD^T00020AGGPINUM^T00006AGGPMHRN^T00050AGGPMREL^D00015AGGPHESD^"
  1.  S @DATA@(II)=@DATA@(II)_"D00015AGGPHEED^I00010AGGPLIEN^I00010AGGPIINS^T00003PROC^T00040AGGPICOV^T00035AGGPIHLN^T00035AGGPMPCP^"
  1.  S @DATA@(II)=@DATA@(II)_"T00007AGGPICCF^D00015AGGPICRD^T00020AGGPMNUM"_$C(30)
  1.  S MM=""
  1.  F  S MM=$O(^AUPNPRVT("C",POLH,MM)) Q:MM=""  D
  1.  . S IN=""
  1.  . F  S IN=$O(^AUPNPRVT("C",POLH,MM,IN)) Q:IN=""  D
  1.  .. I $P(^AUPNPRVT(MM,11,IN,0),U,1)'=INSN Q
  1.  .. NEW DA,IENS,REL,FROM,THRU,MEM,PC,MBNM,PCP,CCF,CCFD
  1.  .. S DA(1)=MM,DA=IN,IENS=$$IENS^DILF(.DA)
  1.  .. S REL=$$GET1^DIQ(9000006.11,IENS,.05,"I")
  1.  .. S FROM=$$GET1^DIQ(9000006.11,IENS,.06,"I")
  1.  .. S THRU=$$GET1^DIQ(9000006.11,IENS,.07,"I")
  1.  .. S MEM=$$GET1^DIQ(9000006.11,IENS,.02,"E")
  1.  .. S PC=$$GET1^DIQ(9000006.11,IENS,.12,"E")
  1.  .. S MBNM=$$GET1^DIQ(9000006.11,IENS,21,"E") I MBNM="" S MBNM=$$GET1^DIQ(9000003.1,POLH_",",.04,"E")
  1.  .. S PCP=$$GET1^DIQ(9000006.11,IENS,.14,"E")
  1.  .. S CCF=$$GET1^DIQ(9000006.11,IENS,.15,"I")
  1.  .. S CCFD=$$GET1^DIQ(9000006.11,IENS,.16,"I")
  1.  .. 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
  1.  .. 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)
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. UPOL(DATA,MBDFN,AGGPIINS,AGGPLHIN,PROC,PARMS) ; EP - AGG UPDATE POLICY MEMBER
  1.  ; Input
  1.  ;   PROC      - 'A' to add, 'E' to edit, 'D' to delete
  1.  ;   MBDFN     - Selected Member IEN
  1.  ;   AGGPIINS  - Insurer IEN
  1.  ;   AGGPLHIN  - Policy Holder IEN
  1.  ;   PARMS     - Parameters
  1.  NEW UID,II,AGIEN,AGGRIEN,LIST,BN,IENS,AGGPIIEN,ERROR,MBIEN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGUPOL",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPTUPD D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(II)="I00010RESULT^T01024ERROR^I00010AGGPIIEN"_$C(30)
  1.  ;
  1.  S AGIEN=$O(^AGG(9009068.3,"B","Policy Members",""))
  1.  I AGIEN="" D  Q
  1.  . S II=II+1,@DATA@(II)="-1^"_"RPC Call Failed: "_DEF_" Definition does not exist."_$C(30)
  1.  . S II=II+1,@DATA@(II)=$C(31)
  1.  ;
  1.  S FILE=$P(^AGG(9009068.3,AGIEN,0),U,2)
  1.  ;
  1.  I $G(AGGPIINS)="" S AGGPIINS=$$GET1^DIQ(9000003.1,AGGPLHIN_",",.03,"I")
  1.  I $G(AGGPIIEN)="" D
  1.  . S IN=""
  1.  . F  S IN=$O(^AUPNPRVT("C",AGGPLHIN,MBDFN,IN))  Q:IN=""  D
  1.  .. I $P(^AUPNPRVT(MBDFN,11,IN,0),U,1)'=AGGPIINS Q
  1.  .. S AGGPIIEN=IN
  1.  ;
  1.  ;if deleting a Member
  1.  I $G(PROC)="D" D  G DNE
  1.  . NEW DA,IENS
  1.  . I $G(AGGPIIEN)="" Q
  1.  . S DA(1)=MBDFN,DA=AGGPIIEN,IENS=$$IENS^DILF(.DA)
  1.  . S AGGUPD(FILE,IENS,.01)="@"
  1.  . D FILE^DIE("","AGGUPD","ERROR")
  1.  ;
  1.  S PARMS=$G(PARMS,"")
  1.  I PARMS="" D
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(PARMS(BN)) Q:BN=""  S LIST=LIST_PARMS(BN)
  1.  . K PARMS
  1.  . S PARMS=LIST
  1.  . K LIST
  1.  ; 
  1.  I PARMS="" D  Q
  1.  . S II=II+1,@DATA@(II)=1_$C(30)
  1.  . S II=II+1,@DATA@(II)=$C(31)
  1.  ;
  1.  ; If selected member does not exist
  1.  I $G(^AUPNPRVT(MBDFN,0))="" D
  1.  . NEW DIC,X,DINUM
  1.  . S DIC="^AUPNPRVT(",DLAYGO=9000006,DIC(0)="L",X=MBDFN,DINUM=X
  1.  . K DO,DD D FILE^DICN
  1.  ;
  1.  NEW DIC,X,Y
  1.  I $G(AGGPIIEN)="" D
  1.  . I $G(^AUPNPRVT(MBDFN,11,0))="" S ^AUPNPRVT(MBDFN,11,0)="^9000006.11P^^"
  1.  . S DIC="^AUPNPRVT("_MBDFN_",11,"
  1.  . S DIC("P")=$P(^DD(9000006,1101,0),U,2),DIC(0)="L",DA(1)=MBDFN,X="`"_AGGPIINS
  1.  . D ^DIC S AGGPIIEN=+Y
  1.  ;
  1.  S MBIEN=AGGPIIEN
  1.  D PARS^AGGUPPVT
  1.  S AGGPIIEN=MBIEN
  1.  ;
  1.  ;if editing a Policy Member
  1.  S DA(1)=MBDFN,DA=AGGPIIEN,IENS=$$IENS^DILF(.DA)
  1.  ;
  1.  F BQ=1:1:$L(PARMS,$C(28)) D
  1.  . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1)
  1.  . S PFIEN=$O(^AGG(9009068.3,AGIEN,10,"AC",NAME,""))
  1.  . I PFIEN="" Q
  1.  . S FIELD=$P($G(^AGG(9009068.3,AGIEN,10,PFIEN,3)),U,1)
  1.  . S SECFLD=$P($G(^AGG(9009068.3,AGIEN,10,PFIEN,3)),U,7)
  1.  . S EXEC=$G(^AGG(9009068.3,AGIEN,10,PFIEN,7))
  1.  . I EXEC'="" X EXEC Q
  1.  . I FIELD="",SECFLD="" Q
  1.  . I FIELD=".001"!(SECFLD=".001") Q
  1.  . S PTYP=$P($G(^AGG(9009068.3,AGIEN,10,PFIEN,1)),U,1)
  1.  . ;
  1.  . I PTYP="C"!(PTYP="T")!(PTYP="K") D  Q
  1.  .. I FIELD'="" D
  1.  ... S DA(1)=MBDFN,DA=AGGPIIEN,IENS=$$IENS^DILF(.DA)
  1.  ... S AGGDATAI(FILE,IENS,FIELD)=@NAME
  1.  . I FIELD'="" D
  1.  .. S DA(1)=MBDFN,DA=AGGPIIEN,IENS=$$IENS^DILF(.DA)
  1.  .. I PTYP="D" S AGGDATAI(FILE,IENS,FIELD)=$$DATE^AGGUL1(@NAME) Q
  1.  .. S AGGDATA(FILE,IENS,FIELD)=@NAME
  1.  S AGGDATAI(FILE,IENS,.08)=$G(AGGPLHIN)
  1.  ;
  1.  I PROC="A" D
  1.  . S AGGDATAI(FILE,IENS,.06)=$$GET1^DIQ(9000003.1,AGGPLHIN_",",.17,"I")
  1.  . S AGGDATAI(FILE,IENS,.07)=$$GET1^DIQ(9000003.1,AGGPLHIN_",",.18,"I")
  1.  . S AGGDATA(FILE,IENS,.02)=$$GET1^DIQ(9000003.1,AGGPLHIN_",",.04,"E")
  1.  . S AGGDATA(FILE,IENS,21)=$$GET1^DIQ(9000003.1,AGGPLHIN_",",.04,"E")
  1.  ;
  1.  I $G(AGGPMREL)="" S AGGPMREL=$$GET1^DIQ(FILE,IENS,.05,"I")
  1.  I $G(AGGPMREL)'="",$P(^AUTTRLSH(AGGPMREL,0),U,1)="SELF" D
  1.  . S AGGDATAI(9000003.1,AGGPLHIN_",",.18)=AGGPHEED
  1.  ;
  1.  I $D(AGGDATA) D FILE^DIE("","AGGDATA","ERROR")
  1.  I $D(AGGDATAI) D FILE^DIE("I","AGGDATAI","ERROR")
  1.  ;
  1. DNE ;
  1.  S RESULT=1_U_U_AGGPIIEN
  1.  I $D(ERROR) S RESULT="-1"_U_$G(ERROR("DIERR",1,"TEXT",1))_U
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  ;
  1.  ; Set last date updated and updated by
  1.  I $P(RESULT,U,1)=1 D
  1.  . S AGGDATAI(9000001,MBDFN_",",.03)=DT,AGGDATAI(9000001,MBDFN_",",.12)=DUZ
  1.  . D FILE^DIE("I","AGGDATAI","ERROR")
  1.  . D EDIT^AGGEXPRT(MBDFN)
  1.  ;
  1.  S NAME=""
  1.  F  S NAME=$O(^AGG(9009068.3,AGIEN,10,"AC",NAME)) Q:NAME=""  K @NAME
  1.  K AGGDATA,AGGDATAI,ERROR,AGGPMREL
  1.  Q
  1.  ;
  1. INIT(DATA,TRANSTYP,AGGPLIEN) ;EP -- AGG POLICY MEMBER TRIGGER
  1.  NEW UID,II,HDR,SOURCE,VALUE,TYPE,ABLE,CLEAR,HELP,VISIBLE
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGPMTRG",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  D HDR
  1.  S @DATA@(II)=HDR_$C(30)
  1.  ;S SOURCE="AGGPMREL",VALUE="",TYPE="T",ABLE="Y",CLEAR="",HELP="",VISIBLE=$S(TRANSTYP="A":"",1:"N"),REQ=$S(VISIBLE="":"R",1:"") D UP
  1.  S SOURCE="AGGPMREL",VALUE="",TYPE="T",ABLE="Y",CLEAR="",HELP="",VISIBLE="",REQ="R" D UP
  1.  S SOURCE="AGGPMPCD",VALUE="",TYPE="X",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE="" D UP
  1.  S SOURCE="AGGPICCF",VALUE="",TYPE="C",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE="" D UP
  1.  S SOURCE="AGGPICRD",VALUE="",TYPE="D",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE="" D UP
  1.  S SOURCE="AGGPMNUM",TYPE="X",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE="" D  D UP
  1.  . S VALUE=$$GET1^DIQ(9000003.1,AGGPLIEN_",",.04,"E")
  1.  ;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
  1.  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
  1.  . S VALUE=""
  1.  . I TRANSTYP="A" S VALUE=$$FMTE^AGGUL1($$GET1^DIQ(9000003.1,AGGPLIEN_",",.17,"I"))
  1.  ;S SOURCE="AGGPHEED",TYPE="D",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE=$S(TRANSTYP="A":"N",1:"") D  D UP
  1.  S SOURCE="AGGPHEED",TYPE="D",ABLE=$S(TRANSTYP="A":"N",1:"Y"),CLEAR="",HELP="",REQ="",VISIBLE="" D  D UP
  1.  . S VALUE=""
  1.  . I TRANSTYP="A" S VALUE=$$FMTE^AGGUL1($$GET1^DIQ(9000003.1,AGGPLIEN_",",.18,"I"))
  1.  S SOURCE="AGGPMPCP",VALUE="",TYPE="X",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE="" D UP
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. HDR ;
  1.  S HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT^T00001REQ_OPT^T00001VISIBLE"
  1.  Q
  1.  ;
  1. UP ;
  1.  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)
  1.  Q
  1.  ;
  1. MBTR(DATA,MBDFN) ;EP -- AGG MEMBER TRIGGER
  1.  NEW UID,II,HDR,SOURCE,VALUE,TYPE,ABLE,CLEAR,HELP
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGMBTRG",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  D HDR
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S SOURCE="MBDFN",VALUE=MBDFN,TYPE="N",ABLE="Y",CLEAR="AGGPLMNM;AGGPMHRN",HELP="",REQ="",VISIBLE="" D UP
  1.  S SOURCE="AGGPLMNM",VALUE=$P(^DPT(MBDFN,0),U,1),TYPE="X",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE="" D UP
  1.  S SOURCE="AGGPMHRN",VALUE=$$HRN^AGGUL1(MBDFN),TYPE="X",ABLE="Y",CLEAR="",HELP="",REQ="",VISIBLE="" D UP
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. DATE(DATA,AGGPLIEN) ;EP -- AGG HOLDER DATES
  1.  NEW UID,II,HDR
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGPHDATE",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="D00015AGGPHESD^D00015AGGPHEED"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S AGGPHESD=$$FMTE^AGGUL1($$GET1^DIQ(9000003.1,AGGPLIEN_",",.17,"I"))
  1.  S AGGPHEED=$$FMTE^AGGUL1($$GET1^DIQ(9000003.1,AGGPLIEN_",",.18,"I"))
  1.  S II=II+1,@DATA@(II)=AGGPHESD_U_AGGPHEED_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q