AGELUPUT ;IHS/SET/GTH - UPDATE ELIGIBILITY FROM CMS FILE (UTILITIES) ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
FRMT ;EP - ask template and mode
;Select template.
W !!
S DIC="^AGELUP(",DIC("S")="I '$P(^(0),U,7)",DIC(0)="AEMQ"
D ^DIC
Q:+Y<0
;Load template into local vars.
S AGTDA=+Y,AGZERO=^AGELUP(AGTDA,0),AGONE=$G(^(1)),AGTWO=$G(^(2)),AGTHREE=$G(^(3)),AGSEVEN=$G(^(7)),AGFPVL=$P(AGTHREE,U,3),AGPARSE=$P(AGZERO,U,3)
I AGPARSE="V" S AGDEL=$$GET1^DIQ(9009062.01,AGTDA_",",.04)
S AGTYPE=$P(AGZERO,U,2),AGAUTO=$P(AGZERO,U,6)
I AGTYPE="D" D I 'AGMCDST S DIRUT=1
. S AGMCDST=0
. I '$L($P(AGTWO,U,10)) D
.. W !,"MEDICAID STATE isn't entered for this template.",!,"What's the State?"
.. NEW DA,DIE,DR
.. S DIE="^AGELUP(",DR=.295,DA=AGTDA
.. D ^DIE
.. S AGTWO=^AGELUP(AGTDA,2)
..Q
. I '$L($P(AGTWO,U,10)) Q
. S AGMCDST=$O(^DIC(5,"C",$P(AGTWO,U,10),0))
.Q
S AGMATCH=$G(^AGELUP(AGTDA,11))
F %=1:1:$L(AGMATCH,"^") I '$L($P(AGMATCH,U,%)) S $P(AGMATCH,U,%)=0
S AGMATCH=$TR(AGMATCH,"^")
;Select processing mode.
NEW DA
S AGAUTO=$$DIR^XBDIR("9009062.01,.06","",AGAUTO,"","","",2)
I AGTYPE="D",AGAUTO="A" D DMC(AGTDA)
Q
;
;Data auditing at the file level is indicated by a lower case "a"
;in the 2nd piece of the 0th node of the global.
;Data auditing at the field level is indicated by a lower case "a"
;in the 2nd piece of the 0th node of the field definition in ^DD(.
AUDS ;EP - Save current settings, and SET data auditing 'on'.
S ^XTMP("AGELUP1",0)=$$FMADD^XLFDT(DT,56)_"^"_DT_"^"_"M/M ELIGIBILITY FILE PROCESSING"
NEW G,P
F %=1:1 S G=$P($T(AUD+%),";",3) Q:G="END" D
. S P=$P(@(G_"0)"),"^",2)
. I '$D(^XTMP("AGELUP1",G)) S ^XTMP("AGELUP1",G)=P
. S:'(P["a") $P(@(G_"0)"),"^",2)=P_"a"
. Q:'(G["^DD(")
. I '$D(^XTMP("AGELUP1",G,"AUDIT")) S ^XTMP("AGELUP1",G,"AUDIT")=$G(@(G_"""AUDIT"")"))
. S (@(G_"""AUDIT"")"))="y"
.Q
Q
AUDR ;EP - Restore the file data audit values to their original values.
NEW G,P
F %=1:1 S G=$P($T(AUD+%),";",3) Q:G="END" D
. S $P(@(G_"0)"),"^",2)=^XTMP("AGELUP1",G)
. Q:'(G["^DD(")
. S (@(G_"""AUDIT"")"))=^XTMP("AGELUP1",G,"AUDIT")
. K:@(G_"""AUDIT"")")="" @(G_"""AUDIT"")")
.Q
Q
AUD ;These are files/fields to be audited.
;;^AUPNMCR(
;;^DD(9000003,.01,
;;^DD(9000003,.02,
;;^DD(9000003,.03,
;;^DD(9000003,.04,
;;^DD(9000003,1101,
;;^DD(9000003,2101,
;;^DD(9000003,2102,
;;^AUPNMCD(
;;^DD(9000004,.01,
;;^DD(9000004,.02,
;;^DD(9000004,.03,
;;^DD(9000004,.04,
;;^DD(9000004,.07,
;;^DD(9000004,1101,
;;^DD(9000004,2101,
;;^DD(9000004,2102,
;;^AUPNRRE(
;;^DD(9000005,.01,
;;^DD(9000005,.02,
;;^DD(9000005,.03,
;;^DD(9000005,.04,
;;^DD(9000005,1101,
;;^DD(9000005,2101,
;;^DD(9000005,2102,
;;^AUTTMCS(
;;^DD(9999999.32,.01,
;;^AUTTRRP(
;;^DD(9999999.33,.01,
;;END
; -----------------------------------------------------
;
INSPT ;EP - Get the INSURER that is to be used.
U IO(0)
W !!,"Looking for an entry in the INSURER file named """,$S(AGTYPE="M":"MEDICARE",AGTYPE="R":"RAILROAD RETIREMENT",AGTYPE="D":"MEDICAID",1:"???"),"""..."
NEW DA
S AGINSPT=$$DIR^XBDIR("900000"_$S(AGTYPE="M":3,AGTYPE="D":4,AGTYPE="R":5,1:3)_",.02","",$S(AGTYPE="M":"MEDICARE",AGTYPE="D":"MEDICAID",AGTYPE="R":"RAILROAD RETIREMENT",1:""),"","","",1)
I +Y>0 D INSPT9 Q
W !,"An insurer named """,$S(AGTYPE="M":"MEDICARE",AGTYPE="D":"MEDICAID",AGTYPE="R":"RAILROAD RETIREMENT",1:"???"),""" could not be found in your INSURER file."
W !,"What INSURER should be used for the elgibility update?"
S DIC(0)="AEMZ"
D ^DIC
INSPT9 ;
I +Y>0 W !,"The insurer named """,$P(Y,U,2),""" will be used to update eligibility information." S AGINSPT=+Y
Q
HEAD(AGHDR) ;EP - page header
U IO(0)
W @IOF,!,"FILE RECORD #: ",AGRCNT
W !,"PATIENT: ",$P(^DPT(AG("DFN"),0),U,1),?35,"SSN: "
W $E(AG("FSSN"),1,3)_"-"_$E(AG("FSSN"),4,5)_"-"_$E(AG("FSSN"),6,9)
W ?58,"DOB: ",$$DOB^AUPNPAT(AG("DFN"),"S")
W !,$$REPEAT^XLFSTR("=",80)
W !?3,"RPMS ",AGHDR," ELIGIBILE File",?48,$S(AGTYPE="M":"CMS Medicare",AGTYPE="D":"State Medicaid",AGTYPE="P":"Private Ins.",AGTYPE="R":"CMS Railroad",1:"<unknown>")," FILE"
W !,$$REPEAT^XLFSTR("-",80)
Q
PEND ;EP - end of page
W !
S AGACT=$$DIR^XBDIR("SBM^F:FILE;S:SKIP;Q:QUIT","ACTION: (F)ILE, (S)KIP, (Q)UIT","QUIT")
I $D(DIRUT) S AGACT="Q"
Q
RUN ;EP - add run multiple
S X=$$NOW^XLFDT,DIC="^AGELUPLG(",DIC(0)="LX",DLAYGO=9009062.02
D ^DIC
I +Y<0 U IO(0) W !!,"Could not create entry in Log file.",! Q
S (AGRUN,DA)=+Y,DIE=DIC,DR=".02////"_AGTDA_";.03///"_AGFILE_";.04///"_AGCNT_";.05////"_DUZ_";.06///"_$P($G(^AUPNMCR(0)),U,4)_";.08///"_$P($G(^AUPNRRE(0)),U,4)_";.11///"_$P($G(^AUPNMCD(0)),U,4)
D ^DIE
Q
RUN1 ;EP - Update end of run file counts.
S DIE="^AGELUPLG(",DA=AGRUN,DR=".07///"_$P($G(^AUPNMCR(0)),U,4)_";.09///"_$P($G(^AUPNRRE(0)),U,4)_";.12///"_$P($G(^AUPNMCD(0)),U,4)
D ^DIE
Q
MATCH() ;EP - Match the Patient for Medicaid Auto-processing, only.
NEW AGQ,AGDPT0
S AGDPT0=^DPT(AG("DFN"),0),AGQ=0
;SSN
;SSN must always match.
;
;NAME
I $E(AGMATCH,2) D Q:AGQ 0
. S AGQ=AG("FLNM")_","_AG("FFNM")
. S:AG("FMI")'="" AGQ=AGQ_" "_AG("FMI")
. I $E(AGMATCH,2)=1,'($P(AGDPT0,U,1)=AGQ) S AGQ=1 Q
. I $E(AGMATCH,2)=2,'($P($P(AGDPT0,U,1),",",1)=AG("FLNM")) S AGQ=1 Q
. I $E(AGMATCH,2)=3,'($E($P($P(AGDPT0,U,1),",",1),1,6)=$E(AG("FLNM"),1,6)) S AGQ=1 Q
.Q
;DOB
I $E(AGMATCH,3) D Q:AGQ 0
. I $E(AGMATCH,3)=1,'($P(AGDPT0,U,3)=AG("FDOB")) S AGQ=1 Q
. I $E(AGMATCH,3)=2,'($E($P(AGDPT0,U,3),1,3)=$E(AG("FDOB"),1,3)) S AGQ=1 Q
. I $E(AGMATCH,3)=3,'($E($P(AGDPT0,U,3),1,5)=$E(AG("FDOB"),1,5)) S AGQ=1 Q
.Q
;GENDER
I $E(AGMATCH,4),'($P(AGDPT0,U,2)=AG("FSEX")) Q 0
;ZIP
I $E(AGMATCH,5) D Q:AGQ 0
. I $E(AGMATCH,5)=1,'($P($G(^DPT(AG("DFN"),.11)),U,6)=AG("FMAZ")) S AGQ=1 Q
. I $E(AGMATCH,5)=2,'($E($P($G(^DPT(AG("DFN"),.11)),U,6),1,5)=$E(AG("FMAZ"),1,5)) S AGQ=1 Q
.Q
Q 1
DMC(DA) ;EP - Display matching criteria.
;;You have chosen Medicaid upload in Auto mode.
;;Because of the widely differing methods used by States for verifying
;;Patient demographic data, additional matching criteria are available.
;;Matching is done on PtReg data, -not- Medicaid data.
;;@;!
;;The upload Matching criteria for this template is current set for:
;;###
D HELP^XBHELP("DMC","AGELUPUT",0)
NEW DIC,DR
S DIC="^AGELUP(",DR="11"
D EN^DIQ
I $$DIR^XBDIR("E")
Q
AGELUPUT ;IHS/SET/GTH - UPDATE ELIGIBILITY FROM CMS FILE (UTILITIES) ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
FRMT ;EP - ask template and mode
+1 ;Select template.
+2 WRITE !!
+3 SET DIC="^AGELUP("
SET DIC("S")="I '$P(^(0),U,7)"
SET DIC(0)="AEMQ"
+4 DO ^DIC
+5 IF +Y<0
QUIT
+6 ;Load template into local vars.
+7 SET AGTDA=+Y
SET AGZERO=^AGELUP(AGTDA,0)
SET AGONE=$GET(^(1))
SET AGTWO=$GET(^(2))
SET AGTHREE=$GET(^(3))
SET AGSEVEN=$GET(^(7))
SET AGFPVL=$PIECE(AGTHREE,U,3)
SET AGPARSE=$PIECE(AGZERO,U,3)
+8 IF AGPARSE="V"
SET AGDEL=$$GET1^DIQ(9009062.01,AGTDA_",",.04)
+9 SET AGTYPE=$PIECE(AGZERO,U,2)
SET AGAUTO=$PIECE(AGZERO,U,6)
+10 IF AGTYPE="D"
Begin DoDot:1
+11 SET AGMCDST=0
+12 IF '$LENGTH($PIECE(AGTWO,U,10))
Begin DoDot:2
+13 WRITE !,"MEDICAID STATE isn't entered for this template.",!,"What's the State?"
+14 NEW DA,DIE,DR
+15 SET DIE="^AGELUP("
SET DR=.295
SET DA=AGTDA
+16 DO ^DIE
+17 SET AGTWO=^AGELUP(AGTDA,2)
+18 QUIT
End DoDot:2
+19 IF '$LENGTH($PIECE(AGTWO,U,10))
QUIT
+20 SET AGMCDST=$ORDER(^DIC(5,"C",$PIECE(AGTWO,U,10),0))
+21 QUIT
End DoDot:1
IF 'AGMCDST
SET DIRUT=1
+22 SET AGMATCH=$GET(^AGELUP(AGTDA,11))
+23 FOR %=1:1:$LENGTH(AGMATCH,"^")
IF '$LENGTH($PIECE(AGMATCH,U,%))
SET $PIECE(AGMATCH,U,%)=0
+24 SET AGMATCH=$TRANSLATE(AGMATCH,"^")
+25 ;Select processing mode.
+26 NEW DA
+27 SET AGAUTO=$$DIR^XBDIR("9009062.01,.06","",AGAUTO,"","","",2)
+28 IF AGTYPE="D"
IF AGAUTO="A"
DO DMC(AGTDA)
+29 QUIT
+30 ;
+31 ;Data auditing at the file level is indicated by a lower case "a"
+32 ;in the 2nd piece of the 0th node of the global.
+33 ;Data auditing at the field level is indicated by a lower case "a"
+34 ;in the 2nd piece of the 0th node of the field definition in ^DD(.
AUDS ;EP - Save current settings, and SET data auditing 'on'.
+1 SET ^XTMP("AGELUP1",0)=$$FMADD^XLFDT(DT,56)_"^"_DT_"^"_"M/M ELIGIBILITY FILE PROCESSING"
+2 NEW G,P
+3 FOR %=1:1
SET G=$PIECE($TEXT(AUD+%),";",3)
IF G="END"
QUIT
Begin DoDot:1
+4 SET P=$PIECE(@(G_"0)"),"^",2)
+5 IF '$DATA(^XTMP("AGELUP1",G))
SET ^XTMP("AGELUP1",G)=P
+6 IF '(P["a")
SET $PIECE(@(G_"0)"),"^",2)=P_"a"
+7 IF '(G["^DD(")
QUIT
+8 IF '$DATA(^XTMP("AGELUP1",G,"AUDIT"))
SET ^XTMP("AGELUP1",G,"AUDIT")=$GET(@(G_"""AUDIT"")"))
+9 SET (@(G_"""AUDIT"")"))="y"
+10 QUIT
End DoDot:1
+11 QUIT
AUDR ;EP - Restore the file data audit values to their original values.
+1 NEW G,P
+2 FOR %=1:1
SET G=$PIECE($TEXT(AUD+%),";",3)
IF G="END"
QUIT
Begin DoDot:1
+3 SET $PIECE(@(G_"0)"),"^",2)=^XTMP("AGELUP1",G)
+4 IF '(G["^DD(")
QUIT
+5 SET (@(G_"""AUDIT"")"))=^XTMP("AGELUP1",G,"AUDIT")
+6 IF @(G_"""AUDIT"")")=""
KILL @(G_"""AUDIT"")")
+7 QUIT
End DoDot:1
+8 QUIT
AUD ;These are files/fields to be audited.
+1 ;;^AUPNMCR(
+2 ;;^DD(9000003,.01,
+3 ;;^DD(9000003,.02,
+4 ;;^DD(9000003,.03,
+5 ;;^DD(9000003,.04,
+6 ;;^DD(9000003,1101,
+7 ;;^DD(9000003,2101,
+8 ;;^DD(9000003,2102,
+9 ;;^AUPNMCD(
+10 ;;^DD(9000004,.01,
+11 ;;^DD(9000004,.02,
+12 ;;^DD(9000004,.03,
+13 ;;^DD(9000004,.04,
+14 ;;^DD(9000004,.07,
+15 ;;^DD(9000004,1101,
+16 ;;^DD(9000004,2101,
+17 ;;^DD(9000004,2102,
+18 ;;^AUPNRRE(
+19 ;;^DD(9000005,.01,
+20 ;;^DD(9000005,.02,
+21 ;;^DD(9000005,.03,
+22 ;;^DD(9000005,.04,
+23 ;;^DD(9000005,1101,
+24 ;;^DD(9000005,2101,
+25 ;;^DD(9000005,2102,
+26 ;;^AUTTMCS(
+27 ;;^DD(9999999.32,.01,
+28 ;;^AUTTRRP(
+29 ;;^DD(9999999.33,.01,
+30 ;;END
+31 ; -----------------------------------------------------
+32 ;
INSPT ;EP - Get the INSURER that is to be used.
+1 USE IO(0)
+2 WRITE !!,"Looking for an entry in the INSURER file named """,$SELECT(AGTYPE="M":"MEDICARE",AGTYPE="R":"RAILROAD RETIREMENT",AGTYPE="D":"MEDICAID",1:"???"),"""..."
+3 NEW DA
+4 SET AGINSPT=$$DIR^XBDIR("900000"_$SELECT(AGTYPE="M":3,AGTYPE="D":4,AGTYPE="R":5,1:3)_",.02","",$SELECT(AGTYPE="M":"MEDICARE",AGTYPE="D":"MEDICAID",AGTYPE="R":"RAILROAD RETIREMENT",1:""),"","","",1)
+5 IF +Y>0
DO INSPT9
QUIT
+6 WRITE !,"An insurer named """,$SELECT(AGTYPE="M":"MEDICARE",AGTYPE="D":"MEDICAID",AGTYPE="R":"RAILROAD RETIREMENT",1:"???"),""" could not be found in your INSURER file."
+7 WRITE !,"What INSURER should be used for the elgibility update?"
+8 SET DIC(0)="AEMZ"
+9 DO ^DIC
INSPT9 ;
+1 IF +Y>0
WRITE !,"The insurer named """,$PIECE(Y,U,2),""" will be used to update eligibility information."
SET AGINSPT=+Y
+2 QUIT
HEAD(AGHDR) ;EP - page header
+1 USE IO(0)
+2 WRITE @IOF,!,"FILE RECORD #: ",AGRCNT
+3 WRITE !,"PATIENT: ",$PIECE(^DPT(AG("DFN"),0),U,1),?35,"SSN: "
+4 WRITE $EXTRACT(AG("FSSN"),1,3)_"-"_$EXTRACT(AG("FSSN"),4,5)_"-"_$EXTRACT(AG("FSSN"),6,9)
+5 WRITE ?58,"DOB: ",$$DOB^AUPNPAT(AG("DFN"),"S")
+6 WRITE !,$$REPEAT^XLFSTR("=",80)
+7 WRITE !?3,"RPMS ",AGHDR," ELIGIBILE File",?48,$SELECT(AGTYPE="M":"CMS Medicare",AGTYPE="D":"State Medicaid",AGTYPE="P":"Private Ins.",AGTYPE="R":"CMS Railroad",1:"<unknown>")," FILE"
+8 WRITE !,$$REPEAT^XLFSTR("-",80)
+9 QUIT
PEND ;EP - end of page
+1 WRITE !
+2 SET AGACT=$$DIR^XBDIR("SBM^F:FILE;S:SKIP;Q:QUIT","ACTION: (F)ILE, (S)KIP, (Q)UIT","QUIT")
+3 IF $DATA(DIRUT)
SET AGACT="Q"
+4 QUIT
RUN ;EP - add run multiple
+1 SET X=$$NOW^XLFDT
SET DIC="^AGELUPLG("
SET DIC(0)="LX"
SET DLAYGO=9009062.02
+2 DO ^DIC
+3 IF +Y<0
USE IO(0)
WRITE !!,"Could not create entry in Log file.",!
QUIT
+4 SET (AGRUN,DA)=+Y
SET DIE=DIC
SET DR=".02////"_AGTDA_";.03///"_AGFILE_";.04///"_AGCNT_";.05////"_DUZ_";.06///"_$PIECE($GET(^AUPNMCR(0)),U,4)_";.08///"_$PIECE($GET(^AUPNRRE(0)),U,4)_";.11///"_$PIECE($GET(^AUPNMCD(0)),U,4)
+5 DO ^DIE
+6 QUIT
RUN1 ;EP - Update end of run file counts.
+1 SET DIE="^AGELUPLG("
SET DA=AGRUN
SET DR=".07///"_$PIECE($GET(^AUPNMCR(0)),U,4)_";.09///"_$PIECE($GET(^AUPNRRE(0)),U,4)_";.12///"_$PIECE($GET(^AUPNMCD(0)),U,4)
+2 DO ^DIE
+3 QUIT
MATCH() ;EP - Match the Patient for Medicaid Auto-processing, only.
+1 NEW AGQ,AGDPT0
+2 SET AGDPT0=^DPT(AG("DFN"),0)
SET AGQ=0
+3 ;SSN
+4 ;SSN must always match.
+5 ;
+6 ;NAME
+7 IF $EXTRACT(AGMATCH,2)
Begin DoDot:1
+8 SET AGQ=AG("FLNM")_","_AG("FFNM")
+9 IF AG("FMI")'=""
SET AGQ=AGQ_" "_AG("FMI")
+10 IF $EXTRACT(AGMATCH,2)=1
IF '($PIECE(AGDPT0,U,1)=AGQ)
SET AGQ=1
QUIT
+11 IF $EXTRACT(AGMATCH,2)=2
IF '($PIECE($PIECE(AGDPT0,U,1),",",1)=AG("FLNM"))
SET AGQ=1
QUIT
+12 IF $EXTRACT(AGMATCH,2)=3
IF '($EXTRACT($PIECE($PIECE(AGDPT0,U,1),",",1),1,6)=$EXTRACT(AG("FLNM"),1,6))
SET AGQ=1
QUIT
+13 QUIT
End DoDot:1
IF AGQ
QUIT 0
+14 ;DOB
+15 IF $EXTRACT(AGMATCH,3)
Begin DoDot:1
+16 IF $EXTRACT(AGMATCH,3)=1
IF '($PIECE(AGDPT0,U,3)=AG("FDOB"))
SET AGQ=1
QUIT
+17 IF $EXTRACT(AGMATCH,3)=2
IF '($EXTRACT($PIECE(AGDPT0,U,3),1,3)=$EXTRACT(AG("FDOB"),1,3))
SET AGQ=1
QUIT
+18 IF $EXTRACT(AGMATCH,3)=3
IF '($EXTRACT($PIECE(AGDPT0,U,3),1,5)=$EXTRACT(AG("FDOB"),1,5))
SET AGQ=1
QUIT
+19 QUIT
End DoDot:1
IF AGQ
QUIT 0
+20 ;GENDER
+21 IF $EXTRACT(AGMATCH,4)
IF '($PIECE(AGDPT0,U,2)=AG("FSEX"))
QUIT 0
+22 ;ZIP
+23 IF $EXTRACT(AGMATCH,5)
Begin DoDot:1
+24 IF $EXTRACT(AGMATCH,5)=1
IF '($PIECE($GET(^DPT(AG("DFN"),.11)),U,6)=AG("FMAZ"))
SET AGQ=1
QUIT
+25 IF $EXTRACT(AGMATCH,5)=2
IF '($EXTRACT($PIECE($GET(^DPT(AG("DFN"),.11)),U,6),1,5)=$EXTRACT(AG("FMAZ"),1,5))
SET AGQ=1
QUIT
+26 QUIT
End DoDot:1
IF AGQ
QUIT 0
+27 QUIT 1
DMC(DA) ;EP - Display matching criteria.
+1 ;;You have chosen Medicaid upload in Auto mode.
+2 ;;Because of the widely differing methods used by States for verifying
+3 ;;Patient demographic data, additional matching criteria are available.
+4 ;;Matching is done on PtReg data, -not- Medicaid data.
+5 ;;@;!
+6 ;;The upload Matching criteria for this template is current set for:
+7 ;;###
+8 DO HELP^XBHELP("DMC","AGELUPUT",0)
+9 NEW DIC,DR
+10 SET DIC="^AGELUP("
SET DR="11"
+11 DO EN^DIQ
+12 IF $$DIR^XBDIR("E")
+13 QUIT
