AGGUPMCD ;VNGT/HS/ALA-Update Medicaid ; 20 May 2010 5:20 PM
;;1.0;PATIENT REGISTRATION GUI;**1**;Nov 15, 2010
;
;
UPD(DATA,DFN,PROC,DEF,RIEN,MIEN,PARMS) ; EP - AGG UPDATE MEDICAID
; Input
; DFN - Patient IEN
; RIEN - Record IEN
; MIEN - Multiple IEN
; PROC - 'A' to add, 'E' to edit, 'D' to delete
; DEF - Definition
; PARMS - Parameters
NEW UID,II,AGIEN,ERROR,AGGDATA
NEW IENS,DA,FILE,FIELD,EXEC,NAME,PDATA,BQ
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGUPMCD",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^I00010RIEN^I00010MIEN"_$C(30)
;
S AGIEN=$O(^AGG(9009068.3,"B",DEF,""))
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)
;
;if deleting a Medicaid
I $G(PROC)="D" D G DONE
. I +$G(MIEN)=0 S DA=RIEN,IENS=$$IENS^DILF(.DA)
. I +$G(MIEN)'=0 S DA(1)=RIEN,DA=MIEN,IENS=$$IENS^DILF(.DA)
. K IN3PB
. S IN3PB=$$USED^AGUTILS(DFN,$O(^AUTNINS("B","MEDICAID","")),7,MIEN,RIEN)
. I $G(PARMS)["OVERRIDE=Y" S IN3PB=""
. I IN3PB'="" D Q
.. S ERROR("DIERR",1,"TEXT",1)="WARNING: This member has outstanding claims and/or bills!!"_$C(10)
.. S ERROR("DIERR",1,"TEXT",1)=ERROR("DIERR",1,"TEXT",1)_"Deleting an eligibility date may cause data integrity problems"_$C(10)
.. S ERROR("DIERR",1,"TEXT",1)=ERROR("DIERR",1,"TEXT",1)_"in the Third Party Billing package!!"
. S AGGUPD(FILE,IENS,.01)="@"
. D FILE^DIE("","AGGUPD","ERROR")
. I $D(ERROR) Q
. I $O(^AUPNMCD(RIEN,11,0))'="" Q
. ; If no more eligibility dates, delete record
. NEW DIK,DA
. S DIK="^AUPNMCD(",DA=RIEN D ^DIK
;if adding a new Medicaid
D PARS
I $G(PROC)="A" D
. I $G(RIEN)="" D
.. S DLAYGO=FILE,DIC(0)="L",DIC="^AUPNMCD(",X=DFN
.. K DO,DD D FILE^DICN S RIEN=+Y
. I +$G(MIEN)=0,$G(RIEN)'="" D
.. I '$D(^AUPNMCD(RIEN,11,0)) S ^AUPNMCD(RIEN,11,0)="^9000004.11D^0^0"
.. I $G(AGGMDESD)="" Q
.. S DA(1)=RIEN,DLAYGO=FILE,DIC(0)="L",DIC="^AUPNMCD("_DA(1)_",11,"
.. S (X,DINUM)=AGGMDESD
.. K DO,DD D FILE^DICN S MIEN=+Y
;if editing a Medicaid
I +$G(MIEN)=0 S DA=RIEN,IENS=$$IENS^DILF(.DA)
I +$G(MIEN)'=0 S DA(1)=RIEN,DA=MIEN,IENS=$$IENS^DILF(.DA)
;
I FILE=9000004,$G(AGGMDINS)="" S AGGDATA(9000004,RIEN_",",.02)=$P($$MCD(),$C(29),1)
F BQ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
. 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="" S BMXSEC=NAME_" not a valid parameter for this update" Q
. S FIELD=$P($G(^AGG(9009068.3,AGIEN,10,PFIEN,3)),U,1)
. S EXEC=$G(^AGG(9009068.3,AGIEN,10,PFIEN,7))
. I EXEC'="" X EXEC Q
. I FIELD="" Q
. S AGGDATA(FILE,IENS,FIELD)=@NAME
;
I $D(AGGDATAI) D FILE^DIE("","AGGDATAI","ERROR")
I $D(AGGDATA) D FILE^DIE("","AGGDATA","ERROR")
;
DONE ;
S RESULT=1_U_U_RIEN_U_MIEN
I $D(ERROR) S RESULT="-1"_U_$G(ERROR("DIERR",1,"TEXT",1))_U_U
S II=II+1,@DATA@(II)=RESULT_$C(30)
S II=II+1,@DATA@(II)=$C(31)
;
I $P(RESULT,U,1)=1 D
. S AGGDATAI(9000001,DFN_",",.03)=DT,AGGDATAI(9000001,DFN_",",.12)=DUZ
. D FILE^DIE("","AGGDATAI","ERROR")
. D EDIT^AGGEXPRT(DFN)
;
S NAME=""
F S NAME=$O(^AGG(9009068.3,AGIEN,10,"AC",NAME)) Q:NAME="" K @NAME
K ERROR,AGGMDINS
Q
;
MCD() ;EP
NEW IEN
S IEN=$O(^AUTNINS("B","MEDICAID",""))
Q IEN_$C(29)_"MEDICAID"
;
MCNM(DFN) ;EP - NAME
Q $P(^DPT(DFN,0),U,1)
;
MCDB(DFN) ;EP - DOB
NEW DOB
S DOB=$P(^DPT(DFN,0),U,3)
Q $$FMTE^AGGUL1(DOB)
;
TRIG(DATA,DFN,PROC) ;EP - AGG MEDICAID TRIGGER
; Input
; DFN - Patient record
; PROC - Process; 'A' is add
;
NEW UID,II
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGMCDTR",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPTUPD D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR^AGGWTRIG
S @DATA@(II)=HDR_$C(30)
I $G(PROC)'="A" S II=II+1,@DATA@(II)=$C(31) Q
S ABLE="Y",HELP=""
S SOURCE="AGGMDINS",TYPE="T",VALUE=$$MCD() D UP^AGGWTRIG
S SOURCE="AGGMDNME",TYPE="X",VALUE=$$MCNM(DFN) D UP^AGGWTRIG
S SOURCE="AGGMDDOB",TYPE="D",VALUE=$$MCDB(DFN) D UP^AGGWTRIG
S II=II+1,@DATA@(II)=$C(31)
Q
;
PARS ;
F BQ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
. S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
. S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
. ;I VALUE="" S VALUE="@"
. ;I VALUE="" Q
. S PFIEN=$O(^AGG(9009068.3,AGIEN,10,"AC",NAME,""))
. I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
. S PTYP=$P($G(^AGG(9009068.3,AGIEN,10,PFIEN,1)),U,1)
. I PTYP="D" S VALUE=$$DATE^AGGUL1(VALUE)
. I PTYP="C" D
.. I VALUE="" Q
.. S CHIEN=$O(^AGG(9009068.3,AGIEN,10,PFIEN,5,"B",VALUE,"")) I CHIEN="" Q
.. S VALUE=$P(^AGG(9009068.3,AGIEN,10,PFIEN,5,CHIEN,0),U,2)
. I PTYP="W" D Q
.. F AGI=1:1 S AGJ=$P(VALUE,$C(10),AGI) Q:AGJ="" D
... S AGWP(AGI,0)=$$CTRL^AGGUL1(AGJ)
. S @NAME=VALUE
Q
AGGUPMCD ;VNGT/HS/ALA-Update Medicaid ; 20 May 2010 5:20 PM
+1 ;;1.0;PATIENT REGISTRATION GUI;**1**;Nov 15, 2010
+2 ;
+3 ;
UPD(DATA,DFN,PROC,DEF,RIEN,MIEN,PARMS) ; EP - AGG UPDATE MEDICAID
+1 ; Input
+2 ; DFN - Patient IEN
+3 ; RIEN - Record IEN
+4 ; MIEN - Multiple IEN
+5 ; PROC - 'A' to add, 'E' to edit, 'D' to delete
+6 ; DEF - Definition
+7 ; PARMS - Parameters
+8 NEW UID,II,AGIEN,ERROR,AGGDATA
+9 NEW IENS,DA,FILE,FIELD,EXEC,NAME,PDATA,BQ
+10 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+11 SET DATA=$NAME(^TMP("AGGUPMCD",UID))
+12 KILL @DATA
+13 ;
+14 SET II=0
+15 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGPTUPD D UNWIND^%ZTER"
+16 SET @DATA@(II)="I00010RESULT^T01024ERROR^I00010RIEN^I00010MIEN"_$CHAR(30)
+17 ;
+18 SET AGIEN=$ORDER(^AGG(9009068.3,"B",DEF,""))
+19 IF AGIEN=""
Begin DoDot:1
+20 SET II=II+1
SET @DATA@(II)="-1^"_"RPC Call Failed: "_DEF_" Definition does not exist."_$CHAR(30)
+21 SET II=II+1
SET @DATA@(II)=$CHAR(31)
End DoDot:1
QUIT
+22 SET FILE=$PIECE(^AGG(9009068.3,AGIEN,0),U,2)
+23 ;
+24 ;if deleting a Medicaid
+25 IF $GET(PROC)="D"
Begin DoDot:1
+26 IF +$GET(MIEN)=0
SET DA=RIEN
SET IENS=$$IENS^DILF(.DA)
+27 IF +$GET(MIEN)'=0
SET DA(1)=RIEN
SET DA=MIEN
SET IENS=$$IENS^DILF(.DA)
+28 KILL IN3PB
+29 SET IN3PB=$$USED^AGUTILS(DFN,$ORDER(^AUTNINS("B","MEDICAID","")),7,MIEN,RIEN)
+30 IF $GET(PARMS)["OVERRIDE=Y"
SET IN3PB=""
+31 IF IN3PB'=""
Begin DoDot:2
+32 SET ERROR("DIERR",1,"TEXT",1)="WARNING: This member has outstanding claims and/or bills!!"_$CHAR(10)
+33 SET ERROR("DIERR",1,"TEXT",1)=ERROR("DIERR",1,"TEXT",1)_"Deleting an eligibility date may cause data integrity problems"_$CHAR(10)
+34 SET ERROR("DIERR",1,"TEXT",1)=ERROR("DIERR",1,"TEXT",1)_"in the Third Party Billing package!!"
End DoDot:2
QUIT
+35 SET AGGUPD(FILE,IENS,.01)="@"
+36 DO FILE^DIE("","AGGUPD","ERROR")
+37 IF $DATA(ERROR)
QUIT
+38 IF $ORDER(^AUPNMCD(RIEN,11,0))'=""
QUIT
+39 ; If no more eligibility dates, delete record
+40 NEW DIK,DA
+41 SET DIK="^AUPNMCD("
SET DA=RIEN
DO ^DIK
End DoDot:1
GOTO DONE
+42 ;if adding a new Medicaid
+43 DO PARS
+44 IF $GET(PROC)="A"
Begin DoDot:1
+45 IF $GET(RIEN)=""
Begin DoDot:2
+46 SET DLAYGO=FILE
SET DIC(0)="L"
SET DIC="^AUPNMCD("
SET X=DFN
+47 KILL DO,DD
DO FILE^DICN
SET RIEN=+Y
End DoDot:2
+48 IF +$GET(MIEN)=0
IF $GET(RIEN)'=""
Begin DoDot:2
+49 IF '$DATA(^AUPNMCD(RIEN,11,0))
SET ^AUPNMCD(RIEN,11,0)="^9000004.11D^0^0"
+50 IF $GET(AGGMDESD)=""
QUIT
+51 SET DA(1)=RIEN
SET DLAYGO=FILE
SET DIC(0)="L"
SET DIC="^AUPNMCD("_DA(1)_",11,"
+52 SET (X,DINUM)=AGGMDESD
+53 KILL DO,DD
DO FILE^DICN
SET MIEN=+Y
End DoDot:2
End DoDot:1
+54 ;if editing a Medicaid
+55 IF +$GET(MIEN)=0
SET DA=RIEN
SET IENS=$$IENS^DILF(.DA)
+56 IF +$GET(MIEN)'=0
SET DA(1)=RIEN
SET DA=MIEN
SET IENS=$$IENS^DILF(.DA)
+57 ;
+58 IF FILE=9000004
IF $GET(AGGMDINS)=""
SET AGGDATA(9000004,RIEN_",",.02)=$PIECE($$MCD(),$CHAR(29),1)
+59 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+60 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+61 SET NAME=$PIECE(PDATA,"=",1)
+62 SET PFIEN=$ORDER(^AGG(9009068.3,AGIEN,10,"AC",NAME,""))
+63 IF PFIEN=""
SET BMXSEC=NAME_" not a valid parameter for this update"
QUIT
+64 SET FIELD=$PIECE($GET(^AGG(9009068.3,AGIEN,10,PFIEN,3)),U,1)
+65 SET EXEC=$GET(^AGG(9009068.3,AGIEN,10,PFIEN,7))
+66 IF EXEC'=""
XECUTE EXEC
QUIT
+67 IF FIELD=""
QUIT
+68 SET AGGDATA(FILE,IENS,FIELD)=@NAME
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+69 ;
+70 IF $DATA(AGGDATAI)
DO FILE^DIE("","AGGDATAI","ERROR")
+71 IF $DATA(AGGDATA)
DO FILE^DIE("","AGGDATA","ERROR")
+72 ;
DONE ;
+1 SET RESULT=1_U_U_RIEN_U_MIEN
+2 IF $DATA(ERROR)
SET RESULT="-1"_U_$GET(ERROR("DIERR",1,"TEXT",1))_U_U
+3 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
+4 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+5 ;
+6 IF $PIECE(RESULT,U,1)=1
Begin DoDot:1
+7 SET AGGDATAI(9000001,DFN_",",.03)=DT
SET AGGDATAI(9000001,DFN_",",.12)=DUZ
+8 DO FILE^DIE("","AGGDATAI","ERROR")
+9 DO EDIT^AGGEXPRT(DFN)
End DoDot:1
+10 ;
+11 SET NAME=""
+12 FOR
SET NAME=$ORDER(^AGG(9009068.3,AGIEN,10,"AC",NAME))
IF NAME=""
QUIT
KILL @NAME
+13 KILL ERROR,AGGMDINS
+14 QUIT
+15 ;
MCD() ;EP
+1 NEW IEN
+2 SET IEN=$ORDER(^AUTNINS("B","MEDICAID",""))
+3 QUIT IEN_$CHAR(29)_"MEDICAID"
+4 ;
MCNM(DFN) ;EP - NAME
+1 QUIT $PIECE(^DPT(DFN,0),U,1)
+2 ;
MCDB(DFN) ;EP - DOB
+1 NEW DOB
+2 SET DOB=$PIECE(^DPT(DFN,0),U,3)
+3 QUIT $$FMTE^AGGUL1(DOB)
+4 ;
TRIG(DATA,DFN,PROC) ;EP - AGG MEDICAID TRIGGER
+1 ; Input
+2 ; DFN - Patient record
+3 ; PROC - Process; 'A' is add
+4 ;
+5 NEW UID,II
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("AGGMCDTR",UID))
+8 KILL @DATA
+9 ;
+10 SET II=0
+11 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGPTUPD D UNWIND^%ZTER"
+12 DO HDR^AGGWTRIG
+13 SET @DATA@(II)=HDR_$CHAR(30)
+14 IF $GET(PROC)'="A"
SET II=II+1
SET @DATA@(II)=$CHAR(31)
QUIT
+15 SET ABLE="Y"
SET HELP=""
+16 SET SOURCE="AGGMDINS"
SET TYPE="T"
SET VALUE=$$MCD()
DO UP^AGGWTRIG
+17 SET SOURCE="AGGMDNME"
SET TYPE="X"
SET VALUE=$$MCNM(DFN)
DO UP^AGGWTRIG
+18 SET SOURCE="AGGMDDOB"
SET TYPE="D"
SET VALUE=$$MCDB(DFN)
DO UP^AGGWTRIG
+19 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+20 QUIT
+21 ;
PARS ;
+1 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+2 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+3 SET NAME=$PIECE(PDATA,"=",1)
SET VALUE=$PIECE(PDATA,"=",2,99)
+4 ;I VALUE="" S VALUE="@"
+5 ;I VALUE="" Q
+6 SET PFIEN=$ORDER(^AGG(9009068.3,AGIEN,10,"AC",NAME,""))
+7 IF PFIEN=""
SET BMXSEC=NAME_" not a valid parameter for this update"
QUIT
+8 SET PTYP=$PIECE($GET(^AGG(9009068.3,AGIEN,10,PFIEN,1)),U,1)
+9 IF PTYP="D"
SET VALUE=$$DATE^AGGUL1(VALUE)
+10 IF PTYP="C"
Begin DoDot:2
+11 IF VALUE=""
QUIT
+12 SET CHIEN=$ORDER(^AGG(9009068.3,AGIEN,10,PFIEN,5,"B",VALUE,""))
IF CHIEN=""
QUIT
+13 SET VALUE=$PIECE(^AGG(9009068.3,AGIEN,10,PFIEN,5,CHIEN,0),U,2)
End DoDot:2
+14 IF PTYP="W"
Begin DoDot:2
+15 FOR AGI=1:1
SET AGJ=$PIECE(VALUE,$CHAR(10),AGI)
IF AGJ=""
QUIT
Begin DoDot:3
+16 SET AGWP(AGI,0)=$$CTRL^AGGUL1(AGJ)
End DoDot:3
End DoDot:2
QUIT
+17 SET @NAME=VALUE
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+18 QUIT
