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

AGGUPMCD.m

Go to the documentation of this file. 
  1. AGGUPMCD ;VNGT/HS/ALA-Update Medicaid ; 20 May 2010  5:20 PM
  1.  ;;1.0;PATIENT REGISTRATION GUI;**1**;Nov 15, 2010
  1.  ;
  1.  ;
  1. UPD(DATA,DFN,PROC,DEF,RIEN,MIEN,PARMS) ; EP - AGG UPDATE MEDICAID
  1.  ; Input
  1.  ;   DFN   - Patient IEN
  1.  ;   RIEN  - Record IEN
  1.  ;   MIEN  - Multiple IEN
  1.  ;   PROC  - 'A' to add, 'E' to edit, 'D' to delete
  1.  ;   DEF   - Definition
  1.  ;   PARMS - Parameters
  1.  NEW UID,II,AGIEN,ERROR,AGGDATA
  1.  NEW IENS,DA,FILE,FIELD,EXEC,NAME,PDATA,BQ
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGUPMCD",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^I00010RIEN^I00010MIEN"_$C(30)
  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)
  1.  ;
  1.  ;if deleting a Medicaid
  1.  I $G(PROC)="D" D  G DONE
  1.  . I +$G(MIEN)=0 S DA=RIEN,IENS=$$IENS^DILF(.DA)
  1.  . I +$G(MIEN)'=0 S DA(1)=RIEN,DA=MIEN,IENS=$$IENS^DILF(.DA)
  1.  . K IN3PB
  1.  . S IN3PB=$$USED^AGUTILS(DFN,$O(^AUTNINS("B","MEDICAID","")),7,MIEN,RIEN)
  1.  . I $G(PARMS)["OVERRIDE=Y" S IN3PB=""
  1.  . I IN3PB'="" D  Q
  1.  .. S ERROR("DIERR",1,"TEXT",1)="WARNING: This member has outstanding claims and/or bills!!"_$C(10)
  1.  .. S ERROR("DIERR",1,"TEXT",1)=ERROR("DIERR",1,"TEXT",1)_"Deleting an eligibility date may cause data integrity problems"_$C(10)
  1.  .. S ERROR("DIERR",1,"TEXT",1)=ERROR("DIERR",1,"TEXT",1)_"in the Third Party Billing package!!"
  1.  . S AGGUPD(FILE,IENS,.01)="@"
  1.  . D FILE^DIE("","AGGUPD","ERROR")
  1.  . I $D(ERROR) Q
  1.  . I $O(^AUPNMCD(RIEN,11,0))'="" Q
  1.  . ; If no more eligibility dates, delete record
  1.  . NEW DIK,DA
  1.  . S DIK="^AUPNMCD(",DA=RIEN D ^DIK
  1.  ;if adding a new Medicaid
  1.  D PARS
  1.  I $G(PROC)="A" D
  1.  . I $G(RIEN)="" D
  1.  .. S DLAYGO=FILE,DIC(0)="L",DIC="^AUPNMCD(",X=DFN
  1.  .. K DO,DD D FILE^DICN S RIEN=+Y
  1.  . I +$G(MIEN)=0,$G(RIEN)'="" D
  1.  .. I '$D(^AUPNMCD(RIEN,11,0)) S ^AUPNMCD(RIEN,11,0)="^9000004.11D^0^0"
  1.  .. I $G(AGGMDESD)="" Q
  1.  .. S DA(1)=RIEN,DLAYGO=FILE,DIC(0)="L",DIC="^AUPNMCD("_DA(1)_",11,"
  1.  .. S (X,DINUM)=AGGMDESD
  1.  .. K DO,DD D FILE^DICN S MIEN=+Y
  1.  ;if editing a Medicaid
  1.  I +$G(MIEN)=0 S DA=RIEN,IENS=$$IENS^DILF(.DA)
  1.  I +$G(MIEN)'=0 S DA(1)=RIEN,DA=MIEN,IENS=$$IENS^DILF(.DA)
  1.  ;
  1.  I FILE=9000004,$G(AGGMDINS)="" S AGGDATA(9000004,RIEN_",",.02)=$P($$MCD(),$C(29),1)
  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)
  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 EXEC=$G(^AGG(9009068.3,AGIEN,10,PFIEN,7))
  1.  . I EXEC'="" X EXEC Q
  1.  . I FIELD="" Q
  1.  . S AGGDATA(FILE,IENS,FIELD)=@NAME
  1.  ;
  1.  I $D(AGGDATAI) D FILE^DIE("","AGGDATAI","ERROR")
  1.  I $D(AGGDATA) D FILE^DIE("","AGGDATA","ERROR")
  1.  ;
  1. DONE ;
  1.  S RESULT=1_U_U_RIEN_U_MIEN
  1.  I $D(ERROR) S RESULT="-1"_U_$G(ERROR("DIERR",1,"TEXT",1))_U_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 ERROR,AGGMDINS
  1.  Q
  1.  ;
  1. MCD() ;EP
  1.  NEW IEN
  1.  S IEN=$O(^AUTNINS("B","MEDICAID",""))
  1.  Q IEN_$C(29)_"MEDICAID"
  1.  ;
  1. MCNM(DFN) ;EP - NAME
  1.  Q $P(^DPT(DFN,0),U,1)
  1.  ;
  1. MCDB(DFN) ;EP - DOB
  1.  NEW DOB
  1.  S DOB=$P(^DPT(DFN,0),U,3)
  1.  Q $$FMTE^AGGUL1(DOB)
  1.  ;
  1. TRIG(DATA,DFN,PROC) ;EP - AGG MEDICAID TRIGGER
  1.  ; Input
  1.  ;   DFN - Patient record
  1.  ;   PROC - Process; 'A' is add
  1.  ;
  1.  NEW UID,II
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGMCDTR",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.  D HDR^AGGWTRIG
  1.  S @DATA@(II)=HDR_$C(30)
  1.  I $G(PROC)'="A" S II=II+1,@DATA@(II)=$C(31) Q
  1.  S ABLE="Y",HELP=""
  1.  S SOURCE="AGGMDINS",TYPE="T",VALUE=$$MCD() D UP^AGGWTRIG
  1.  S SOURCE="AGGMDNME",TYPE="X",VALUE=$$MCNM(DFN) D UP^AGGWTRIG
  1.  S SOURCE="AGGMDDOB",TYPE="D",VALUE=$$MCDB(DFN) D UP^AGGWTRIG
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. PARS ;
  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.  . ;I VALUE="" S VALUE="@"
  1.  . ;I VALUE="" 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 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" 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