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

AGGUPPVT.m

Go to the documentation of this file. 
  1. AGGUPPVT ;VNGT/HS/ALA-Update Private Insurance ; 28 Jun 2010  12:11 PM
  1.  ;;1.0;PATIENT REGISTRATION GUI;**1**;Nov 15, 2010
  1.  ;
  1. UPD(DATA,PROC,DFN,AGGPIIEN,AGGPLIEN,PARMS) ; EP - AGG UPDATE PRIVATE INSUR
  1.  ; Input
  1.  ;   PROC      - 'A' to add, 'E' to edit, 'D' to delete
  1.  ;   DFN       - Patient IEN
  1.  ;   AGGPIIEN  - Insurer IEN
  1.  ;   AGGPLIEN  - Policy Holder IEN
  1.  ;   PARMS     - Parameters
  1.  NEW UID,II,AGIEN,ERROR,DEF,BN,LIST,FILE,SECFILE,BQ,AGGDATA,AGGDATAI,PHDATA
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGUPPVT",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^I00010AGGPLHIN"_$C(30)
  1.  ;
  1.  S DEF="Insurance Edit"
  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.  S AGIEN=$O(^AGG(9009068.3,"B",DEF,""))
  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.  S FILE=$P(^AGG(9009068.3,AGIEN,0),U,2),SECFILE=$P(^AGG(9009068.3,AGIEN,0),U,14)
  1.  ;
  1.  ;if deleting a Private Insurance
  1.  I $G(PROC)="D" D  G DONE
  1.  . S AGGUPD(FILE,IENS,.01)="@"
  1.  . D FILE^DIE("","AGGUPD","ERROR")
  1.  ;if adding a new Private Insurance
  1.  I $G(^AUPNPRVT(DFN,0))="" D
  1.  . NEW DIC,X,DINUM
  1.  . S DIC="^AUPNPRVT(",DLAYGO=9000006,DIC(0)="L",X=DFN,DINUM=X
  1.  . K DO,DD D FILE^DICN
  1.  ;
  1.  D PARS
  1.  I $G(PROC)="A" D
  1.  . NEW DIC,X,Y
  1.  . I $G(AGGPIIEN)="" D
  1.  .. I $G(^AUPNPRVT(DFN,11,0))="" S ^AUPNPRVT(DFN,11,0)="^9000006.11P^^"
  1.  .. S DIC="^AUPNPRVT("_DFN_",11,"
  1.  .. S DIC("P")=$P(^DD(9000006,1101,0),U,2),DIC(0)="L",DA(1)=DFN,X=AGGPIINS
  1.  .. D FILE^DICN S AGGPIIEN=+Y
  1.  . I $G(AGGPLIEN)="" D
  1.  .. NEW SCREEN,N,QFL
  1.  .. S SCREEN="I $P(^(0),U,3)=AGGPIINS",PHDATA=$NA(^TMP("DILIST",$J))
  1.  .. D FIND^DIC(9000003.1,"",".01;.18","PX",AGGPIHLN,"","",SCREEN,"","","ERROR")
  1.  .. S N=0,QFL=0
  1.  .. F  S N=$O(@PHDATA@(N)) Q:'N  D  Q:QFL
  1.  ... I $P(@PHDATA@(N,0),U,4)="" S AGGPLIEN=$P(@PHDATA@(N,0),U,1),QFL=1
  1.  .. K @PHDATA
  1.  .. I AGGPLIEN="" D
  1.  ... NEW DIC,DLAYGO,X,Y
  1.  ... S DIC="^AUPN3PPH(",X=AGGPIHLN,DLAYGO=9000003.1,DIC(0)="L"
  1.  ... K DO,DD D FILE^DICN S AGGPLIEN=+Y
  1.  .. NEW DA,IENS
  1.  .. S DA(1)=DFN,DA=AGGPIIEN,IENS=$$IENS^DILF(.DA)
  1.  .. S AGGDATAI(FILE,IENS,.08)=AGGPLIEN
  1.  ;
  1.  F BQ=1:1:$L(PARMS,$C(28)) D  Q:$G(BMXSEC)'=""
  1.  . NEW DA,IENS,PDATA,NAME,PFIEN,FIELD,SECFLD,EXEC,PTYP
  1.  . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1)
  1.  . I NAME="AGGPTDFN",@NAME="" Q
  1.  . S PFIEN=$O(^AGG(9009068.3,AGIEN,10,"AC",NAME,""))
  1.  . I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" 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.  . I PTYP="C"!(PTYP="T")!(PTYP="K") D  Q
  1.  .. I FIELD'="" D
  1.  ... S DA(1)=DFN,DA=AGGPIIEN,IENS=$$IENS^DILF(.DA)
  1.  ... S AGGDATAI(FILE,IENS,FIELD)=@NAME
  1.  .. I SECFLD'="" D
  1.  ... S DA=AGGPLIEN,IENS=$$IENS^DILF(.DA)
  1.  ... S AGGDATAI(SECFILE,IENS,SECFLD)=@NAME
  1.  . I FIELD'="" D
  1.  .. S DA(1)=DFN,DA=AGGPIIEN,IENS=$$IENS^DILF(.DA)
  1.  .. S AGGDATA(FILE,IENS,FIELD)=@NAME
  1.  . I SECFLD'="" D
  1.  .. S DA=AGGPLIEN,IENS=$$IENS^DILF(.DA)
  1.  .. S AGGDATA(SECFILE,IENS,SECFLD)=@NAME
  1.  ;
  1.  I $D(AGGDATA) D FILE^DIE("","AGGDATA","ERROR")
  1.  I $D(AGGDATAI) D FILE^DIE("I","AGGDATAI","ERROR")
  1.  D UPOL
  1.  ;
  1. DONE ;
  1.  S RESULT=1_U_U_AGGPIIEN_U_AGGPLIEN
  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.  I $P(RESULT,U,1)=1 D
  1.  . S AGGDATAI(9000001,DFN_",",.03)=DT,AGGDATAI(9000001,DFN_",",.12)=DUZ
  1.  . D FILE^DIE("","AGGDATAI","ERROR")
  1.  . D EDIT^AGGEXPRT(DFN)
  1.  ;
  1.  S NAME=""
  1.  F  S NAME=$O(^AGG(9009068.3,AGIEN,10,"AC",NAME)) Q:NAME=""  K @NAME
  1.  K PROC,DFN,AGGPIIEN,AGGPLIEN
  1.  Q
  1.  ;
  1. PARS ;
  1.  I $G(PARMS)="" Q
  1.  F BQ=1:1:$L(PARMS,$C(28)) D  Q:$G(BMXSEC)'=""
  1.  . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
  1.  . S PFIEN=$O(^AGG(9009068.3,AGIEN,10,"AC",NAME,""))
  1.  . I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
  1.  . S PTYP=$P($G(^AGG(9009068.3,AGIEN,10,PFIEN,1)),U,1)
  1.  . I PTYP="D" S VALUE=$$DATE^AGGUL1(VALUE)
  1.  . I PTYP="C"!(PTYP="K") D
  1.  .. I VALUE="" Q
  1.  .. S CHIEN=$O(^AGG(9009068.3,AGIEN,10,PFIEN,5,"B",VALUE,"")) I CHIEN="" Q
  1.  .. S VALUE=$P(^AGG(9009068.3,AGIEN,10,PFIEN,5,CHIEN,0),U,2)
  1.  . I PTYP="W" D  Q
  1.  .. F AGI=1:1  S AGJ=$P(VALUE,$C(10),AGI) Q:AGJ=""  D
  1.  ... S AGWP(AGI,0)=$$CTRL^AGGUL1(AGJ)
  1.  . S @NAME=VALUE
  1.  Q
  1.  ;
  1. UPOL ; EP - Update Policy Members
  1.  NEW IN,MBDFN
  1.  S MBDFN=""
  1.  F  S MBDFN=$O(^AUPNPRVT("C",AGGPLIEN,MBDFN)) Q:MBDFN=""  D
  1.  . S IN=""
  1.  . F  S IN=$O(^AUPNPRVT("C",AGGPLIEN,MBDFN,IN))  Q:IN=""  D
  1.  .. I $P(^AUPNPRVT(MBDFN,11,IN,0),U,1)'=AGGPIINS Q
  1.  .. NEW DA,IENS
  1.  .. S DA(1)=MBDFN,DA=IN,IENS=$$IENS^DILF(.DA)
  1.  .. I $$GET1^DIQ(9000006.11,IENS,.05,"E")="SELF" S AGGDATA(9000006.11,IENS,.06)=AGGPHESD,AGGDATA(9000006.11,IENS,.07)=AGGPHEED
  1.  .. I $$GET1^DIQ(9000006.11,IENS,.06,"I")="" S AGGDATA(9000006.11,IENS,.06)=AGGPHESD
  1.  .. I $$GET1^DIQ(9000006.11,IENS,.07,"I")="" S AGGDATA(9000006.11,IENS,.07)=AGGPHEED
  1.  .. I $$GET1^DIQ(9000006.11,IENS,21,"E")="" S AGGDATA(9000006.11,IENS,21)=$$GET1^DIQ(9000003.1,AGGPLIEN_",",.04,"E")
  1.  I $D(AGGDATA) D FILE^DIE("","AGGDATA","ERROR")
  1.  K AGGPHESD,AGGPHEED
  1.  Q