AGGARVAL ;VNGT/HS/BEE-AGG Alternate Resource RPC Calls ; 07 Apr 2010 7:05 PM
;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
;
;
MCDELG(DATA,MDESD,MDEED,MDECV,MDELIG) ;EP -- AGG VALIDATE MEDICAID ELIG ENTRY
;
;Input
; MDESD - AGGMDESD - Medicaid Eligibility Start Date
; MDEED - AGGMDEED - Medicaid Eligibility End Date
; MDECV - AGGMDECV - Medicaid Eligibility Coverage
; MDELIG - Current list of Eligibility Entries
;
NEW UID,II,LIST,BN,BQ,AGGMDESD,AGGMDEED,AGGMDECV,RESULT,EXPDT,EFFDT
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGARVAL",UID))
K @DATA
S II=0,MSG=""
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGARVAL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="I00010RESULT^T00100ERROR"_$C(30)
;
; Get list of current eligibility entries
S MDELIG=$G(MDELIG,"")
I MDELIG="" D
. S LIST="",BN=""
. F S BN=$O(MDELIG(BN)) Q:BN="" S LIST=LIST_MDELIG(BN)
. K MDELIG
. S MDELIG=LIST
. K LIST
;
;Parse Parameters
S (AGGMDESD,AGGMDEED,AGGMDECV)=""
F BQ=1:1:$L(MDELIG,$C(28)) D
. N PDATA,NAME,VALUE,BP,BV
. S PDATA=$P(MDELIG,$C(28),BQ) Q:PDATA=""
. S NAME=$P(PDATA,"=",1) I NAME="" Q
. S VALUE=$P(PDATA,"=",2,99) Q:VALUE=""
. F BP=1:1:$L(VALUE,$C(29)) S BV=$P(VALUE,$C(29),BP),@NAME=$G(@NAME)_$S(BP=1:"",1:$C(29))_BV
;
;Reset Return Result
S RESULT="1^"
;
;If no current entries pass test
I AGGMDESD="" S II=II+1,@DATA@(II)=RESULT_$C(30) G DONE
;
;Convert dates
S MDESD=$$DATE^AGGUL1(MDESD) S:MDESD="" MDESD=9999999
S MDEED=$$DATE^AGGUL1(MDEED) S:MDEED="" MDEED=9999999
;
;Loop through current entries and check for overlap
;
;First check for the same coverage
F BQ=1:1:$L(AGGMDESD,$C(29)) D I RESULT'="1^" Q
. ;
. ;Check for overlapping date range
. S EXPDT=$$DATE^AGGUL1($P($P(AGGMDEED,$C(29),BQ)," ")) S:EXPDT="" EXPDT=9999999
. S EFFDT=$$DATE^AGGUL1($P($P(AGGMDESD,$C(29),BQ)," ")) S:EFFDT="" EFFDT=0
. ;
. ;Cannot have same start date
. I MDESD=EFFDT S RESULT="-1^" Q
. ;
. ;Check coverage
. I MDECV'=$P(AGGMDECV,$C(29),BQ) Q
. ;
. ;Other date checks
. I MDESD'<EFFDT,MDESD'>EXPDT S RESULT="-1^" Q
. I MDEED'<EFFDT,MDEED'>EXPDT S RESULT="-1^" Q
. I MDESD<EFFDT,MDEED>EXPDT S RESULT="-1^" Q
. Q
I RESULT="-1^" S RESULT=RESULT_"YOU HAVE ENTERED A COVERAGE DATE RANGE WHICH OVERLAPS WITH ANOTHER ALREADY EXISTING FOR THIS PATIENT! THE ENTRY WILL NOT BE ALLOWED!"
;
S II=II+1,@DATA@(II)=RESULT_$C(30)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
;
;Clear out variables
F BQ=1:1:$L(MDELIG,$C(28)) S NAME=$P($P(MDELIG,$C(28),BQ),"=") I NAME]"" K @NAME
;
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
MCDACT(RIEN) ;Check if Medicaid Entry is Active
;
;Input: RIEN - ^AUPNMCD Pointer
;Output: ACTIVE/INACTIVE
;
N RESULT,IEN,EFFDT,EXPDT
;
S (RESULT,IEN)=0 F S IEN=$O(^AUPNMCD(RIEN,11,IEN)) Q:'IEN D I RESULT=1 Q
. S EFFDT=$$GET1^DIQ(9000004.11,IEN_","_RIEN_",",.01,"I") S:EFFDT="" EFFDT=0
. S EXPDT=$$GET1^DIQ(9000004.11,IEN_","_RIEN_",",.02,"I") S:EXPDT="" EXPDT=9999999
. I DT'<EFFDT,DT'>EXPDT S RESULT=1
;
S RESULT=$S(RESULT=1:"ACTIVE",1:"INACTIVE")
Q RESULT
;
MCRACT(DFN) ;Check if Medicare Entry is Active
;
;Input: DFN - ^AUPNMCR Pointer
;Output: ACTIVE/INACTIVE/Null-For no Medicare
;
N RESULT,IEN,EFFDT,EXPDT
;
I '$D(^AUPNMCR(DFN)) Q ""
S (RESULT,IEN)=0 F S IEN=$O(^AUPNMCR(DFN,11,IEN)) Q:'IEN D I RESULT=1 Q
. S EFFDT=$$GET1^DIQ(9000003.11,IEN_","_DFN_",",.01,"I") S:EFFDT="" EFFDT=0
. S EXPDT=$$GET1^DIQ(9000003.11,IEN_","_DFN_",",.02,"I") S:EXPDT="" EXPDT=9999999
. I DT'<EFFDT,DT'>EXPDT S RESULT=1
;
S RESULT=$S(RESULT=1:"ACTIVE",1:"INACTIVE")
Q RESULT
;
PVTACT(IENS) ;Check if Private Insurance entry is active for patient
;Check member info first and if blank look at policy holder info
;
;Input: IENS - Lookup string to ^AUPNPRVT entry
;Ouput: ACTIVE/INACTIVE/Null - For no information
NEW POLIEN,EFFDT,EXPDT,RESULT
;
I $G(IENS)="" Q ""
S RESULT=""
;
;First look for member effective/expiration dates
S EFFDT=$$GET1^DIQ(9000006.11,IENS,.06,"I")
S EXPDT=$$GET1^DIQ(9000006.11,IENS,.07,"I")
I EFFDT]""!(EXPDT]"") D Q RESULT
. S:EFFDT="" EFFDT=0
. S:EXPDT="" EXPDT=9999999
. I DT'<EFFDT,DT'>EXPDT S RESULT="ACTIVE" Q
. S RESULT="INACTIVE"
;
;If no member effective/expiration dates look at policy holder
S POLIEN=$$GET1^DIQ(9000006.11,IENS,.08,"I")
I POLIEN="" Q ""
S EFFDT=$$GET1^DIQ(9000003.1,POLIEN_",",.17,"I") S:EFFDT="" EFFDT=0
S EXPDT=$$GET1^DIQ(9000003.1,POLIEN_",",.18,"I") S:EXPDT="" EXPDT=9999999
I DT'<EFFDT,DT'>EXPDT Q "ACTIVE"
Q "INACTIVE"
;
INIT(DATA,RIEN,DFN) ;EP - AGG MEDICAID INIT TRIG
; Input
; RIEN - Pointer to the Patient's Medicaid Entry
; DFN - Patient IEN
;
NEW UID,II,HDR,SOURCE,HELP,TYPE,VALUE,ABLE,VISIBLE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGUPMCR",UID))
K @DATA
;
S II=0,RIEN=$G(RIEN)
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGARVAL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR^AGGWTRIG
S @DATA@(II)=HDR_$C(30)
;
S RIEN=$G(RIEN)
;
;Always disable Date of Last Update field
S SOURCE="AGGLSTDT",HELP="",TYPE="D",VALUE="" S:RIEN]"" VALUE=$$FMTE^AGGUL1($$GET1^DIQ(9000004,RIEN_",",.08,"I")) S ABLE="N" S:VALUE="" VISIBLE="N" D UP^AGGWTRIG
S:RIEN="" SOURCE="AGGMDNME",HELP="",TYPE="X",VALUE=$$GET1^DIQ(2,DFN_",",.01,"E"),ABLE="Y",VISIBLE="Y" D UP^AGGWTRIG
S:RIEN="" SOURCE="AGGMDDOB",HELP="",TYPE="D",VALUE=$$FMTE^AGGUL1($$GET1^DIQ(2,DFN_",",.03,"I")),ABLE="Y",VISIBLE="Y" D UP^AGGWTRIG
;
XINIT S II=II+1,@DATA@(II)=$C(31)
Q
;
VAL(DATA,VFILE,PARMS) ;EP -- AGG MEDICARE ELIG VAL
;
;Input
; VFILE - The vfile number or name
; PARMS - The parameters being checked for validation
;
NEW UID,II,BQ,LIST,BN,PDATA,NAME,VALUE,HDR,CODN,VALID,VALFLD,BI,VFLD,TYPE,X,RESULT,AGGMCCOV
NEW VFIEN,MSG,HNDLR,IEN,CODE,REVAL,MCELIG
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGARVAL",UID))
K @DATA
S II=0,MSG=""
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGARVAL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S VFILE=$G(VFILE,"") I VFILE="" S BMXSEC="RPC Failed: No Window selected" Q
S VFIEN=$O(^AGG(9009068.3,"B",VFILE,""))
;
S @DATA@(II)="I00010RESULT^T00100MSG^T00001HANDLER^I00010IEN^T00008CODE^T00100REVALIDATE"_$C(30)
; Get list of parameters
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="" S II=II+1,@DATA@(II)="1^"_$G(MSG)_U_$G(HNDLR)_U_$G(IEN)_U_$G(CODE)_U_$G(REVAL)_$C(30) G XDONE
;
;Special Handling for Type of Coverage Validation - Multiple Field Passed
I $P($P(PARMS,$C(28)),"=")="AGGMCCOV" D
.S AGGMCCOV=$P($P(PARMS,$C(28)),"=",2)
.S MCELIG=$P(PARMS,"MCELIG=",2)
.S CODN=$O(^AGG(9009068.3,VFIEN,10,"B","Type of Coverage","")) Q:CODN=""
.S VALID=$P($G(^AGG(9009068.3,VFIEN,10,CODN,2)),U,2)
.S VALFLD=$P($G(^AGG(9009068.3,VFIEN,10,CODN,2)),U,1)
;
;Regular Parameter Parsing
I $P($P(PARMS,$C(28)),"=")'="AGGMCCOV" 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 NAME["{"!(NAME["}") S NAME=$$STRIP^XLFSTR(NAME,"{}")
. S @NAME=VALUE
. ; If value is DFN, it exists at the PCC Visit level not individual
. ; V File level.
. I VFILE'=9000010&(NAME="DFN"!(NAME="APCDDATE")) Q
. S CODN=$O(^AGG(9009068.3,VFIEN,10,"AC",NAME,""))
. I CODN="" S BMXSEC="RPC Failed: Parameter does not exist for this Window" Q
. I $G(VALID)="" S VALID=$P($G(^AGG(9009068.3,VFIEN,10,CODN,2)),U,2)
. I $G(VALFLD)="" S VALFLD=$P($G(^AGG(9009068.3,VFIEN,10,CODN,2)),U,1)
;
; Check that values exist for all fields needed for the validation
F BI=1:1:$L(VALFLD,";") S VFLD=$P(VALFLD,";",BI) D
. I VFLD["*" S VFLD=$$STRIP^XLFSTR(VFLD,"*") Q
. I VFLD["{"!(VFLD["}") S VFLD=$$STRIP^XLFSTR(VFLD,"{}") Q
. I $G(@VFLD)="" S BMXSEC="RPC Failed: Missing validation value for "_VFLD
I $G(BMXSEC)'="" Q
;
S VALID=$TR(VALID,"~","^"),RESULT=0
; Execute the validation tag
D @VALID
S II=II+1,@DATA@(II)=RESULT_U_$G(MSG)_U_$G(HNDLR)_U_$G(IEN)_U_$G(CODE)_U_$G(REVAL)_$C(30)
; Clean up validation variables
F BI=1:1:$L(VALFLD,";") D
. S VFLD=$P(VALFLD,";",BI),VFLD=$$STRIP^XLFSTR(VFLD,"*"),VFLD=$$STRIP^XLFSTR(VFLD,"{}")
. K @VFLD
;
XDONE ;
S II=II+1,@DATA@(II)=$C(31)
S NAME=""
F S NAME=$O(^AGG(9009068.3,VFIEN,10,"AC",NAME)) Q:NAME="" K @NAME
Q
;
PRTD(TYPCV,MCELIG) ;EP - New Part D Check for current Part A/B
N BQ
S RESULT=-1,MSG=""
I TYPCV'="D" S RESULT=1 Q
F BQ=1:1:$L(MCELIG,$C(28)) D Q:RESULT=1
. N PDATA,NAME,VALUE,I
. S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
. S NAME=$P(PDATA,"=",1)
. Q:NAME'="AGGMCCOV"
. S VALUE=$P(PDATA,"=",2,99)
. F I=1:1:$L(VALUE,$C(29)) I $P(VALUE,$C(29),I)="A"!($P(VALUE,$C(29),I)="B") S RESULT=1 Q
Q:RESULT=1
S MSG="Patient must have Medicare Part A or Part B before being eligible for Part D"
Q
;
DTEMS(STRT,END) ; EP - Elig dates validation for Medicare
S RESULT=1
S STRT=$$DATE^AGGUL1(STRT),END=$$DATE^AGGUL1(END)
I $G(STRT)'="",2600000>STRT S RESULT=-1,MSG="Start Date cannot be before 1960" Q
I $G(STRT)'="",DT+20000<STRT S RESULT=-1,MSG="Start Date cannot be greater than 2 years from today" Q
;
I $G(STRT)'="",$G(END)="" Q
I $G(STRT)'="",$G(END)'="",STRT<END S RESULT=1 Q
I $G(STRT)'="",$G(END)'="",STRT>END S RESULT=-1,MSG="Starting date cannot be greater than the Ending date" Q
Q
;
DTEME(END,STRT) ; EP
S RESULT=1
S STRT=$$DATE^AGGUL1(STRT),END=$$DATE^AGGUL1(END)
I $G(END)'="",2600000>END S RESULT=-1,MSG="End Date cannot be before 1960" Q
I $G(END)'="",DT+20000<END S RESULT=-1,MSG="End Date cannot be greater than 2 years from today" Q
;
I $G(STRT)'="",$G(END)="" Q
I $G(STRT)'="",$G(END)'="",STRT<END S RESULT=1 Q
I $G(STRT)'="",$G(END)'="",STRT>END S RESULT=-1,MSG="Ending date cannot be less than the Starting date" Q
Q
AGGARVAL ;VNGT/HS/BEE-AGG Alternate Resource RPC Calls ; 07 Apr 2010 7:05 PM
+1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
+2 ;
+3 ;
MCDELG(DATA,MDESD,MDEED,MDECV,MDELIG) ;EP -- AGG VALIDATE MEDICAID ELIG ENTRY
+1 ;
+2 ;Input
+3 ; MDESD - AGGMDESD - Medicaid Eligibility Start Date
+4 ; MDEED - AGGMDEED - Medicaid Eligibility End Date
+5 ; MDECV - AGGMDECV - Medicaid Eligibility Coverage
+6 ; MDELIG - Current list of Eligibility Entries
+7 ;
+8 NEW UID,II,LIST,BN,BQ,AGGMDESD,AGGMDEED,AGGMDECV,RESULT,EXPDT,EFFDT
+9 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+10 SET DATA=$NAME(^TMP("AGGARVAL",UID))
+11 KILL @DATA
+12 SET II=0
SET MSG=""
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGARVAL D UNWIND^%ZTER"
+14 ;
+15 SET @DATA@(II)="I00010RESULT^T00100ERROR"_$CHAR(30)
+16 ;
+17 ; Get list of current eligibility entries
+18 SET MDELIG=$GET(MDELIG,"")
+19 IF MDELIG=""
Begin DoDot:1
+20 SET LIST=""
SET BN=""
+21 FOR
SET BN=$ORDER(MDELIG(BN))
IF BN=""
QUIT
SET LIST=LIST_MDELIG(BN)
+22 KILL MDELIG
+23 SET MDELIG=LIST
+24 KILL LIST
End DoDot:1
+25 ;
+26 ;Parse Parameters
+27 SET (AGGMDESD,AGGMDEED,AGGMDECV)=""
+28 FOR BQ=1:1:$LENGTH(MDELIG,$CHAR(28))
Begin DoDot:1
+29 NEW PDATA,NAME,VALUE,BP,BV
+30 SET PDATA=$PIECE(MDELIG,$CHAR(28),BQ)
IF PDATA=""
QUIT
+31 SET NAME=$PIECE(PDATA,"=",1)
IF NAME=""
QUIT
+32 SET VALUE=$PIECE(PDATA,"=",2,99)
IF VALUE=""
QUIT
+33 FOR BP=1:1:$LENGTH(VALUE,$CHAR(29))
SET BV=$PIECE(VALUE,$CHAR(29),BP)
SET @NAME=$GET(@NAME)_$SELECT(BP=1:"",1:$CHAR(29))_BV
End DoDot:1
+34 ;
+35 ;Reset Return Result
+36 SET RESULT="1^"
+37 ;
+38 ;If no current entries pass test
+39 IF AGGMDESD=""
SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
GOTO DONE
+40 ;
+41 ;Convert dates
+42 SET MDESD=$$DATE^AGGUL1(MDESD)
IF MDESD=""
SET MDESD=9999999
+43 SET MDEED=$$DATE^AGGUL1(MDEED)
IF MDEED=""
SET MDEED=9999999
+44 ;
+45 ;Loop through current entries and check for overlap
+46 ;
+47 ;First check for the same coverage
+48 FOR BQ=1:1:$LENGTH(AGGMDESD,$CHAR(29))
Begin DoDot:1
+49 ;
+50 ;Check for overlapping date range
+51 SET EXPDT=$$DATE^AGGUL1($PIECE($PIECE(AGGMDEED,$CHAR(29),BQ)," "))
IF EXPDT=""
SET EXPDT=9999999
+52 SET EFFDT=$$DATE^AGGUL1($PIECE($PIECE(AGGMDESD,$CHAR(29),BQ)," "))
IF EFFDT=""
SET EFFDT=0
+53 ;
+54 ;Cannot have same start date
+55 IF MDESD=EFFDT
SET RESULT="-1^"
QUIT
+56 ;
+57 ;Check coverage
+58 IF MDECV'=$PIECE(AGGMDECV,$CHAR(29),BQ)
QUIT
+59 ;
+60 ;Other date checks
+61 IF MDESD'<EFFDT
IF MDESD'>EXPDT
SET RESULT="-1^"
QUIT
+62 IF MDEED'<EFFDT
IF MDEED'>EXPDT
SET RESULT="-1^"
QUIT
+63 IF MDESD<EFFDT
IF MDEED>EXPDT
SET RESULT="-1^"
QUIT
+64 QUIT
End DoDot:1
IF RESULT'="1^"
QUIT
+65 IF RESULT="-1^"
SET RESULT=RESULT_"YOU HAVE ENTERED A COVERAGE DATE RANGE WHICH OVERLAPS WITH ANOTHER ALREADY EXISTING FOR THIS PATIENT! THE ENTRY WILL NOT BE ALLOWED!"
+66 ;
+67 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
+68 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 ;
+3 ;Clear out variables
+4 FOR BQ=1:1:$LENGTH(MDELIG,$CHAR(28))
SET NAME=$PIECE($PIECE(MDELIG,$CHAR(28),BQ),"=")
IF NAME]""
KILL @NAME
+5 ;
+6 QUIT
+7 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
MCDACT(RIEN) ;Check if Medicaid Entry is Active
+1 ;
+2 ;Input: RIEN - ^AUPNMCD Pointer
+3 ;Output: ACTIVE/INACTIVE
+4 ;
+5 NEW RESULT,IEN,EFFDT,EXPDT
+6 ;
+7 SET (RESULT,IEN)=0
FOR
SET IEN=$ORDER(^AUPNMCD(RIEN,11,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+8 SET EFFDT=$$GET1^DIQ(9000004.11,IEN_","_RIEN_",",.01,"I")
IF EFFDT=""
SET EFFDT=0
+9 SET EXPDT=$$GET1^DIQ(9000004.11,IEN_","_RIEN_",",.02,"I")
IF EXPDT=""
SET EXPDT=9999999
+10 IF DT'<EFFDT
IF DT'>EXPDT
SET RESULT=1
End DoDot:1
IF RESULT=1
QUIT
+11 ;
+12 SET RESULT=$SELECT(RESULT=1:"ACTIVE",1:"INACTIVE")
+13 QUIT RESULT
+14 ;
MCRACT(DFN) ;Check if Medicare Entry is Active
+1 ;
+2 ;Input: DFN - ^AUPNMCR Pointer
+3 ;Output: ACTIVE/INACTIVE/Null-For no Medicare
+4 ;
+5 NEW RESULT,IEN,EFFDT,EXPDT
+6 ;
+7 IF '$DATA(^AUPNMCR(DFN))
QUIT ""
+8 SET (RESULT,IEN)=0
FOR
SET IEN=$ORDER(^AUPNMCR(DFN,11,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+9 SET EFFDT=$$GET1^DIQ(9000003.11,IEN_","_DFN_",",.01,"I")
IF EFFDT=""
SET EFFDT=0
+10 SET EXPDT=$$GET1^DIQ(9000003.11,IEN_","_DFN_",",.02,"I")
IF EXPDT=""
SET EXPDT=9999999
+11 IF DT'<EFFDT
IF DT'>EXPDT
SET RESULT=1
End DoDot:1
IF RESULT=1
QUIT
+12 ;
+13 SET RESULT=$SELECT(RESULT=1:"ACTIVE",1:"INACTIVE")
+14 QUIT RESULT
+15 ;
PVTACT(IENS) ;Check if Private Insurance entry is active for patient
+1 ;Check member info first and if blank look at policy holder info
+2 ;
+3 ;Input: IENS - Lookup string to ^AUPNPRVT entry
+4 ;Ouput: ACTIVE/INACTIVE/Null - For no information
+5 NEW POLIEN,EFFDT,EXPDT,RESULT
+6 ;
+7 IF $GET(IENS)=""
QUIT ""
+8 SET RESULT=""
+9 ;
+10 ;First look for member effective/expiration dates
+11 SET EFFDT=$$GET1^DIQ(9000006.11,IENS,.06,"I")
+12 SET EXPDT=$$GET1^DIQ(9000006.11,IENS,.07,"I")
+13 IF EFFDT]""!(EXPDT]"")
Begin DoDot:1
+14 IF EFFDT=""
SET EFFDT=0
+15 IF EXPDT=""
SET EXPDT=9999999
+16 IF DT'<EFFDT
IF DT'>EXPDT
SET RESULT="ACTIVE"
QUIT
+17 SET RESULT="INACTIVE"
End DoDot:1
QUIT RESULT
+18 ;
+19 ;If no member effective/expiration dates look at policy holder
+20 SET POLIEN=$$GET1^DIQ(9000006.11,IENS,.08,"I")
+21 IF POLIEN=""
QUIT ""
+22 SET EFFDT=$$GET1^DIQ(9000003.1,POLIEN_",",.17,"I")
IF EFFDT=""
SET EFFDT=0
+23 SET EXPDT=$$GET1^DIQ(9000003.1,POLIEN_",",.18,"I")
IF EXPDT=""
SET EXPDT=9999999
+24 IF DT'<EFFDT
IF DT'>EXPDT
QUIT "ACTIVE"
+25 QUIT "INACTIVE"
+26 ;
INIT(DATA,RIEN,DFN) ;EP - AGG MEDICAID INIT TRIG
+1 ; Input
+2 ; RIEN - Pointer to the Patient's Medicaid Entry
+3 ; DFN - Patient IEN
+4 ;
+5 NEW UID,II,HDR,SOURCE,HELP,TYPE,VALUE,ABLE,VISIBLE
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("AGGUPMCR",UID))
+8 KILL @DATA
+9 ;
+10 SET II=0
SET RIEN=$GET(RIEN)
+11 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGARVAL D UNWIND^%ZTER"
+12 DO HDR^AGGWTRIG
+13 SET @DATA@(II)=HDR_$CHAR(30)
+14 ;
+15 SET RIEN=$GET(RIEN)
+16 ;
+17 ;Always disable Date of Last Update field
+18 SET SOURCE="AGGLSTDT"
SET HELP=""
SET TYPE="D"
SET VALUE=""
IF RIEN]""
SET VALUE=$$FMTE^AGGUL1($$GET1^DIQ(9000004,RIEN_",",.08,"I"))
SET ABLE="N"
IF VALUE=""
SET VISIBLE="N"
DO UP^AGGWTRIG
+19 IF RIEN=""
SET SOURCE="AGGMDNME"
SET HELP=""
SET TYPE="X"
SET VALUE=$$GET1^DIQ(2,DFN_",",.01,"E")
SET ABLE="Y"
SET VISIBLE="Y"
DO UP^AGGWTRIG
+20 IF RIEN=""
SET SOURCE="AGGMDDOB"
SET HELP=""
SET TYPE="D"
SET VALUE=$$FMTE^AGGUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
SET ABLE="Y"
SET VISIBLE="Y"
DO UP^AGGWTRIG
+21 ;
XINIT SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
VAL(DATA,VFILE,PARMS) ;EP -- AGG MEDICARE ELIG VAL
+1 ;
+2 ;Input
+3 ; VFILE - The vfile number or name
+4 ; PARMS - The parameters being checked for validation
+5 ;
+6 NEW UID,II,BQ,LIST,BN,PDATA,NAME,VALUE,HDR,CODN,VALID,VALFLD,BI,VFLD,TYPE,X,RESULT,AGGMCCOV
+7 NEW VFIEN,MSG,HNDLR,IEN,CODE,REVAL,MCELIG
+8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+9 SET DATA=$NAME(^TMP("AGGARVAL",UID))
+10 KILL @DATA
+11 SET II=0
SET MSG=""
+12 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGARVAL D UNWIND^%ZTER"
+13 SET VFILE=$GET(VFILE,"")
IF VFILE=""
SET BMXSEC="RPC Failed: No Window selected"
QUIT
+14 SET VFIEN=$ORDER(^AGG(9009068.3,"B",VFILE,""))
+15 ;
+16 SET @DATA@(II)="I00010RESULT^T00100MSG^T00001HANDLER^I00010IEN^T00008CODE^T00100REVALIDATE"_$CHAR(30)
+17 ; Get list of parameters
+18 SET PARMS=$GET(PARMS,"")
+19 IF PARMS=""
Begin DoDot:1
+20 SET LIST=""
SET BN=""
+21 FOR
SET BN=$ORDER(PARMS(BN))
IF BN=""
QUIT
SET LIST=LIST_PARMS(BN)
+22 KILL PARMS
+23 SET PARMS=LIST
+24 KILL LIST
End DoDot:1
+25 ;
+26 IF PARMS=""
SET II=II+1
SET @DATA@(II)="1^"_$GET(MSG)_U_$GET(HNDLR)_U_$GET(IEN)_U_$GET(CODE)_U_$GET(REVAL)_$CHAR(30)
GOTO XDONE
+27 ;
+28 ;Special Handling for Type of Coverage Validation - Multiple Field Passed
+29 IF $PIECE($PIECE(PARMS,$CHAR(28)),"=")="AGGMCCOV"
Begin DoDot:1
+30 SET AGGMCCOV=$PIECE($PIECE(PARMS,$CHAR(28)),"=",2)
+31 SET MCELIG=$PIECE(PARMS,"MCELIG=",2)
+32 SET CODN=$ORDER(^AGG(9009068.3,VFIEN,10,"B","Type of Coverage",""))
IF CODN=""
QUIT
+33 SET VALID=$PIECE($GET(^AGG(9009068.3,VFIEN,10,CODN,2)),U,2)
+34 SET VALFLD=$PIECE($GET(^AGG(9009068.3,VFIEN,10,CODN,2)),U,1)
End DoDot:1
+35 ;
+36 ;Regular Parameter Parsing
+37 IF $PIECE($PIECE(PARMS,$CHAR(28)),"=")'="AGGMCCOV"
FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+38 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+39 SET NAME=$PIECE(PDATA,"=",1)
SET VALUE=$PIECE(PDATA,"=",2,99)
+40 IF NAME["{"!(NAME["}")
SET NAME=$$STRIP^XLFSTR(NAME,"{}")
+41 SET @NAME=VALUE
+42 ; If value is DFN, it exists at the PCC Visit level not individual
+43 ; V File level.
+44 IF VFILE'=9000010&(NAME="DFN"!(NAME="APCDDATE"))
QUIT
+45 SET CODN=$ORDER(^AGG(9009068.3,VFIEN,10,"AC",NAME,""))
+46 IF CODN=""
SET BMXSEC="RPC Failed: Parameter does not exist for this Window"
QUIT
+47 IF $GET(VALID)=""
SET VALID=$PIECE($GET(^AGG(9009068.3,VFIEN,10,CODN,2)),U,2)
+48 IF $GET(VALFLD)=""
SET VALFLD=$PIECE($GET(^AGG(9009068.3,VFIEN,10,CODN,2)),U,1)
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+49 ;
+50 ; Check that values exist for all fields needed for the validation
+51 FOR BI=1:1:$LENGTH(VALFLD,";")
SET VFLD=$PIECE(VALFLD,";",BI)
Begin DoDot:1
+52 IF VFLD["*"
SET VFLD=$$STRIP^XLFSTR(VFLD,"*")
QUIT
+53 IF VFLD["{"!(VFLD["}")
SET VFLD=$$STRIP^XLFSTR(VFLD,"{}")
QUIT
+54 IF $GET(@VFLD)=""
SET BMXSEC="RPC Failed: Missing validation value for "_VFLD
End DoDot:1
+55 IF $GET(BMXSEC)'=""
QUIT
+56 ;
+57 SET VALID=$TRANSLATE(VALID,"~","^")
SET RESULT=0
+58 ; Execute the validation tag
+59 DO @VALID
+60 SET II=II+1
SET @DATA@(II)=RESULT_U_$GET(MSG)_U_$GET(HNDLR)_U_$GET(IEN)_U_$GET(CODE)_U_$GET(REVAL)_$CHAR(30)
+61 ; Clean up validation variables
+62 FOR BI=1:1:$LENGTH(VALFLD,";")
Begin DoDot:1
+63 SET VFLD=$PIECE(VALFLD,";",BI)
SET VFLD=$$STRIP^XLFSTR(VFLD,"*")
SET VFLD=$$STRIP^XLFSTR(VFLD,"{}")
+64 KILL @VFLD
End DoDot:1
+65 ;
XDONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 SET NAME=""
+3 FOR
SET NAME=$ORDER(^AGG(9009068.3,VFIEN,10,"AC",NAME))
IF NAME=""
QUIT
KILL @NAME
+4 QUIT
+5 ;
PRTD(TYPCV,MCELIG) ;EP - New Part D Check for current Part A/B
+1 NEW BQ
+2 SET RESULT=-1
SET MSG=""
+3 IF TYPCV'="D"
SET RESULT=1
QUIT
+4 FOR BQ=1:1:$LENGTH(MCELIG,$CHAR(28))
Begin DoDot:1
+5 NEW PDATA,NAME,VALUE,I
+6 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+7 SET NAME=$PIECE(PDATA,"=",1)
+8 IF NAME'="AGGMCCOV"
QUIT
+9 SET VALUE=$PIECE(PDATA,"=",2,99)
+10 FOR I=1:1:$LENGTH(VALUE,$CHAR(29))
IF $PIECE(VALUE,$CHAR(29),I)="A"!($PIECE(VALUE,$CHAR(29),I)="B")
SET RESULT=1
QUIT
End DoDot:1
IF RESULT=1
QUIT
+11 IF RESULT=1
QUIT
+12 SET MSG="Patient must have Medicare Part A or Part B before being eligible for Part D"
+13 QUIT
+14 ;
DTEMS(STRT,END) ; EP - Elig dates validation for Medicare
+1 SET RESULT=1
+2 SET STRT=$$DATE^AGGUL1(STRT)
SET END=$$DATE^AGGUL1(END)
+3 IF $GET(STRT)'=""
IF 2600000>STRT
SET RESULT=-1
SET MSG="Start Date cannot be before 1960"
QUIT
+4 IF $GET(STRT)'=""
IF DT+20000<STRT
SET RESULT=-1
SET MSG="Start Date cannot be greater than 2 years from today"
QUIT
+5 ;
+6 IF $GET(STRT)'=""
IF $GET(END)=""
QUIT
+7 IF $GET(STRT)'=""
IF $GET(END)'=""
IF STRT<END
SET RESULT=1
QUIT
+8 IF $GET(STRT)'=""
IF $GET(END)'=""
IF STRT>END
SET RESULT=-1
SET MSG="Starting date cannot be greater than the Ending date"
QUIT
+9 QUIT
+10 ;
DTEME(END,STRT) ; EP
+1 SET RESULT=1
+2 SET STRT=$$DATE^AGGUL1(STRT)
SET END=$$DATE^AGGUL1(END)
+3 IF $GET(END)'=""
IF 2600000>END
SET RESULT=-1
SET MSG="End Date cannot be before 1960"
QUIT
+4 IF $GET(END)'=""
IF DT+20000<END
SET RESULT=-1
SET MSG="End Date cannot be greater than 2 years from today"
QUIT
+5 ;
+6 IF $GET(STRT)'=""
IF $GET(END)=""
QUIT
+7 IF $GET(STRT)'=""
IF $GET(END)'=""
IF STRT<END
SET RESULT=1
QUIT
+8 IF $GET(STRT)'=""
IF $GET(END)'=""
IF STRT>END
SET RESULT=-1
SET MSG="Ending date cannot be less than the Starting date"
QUIT
+9 QUIT
