AGED4A1 ; IHS/ASDS/EFG - PAGE 4 - INSURANCE SUMMARY PART 2;
;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
;
HEADING ;EP -
D ^AGED
W !,AGLINE("-")
W !?0,"SEQ",?9,"INSURER",?33,"COVERAGE TYPE",?56,"ELIG BEGIN",?67,"-",?69,"ELIG END"
W !?10,"SUBSCRIBER",?34,"POLICY NUMBER"
W !,AGLINE("EQ")
Q
ADDMSG ;EP - ELIGIBILITY MESSAGE
W !!,"YOU HAVE ADDED NEW ELIGIBILITY, YOU MAY NEED TO RESEQUENCE INSURERS."
H 2
K ADDCHK
Q
GUARDIS(CATREC) ;EP - DISPLAY GUARANTOR ON SEQUENCED DISPLAY. CALLED FROM AGED4A
N CORECPTR,GLOREC,GUARPTR,GUARNAME
I $P(CATREC,U,11)="" Q ;W !?8,"NOTHING IN THE GUARANTOR FILE FOR THIS PATIENT" Q ;IHS/OKCAO/POC 12/5/2005 REPORTED BY POC AG*7.1*1
S CORECPTR=$P(CATREC,U,11)_",0)"
;S CORECPTR=$P(CATREC,U,9)_",0)" ;IHS/SD/TPF AG*7.1*1 9/7/2005 NO IM
S GLOREF="^AUPNGUAR("_CORECPTR
I $G(@GLOREF)']"" Q ;W !?8,"NO ENTRY IN THE GUARANTOR FIELD FOR THIS PATIENT" Q ;IHS/OKCAO/POC 12/5/2005 REPORTED BY POC AG*7.1*1
S GUARREC=$P($P($G(@GLOREF),U),";")
S GUARGLO=U_$P($P($G(@GLOREF),U),";",2)
S GUARPTR=GUARGLO_GUARREC_",0)"
S GUARPO=$P($G(@GLOREF),U,3)
I GUARGLO[("AUPNPAT") I $P($G(@GUARPTR),U) S GUARNAME=$P($G(^DPT($P(@GUARPTR,U),0)),U)
E S GUARNAME=$P(@GUARPTR,U)
S Y=$P(CATREC,U,3) X ^DD("DD") S GUAREFF=Y
S Y=$P(CATREC,U,4) X ^DD("DD") S GUAREND=Y
W ?8,GUARNAME,?33,"GUARANTOR",?56,GUAREFF,?69,GUAREND
W !?10,$P($G(^DPT(DFN,0)),U),?34,GUARPO
Q
TPLDIS(CATREC) ;EP - DISPLAY THIRD PARTY LIABILITY ON SEQUENCED DISPLAY. CALLED FROM AGED4A
N TPLPTR,INSURPTR,INSURNAM,POLNUM,TPLEFF,TPLEND,TPLRESP
I $P(CATREC,U,11)="" Q ;AG*7.1*2 IM20280
S TPLPTR="^AUPNTPL("_$P(CATREC,U,11)_",0)"
S TPLPTR2="^AUPNTPL("_$P(CATREC,U,11)_",1)"
S INSURPTR=$P($G(@TPLPTR),U,2)
S INSURNAM=$S($G(INSURPTR)'="":$P($G(^AUTNINS(INSURPTR,0)),U),1:"UNDEFINED")
S POLNUM=$P($G(@TPLPTR),U,3)
S TPLRESP=$P($G(@TPLPTR2),U)
S Y=$P($G(@TPLPTR),U,4) X ^DD("DD") S TPLEFF=Y
S Y=$P($G(@TPLPTR),U,5) X ^DD("DD") S TPLEND=Y
W ?8,INSURNAM,?33,"TPL",?56,TPLEFF,?69,TPLEND
W !?10,TPLRESP,?34,POLNUM
Q
DISPCAT ;EP
DISPCATA ;
S AGSEL=0
Q:$G(CATPTR)=""
;I $D(CATPTR),('$D(AGCAT(CATPTR))) D Q
I $D(CATPTR),('$D(AGCAT(CATPTR))),($G(CATPTR)'="U") D Q ;AG*7.1*2 AG/SD/TPF 6/26/2006 PAGE 37 OF TASK ORDER
.W !!
.W !?10,"*** THIS PATIENT HAS NOTHING SET UP IN THIS CATEGORY. ***"
.W !?10,"*** TO ENTER DATA INTO THIS CATEGORY, USE ""Sequence"". ***"
.W !!
.K DIR
.S DIR(0)="E"
.D ^DIR
.;AG*7.1*2 AG/SD/TPF 6/26/2006 PAGE 37 OF TASK ORDER
.;D HEADING^AGED4A1 ;AG*7.1*2 AG/SD/TPF 6/26/2006 PAGE 37 OF TASK ORDER
.;D DISPLAYN
D HEADING^AGED4A1 ;AG*7.1*2 AG/SD/TPF 6/26/2006 PAGE 37 OF TASK ORDER
I $D(CATPTR),('$D(AGCAT(CATPTR))) Q
I $D(CATPTR),($D(AGCAT(CATPTR))) D
.;S SQDT="",CNT=0
.I $G(VIEWDT) S SQDT=VIEWDT+.01,CNT=0 K VIEWDT
.E S SQDT=DT+.01,CNT=0 ;AG*7.1*2 AG/SD/TPF 6/26/2006 PAGE 37 OF TASK ORDER
.;S SQDT=DT+.01,CNT=0 ;IHS/SD/TPF 5/1/2006 AG*7.1*2 IM20494 ;AG*7.1*2 AG/SD/TPF
.F S SQDT=$O(AGCAT(CATPTR,SQDT),-1) Q:'SQDT D
..S CNT=CNT+1
..Q:CNT>1
..W !,"SEQ DATE: ",$E(SQDT,4,5)_"/"_$E(SQDT,6,7)_"/"_($E(SQDT,1,3)+1700)
..W !
..I $D(AGFRMMSG) W ?5,$$S^AGVDF("RVN"),$$S^AGVDF("BLN"),"*** NEW "_AGFRMSG2_" SEQUENCE REQUIRED FOR ",AGFRMMSG," ***",$$S^AGVDF("BLF"),$$S^AGVDF("RVF")
..K AGFRMMSG,AGFRMSG2
..S SEQFLG=SQDT
..S AGSEL=0
..F S AGSEL=$O(AGCAT(CATPTR,SQDT,AGSEL)) Q:'AGSEL D
...S CATREC=$G(AGCAT(CATPTR,SQDT,AGSEL))
...;REQUEST TO NOT DISPLAY INACTIVE ELIGIBILITIES WOULD GO HERE
...;ATTACHMENT VIII.1 PATCH 2
...;DID ADRIAN CANCEL THIS REQUEST?
...;END CODE
...W !
...W ?1,AGSEL,"."
...I $P(CATREC,U,2)="G" D GUARDIS^AGED4A1(CATREC) Q
...I $P(CATREC,U,2)="T" D TPLDIS^AGED4A1(CATREC) Q
...;BEGIN NEW CODE AG*7.1*1 ITEM 2
...I $P(CATREC,U,2)="D",($P(CATREC,U)=2) D
....S IENS=$P(CATREC,U,11)
....Q:IENS=""
....S PARTDGLO="^AUPNMCR("_IENS_")"
....S PLANPTR=$P($G(@PARTDGLO),U,4)
....I PLANPTR'="" W ?8,$E($P($G(^AUTNINS(PLANPTR,0)),U),1,20) Q
....W ?8,"UNDEFINED"
....;END NEW CODE
...;IM HANDLE RR WITH DD
...I $P(CATREC,U,2)="D",($P(CATREC,U)=1) D
....S IENS=$P(CATREC,U,11)
....Q:IENS=""
....S PARTDGLO="^AUPNRRE("_IENS_")"
....S PLANPTR=$P($G(@PARTDGLO),U,4)
....I PLANPTR'="" W ?8,$E($P($G(^AUTNINS(PLANPTR,0)),U),1,20) Q
....W ?8,"UNDEFINED"
...I $E($P(CATREC,U,5),1,1)="D" D
....S RECPTR=$E($P(CATREC,U,5),2,10)
....S STPTR=$P($G(^AUPNMCD(RECPTR,0)),U,4)
....I STPTR'="" W ?8,$P($G(^DIC(5,STPTR,0)),U,2)_" "
....I STPTR="" W ?8," "
....;I $P(CATREC,U,8)="" W "MEDICAID"
....;I $P(CATREC,U,8)="" W "UNDEFINED" ;AG*7.1*1 ITEM 3C
....;AG*7.1*2 IM20270
....I $P(CATREC,U,8)="" W "MEDICAID" Q
....I $P(CATREC,U,8)'="" W ?8,$E($P($G(^AUTNINS($P(CATREC,U,8),0)),U),1,24)
...;I $E($P(CATREC,U,5),1,1)'="D" D
...I $E($P(CATREC,U,5),1,1)'="D",($P(CATREC,U,2)'="D") D
....I $P(CATREC,U)="" W !,"UNDEFINED" Q ;IHS/SD/TPF AG*7.1*1 IM18805
....W ?8,$E($P($G(^AUTNINS($P(CATREC,U),0)),U),1,24)
...I ($P(CATREC,U,2)="D"),(($P(CATREC,U)'=1)),(($P(CATREC,U)'=2)) D
....W:$P(CATREC,U)'="" $P($G(^AUTNINS($P(CATREC,U),0)),U)
...W ?33,$P(CATREC,U,2)
...S EFF=$P(CATREC,U,3)
...I EFF'="" W ?56,$E(EFF,4,5)_"/"_$E(EFF,6,7)_"/"_($E(EFF,1,3)+1700)
...S END=$P(CATREC,U,4)
...I END'="" W ?69,$E(END,4,5)_"/"_$E(END,6,7)_"/"_($E(END,1,3)+1700)
...W ! S RECPTR=$P(CATREC,U,5)
...I $E(RECPTR)="D" W ?10,$P($G(^AUPNMCD($E(RECPTR,2,10),21)),U)
...I $E(RECPTR)="M" W ?10,$P($G(^AUPNMCR($E(RECPTR,2,10),21)),U)
...I $E(RECPTR)="R" W ?10,$P($G(^AUPNRRE($E(RECPTR,2,10),21)),U)
...I $E(RECPTR)="P" W ?10,$P($G(^AUPN3PPH($E(RECPTR,2,10),0)),U)
...W ?34,$P(AGCAT(CATPTR,SQDT,AGSEL),U,6)
I $D(CATPTR),($D(AGCAT(CATPTR))) D
.W !!?6,"*** THIS SEQUENCE REFLECTS THE LATEST PRIORITY SEQUENCE DATE ***"
W !,$G(AGLINE("-")) D VERIF2^AGUTILS W !,AGLINE("EQ")
K AG("ED"),AG("ERR"),DFOUT,DTOUT,DUOUT,DQOUT,DLOUT,DIROUT,DIR
;S DIR("A")="Enter S(equence), A(dd) insurer, E(dit) insurer, T(oggle seq category) "
;S DIR("?")="Enter an ""S"" to sequence insurers, a ""T"" to ""toggle"" to a category to see if there's anything in that category."
S DIR("A")="Enter S(equence), A(dd) insurer, E(dit) insurer, T(oggle seq category) V(iew) Historical Sequence Dates:" ;AG*7.1*2 IHS/SD/TPF 6/26/2006 PAGE 36
S DIR("?")="Enter an ""S"" to sequence insurers, a ""T"" to ""toggle"" to a category to see if there's anything in that category."
S DIR(0)="FO^1:3" D ^DIR S X=Y,Y=$$UP^XLFSTR(X) S AGANS=Y K DIR
I AGANS="V" D VPROMPT^AGED4A2(CATPTR) G DISPCATA ;VIEW PROMPT AG*7.1*2 IHS/SD/TPF 6/26/2006 PAGE 37
I AGANS="T" D CPROMPT^AGED4A Q:CATPTR="U" G DISPCATA ;TO ACCOMODATE CHANGE TO DEFAULT DISPLAY IHS/SD/TPF 4/12/2006 AG*7.1*2 ITEM 2 PAGE 35
I AGANS="S" D CPROMPT^AGED4A K:CATPTR="U" CATHD Q:CATPTR="U" D:$G(CATPTR)'="U" SPROMPT^AGED4A S:$G(CATPTR)="U" AGANS="" G DISPCATA
S CATPTR="U" K CATHD ;AG*7.1*2 IHS/SD/TPF 6/26/2006 PAGE 37 RESET TO SUMMARY PAGE IF EXITING SEQUENCE DISPLAY
Q
DISPLAYN ;EP - MCR/RAILROAD
;IHS/SD/TPF 12/5/05 PER PATCH 1 ITEM 1, DISPLAY MCR PART D ON ITS OWN LINE.
DISPLAG ;
S GLO="AGINSNN("""")"
S OLDSEL=""
F S GLO=$Q(@GLO) Q:GLO="" D
.W !
.S ISACTIVE=$P(@GLO,U,13)
.S END=$P(@GLO,U,6)
.I $L(GLO,",")>1 S SEL=$P($P(GLO,","),"(",2)
.E S SEL=$P($P(GLO,")"),"(",2)
.I OLDSEL=SEL
.E W ?1,SEL,"."
.I $P(@GLO,U,10)="D"!($P(@GLO,U,10)="K") D
..S MCDREC=$P(@GLO,U,11)
..S STPTR=$S(MCDREC="":"",1:$P($G(^AUPNMCD($P(MCDREC,","),0)),U,4))
..I STPTR'="" S ST=$P($G(^DIC(5,STPTR,0)),U,2)
..I STPTR'="" W ?8,ST
..I $P(@GLO,U,12)'="" W ?11,$E($P($G(^AUTNINS($P(@GLO,U,12),0)),U),1,24)
..;I $P(@GLO,U,12)="" W ?11,"MEDICAID"
..;I $P(@GLO,U,12)="" W ?11,"UNDEFINED" ;IHS/SD/TPF 12/5/05 AG*7.1*1 ITEM 3C
..I $P(@GLO,U,12)="" W ?11,"MEDICAID" ;;AG*7.1*2 IM20270
.;I $P(@GLO,U,10)'="D"&($P(@GLO,U,10)'="K") W ?8,$E($P(@GLO,U),1,24)
.I $P(@GLO,U,10)'="D"&($P(@GLO,U,10)'="K"),($P(@GLO,U,4)'="D") W ?8,$E($P(@GLO,U),1,24)
.;BEGIN NEW CODE ;IHS/SD/TPF 12/5/05 AG*7.1*1 ITEM 2
.I $P(@GLO,U,4)="D",($P(@GLO,U,2)=2) D ;IHS/SD/TPF 5/2/2006 AG*7.1*2
..S IENS=$P(@GLO,U,11)
..Q:IENS=""
..S PARTDGLO="^AUPNMCR("_IENS_")"
..S PLANPTR=$P($G(@PARTDGLO),U,4)
..I PLANPTR'="" W ?8,$E($P($G(^AUTNINS(PLANPTR,0)),U),1,20) Q
..W ?8,"UNDEFINED"
.;END NEW CODE
.I $P(@GLO,U,4)="D",($P(@GLO,U,2)=1) D ;IHS/SD/TPF 5/2/2006 AG*7.1*2
..S IENS=$P(@GLO,U,11)
..Q:IENS=""
..S PARTDGLO="^AUPNRRE("_IENS_")"
..S PLANPTR=$P($G(@PARTDGLO),U,4)
..I PLANPTR'="" W ?8,$E($P($G(^AUTNINS(PLANPTR,0)),U),1,20) Q
..W ?8,"UNDEFINED"
.;END NEW CODE
.I $P(@GLO,U,4)="D",($P(@GLO,U,2)'=1),($P(@GLO,U,2)'=2) D ;IHS/SD/TPF 5/2/2006 AG*7.1*2
..S PLANPTR=$P($G(@GLO),U,2)
..I PLANPTR'="" W ?8,$E($P($G(^AUTNINS(PLANPTR,0)),U),1,20) Q
..W ?8,"UNDEFINED"
.;END NEW CODE
.W ?33,$S($P(@GLO,U,4)="T"!($P(@GLO,U,4)="W")!($P(@GLO,U,4)="G"):"",1:$P(@GLO,U,4))
.S EFF=$P(@GLO,U,5)
.I EFF'="" W ?56,$E(EFF,4,5)_"/"_$E(EFF,6,7)_"/"_($E(EFF,1,3)+1700)
.I END'="" W ?69,$E(END,4,5)_"/"_$E(END,6,7)_"/"_($E(END,1,3)+1700)
.W ?79,$S(ISACTIVE:"A",1:"I")
.W !?10,$P(@GLO,U,8),?34,$P(@GLO,U,9)
.S OLDSEL=SEL
W !,$G(AGLINE("-"))
W !,AGLINE("EQ")
K AG("ED"),AG("ERR"),DFOUT,DTOUT,DUOUT,DQOUT,DLOUT,DIROUT,DIR
Q:$G(AGANS)="S"
I '$D(AGSEENLY) D
.;I '$D(AGINS),$$NEEDTOSQ^AGUTILS(DFN,DUZ(2)) W !!!,"THIS PATIENT DOES NOT HAVE A SEQUENCE SET UP AND YOUR SITE REQUIRES SEQUENCING!!" S AGANS="S" D CPROMPT^AGED4A S AGANS="REQSEQ" Q ;AG*7.1*1 SAC RTN SIZE
.I $D(AGINS),$$NEEDTOSQ^AGUTILS(DFN,DUZ(2)) W !!!,"THIS PATIENT DOES NOT HAVE A SEQUENCE SET UP AND YOUR SITE REQUIRES SEQUENCING!!" S AGANS="S" G REQ ;D CPROMPT^AGED4A S AGANS="REQSEQ" Q ;AG*7.1*2 IM20351
.;I $G(AGANS)'="E" S DIR("A")="Enter S(equence), A(dd) insurer, E(dit) insurer, T(oggle seq category) "
.I $G(AGANS)'="E" D
..S DIR("A")="Enter S(equence), A(dd) insurer, E(dit) insurer, T(oggle seq category)"
..S DIR("A")=DIR("A")_" V(iew) Historical Sequence Dates "_$S($G(SHOWINAC):"L(ist active eligibilities)",1:"L(ist inactive eligibilities)") ;AG*7.1*2 IHS/SD/TPF 6/26/2006 PAGE 36
.;I $G(AGANS)'="E" S DIR("?")="Enter an ""S"" to sequence insurers, a ""T"" to ""toggle"" to a category to see if there's anything in that category."
.I $G(AGANS)'="E" D
..S DIR("?")="Enter an ""S"" to sequence insurers, a ""T"" to"
..S DIR("?")=DIR("?")_" ""toggle"" to a category to see if there's anything in that category, or ""V"" to view sequences set up for this patient, or "_$S($G(SHOWINAC):"L to view active eligiblities",1:"L to view inactive eligibilities")_"."
.I $G(AGANS)'="E" S DIR(0)="FO^1:3"
.I $G(AGANS)="E" S DIR("A")="Enter the insurer number to edit. "
.I $G(AGANS)="E" S DIR(0)="NO"
.D ^DIR S X=Y,Y=$$UP^XLFSTR(X) S AGANS=Y K DIR
.I AGANS="L" S SHOWINAC=$S(SHOWINAC=1:0,1:1) D ^AGINS
I AGANS="V" D CPROMPT^AGED4A D:$G(CATPTR)'="U" VPROMPT^AGED4A2(CATPTR) S CATPTR="U" K CATHD D HEADING^AGED4A1 S:AGANS="A"!(AGANS="E") AGVIEWSQ=1 Q:AGANS="A"!(AGANS="E") G DISPLAG ;VIEW PROMPT AG*7.1*2 IHS/SD/TPF 6/26/2006 PAGE 37
I AGANS="T" D CPROMPT^AGED4A D:$G(CATPTR)'="U" DISPCAT Q:$G(AGANS)="E"!($G(AGANS)="A") D HEADING^AGED4A1 G DISPLAG ;TO ACCOMODATE CHNAGE TO DEFAULT DISPLAY IHS/SD/TPF 4/12/2006 AG*7.1*2 ITEM 2 PAGE 35
REQ I AGANS="S" D K AGANS G DISPLAG
.D CPROMPT^AGED4A
.D:$G(CATPTR)'="U" SPROMPT^AGED4A
.S:$G(CATPTR)="U" AGANS="",CATPTR="U" K CATHD
.D HEADING^AGED4A1
I $D(AGSEENLY) S DIR(0)="FO^1:3",DIR("A")="Enter the insurer number to view. " D ^DIR S X=Y,Y=$$UP^XLFSTR(X),AGANS=Y K DIR
Q
DISPINS ;EP - DISPLAY INSURERS
S SEL=0
F S SEL=$O(AGINS(SEL)) Q:'SEL D
.S ISACTIVE=$P(AGINS(SEL),U,13)
.W !
.S END=$P(AGINS(SEL),U,6)
.W ?1,SEL
.;NEW CODE AG*7.1*1 ITEM 2
.;I $P(AGINS(SEL),U,4)="D" D
.I $P(AGINS(SEL),U,4)="D",($P(AGINS(SEL),U,2)=2) D ;IHS/SD/TPF 5/2/2006 AG*7.1*2
..S IENS=$P(AGINS(SEL),U,11)
..Q:IENS=""
..S PARTDGLO="^AUPNMCR("_IENS_")"
..S PLANPTR=$P($G(@PARTDGLO),U,4)
..I PLANPTR'="" W ?8,$E($P($G(^AUTNINS(PLANPTR,0)),U),1,20) Q
..W ?8,"UNDEFINED"
.;END NEW
.I $P(AGINS(SEL),U,4)="D",($P(AGINS(SEL),U,2)'=2),($P(AGINS(SEL),U,2)'=1) D ;IHS/SD/TPF 5/2/2006 AG*7.1*2
..S PLANPTR=$P($G(AGINS(SEL)),U,2)
..I PLANPTR'="" W ?8,$E($P($G(^AUTNINS(PLANPTR,0)),U),1,20) Q
..W ?8,"UNDEFINED"
.;IM HANDLE RR WITH DD ;IHS/SD/TPF 5/2/2006 AG*7.1*2
.I $P(AGINS(SEL),U,4)="D",($P(AGINS(SEL),U,2)=1) D
..S IENS=$P(AGINS(SEL),U,11)
..Q:IENS=""
..S PARTDGLO="^AUPNRRE("_IENS_")"
..S PLANPTR=$P($G(@PARTDGLO),U,4)
..I PLANPTR'="" W ?8,$E($P($G(^AUTNINS(PLANPTR,0)),U),1,20) Q
..W ?8,"UNDEFINED"
.I $P(AGINS(SEL),U,10)="D"!($P(AGINS(SEL),U,10)="K") D
..S MCDREC=$P(AGINS(SEL),U,11)
..S STPTR=$S(MCDREC="":"",1:$P($G(^AUPNMCD($P(MCDREC,","),0)),U,4))
..I STPTR'="" S ST=$P($G(^DIC(5,STPTR,0)),U,2)
..I STPTR'="" W ?8,ST
..I $P($G(AGINS(SEL)),U,12)'="" W ?11,$E($P($G(^AUTNINS($P(AGINS(SEL),U,12),0)),U),1,24) Q
..I $P($G(AGINS(SEL)),U,12)="" W ?11,"MEDICAID"
.;I $P(AGINS(SEL),U,10)'="D"&($P(AGINS(SEL),U,10)'="K") W ?8,$E($P(AGINS(SEL),U),1,24)
.I $P(AGINS(SEL),U,4)'="D" I $P(AGINS(SEL),U,10)'="D"&($P(AGINS(SEL),U,10)'="K") W ?8,$E($P(AGINS(SEL),U),1,24)
.W ?33,$P(AGINS(SEL),U,4)
.S EFF=$P(AGINS(SEL),U,5)
.I EFF'="" W ?56,$E(EFF,4,5)_"/"_$E(EFF,6,7)_"/"_($E(EFF,1,3)+1700)
.I END'="" W ?69,$E(END,4,5)_"/"_$E(END,6,7)_"/"_($E(END,1,3)+1700)
.W !?10,$P(AGINS(SEL),U,8),?34,$P(AGINS(SEL),U,9)
W !,AGLINE("EQ")
K AG("ED"),AG("ERR")
K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT,DIROUT,DIR
Q:$G(AGANS)="S"
Q:$G(AGVIEWSQ) ;
I '$D(AGSEENLY) D
.;I $G(AGANS)'="E" S DIR("A")="Enter S(equence), A(dd) insurer, E(dit) insurer, T(oggle seq category) "
.I $G(AGANS)'="E" D ;AG*7.1*2 IHS/SD/TPF 6/26/2006 PAGE 36
..S DIR("A")="Enter S(equence), A(dd) insurer, E(dit) insurer, T(oggle seq category)"
..S DIR("A")=DIR("A")_" V(iew) Historical Sequence Dates "
..S DIR("A")=DIR("A")_$S($G(SHOWINAC):"L(ist active eligibilities)",1:"L(ist inactive eligibilities)")
.;I $G(AGANS)'="E" S DIR("?")="Enter an ""S"" to sequence insurers, a ""T"" to ""toggle"" to a category to see if there's anything in that category."
.I $G(AGANS)'="E" D
..S DIR("?")="Enter an ""S"" to sequence insurers, a ""T"" to ""toggle"" to a"
..S DIR("?")=DIR("?")_" category to see if there's anything in that category, or ""V"" to view sequences set up for this patient, or "_$S($G(SHOWINAC):"L to view active eligiblities",1:"L to view inactive eligibilities")_"."
.I $G(AGANS)'="E" S DIR(0)="FO^1:3"
.I $G(AGANS)="E" S DIR("A")="Enter the insurer number to edit. "
.I $G(AGANS)="E" S DIR(0)="NO"
.D ^DIR S X=Y,Y=$$UP^XLFSTR(X) S AGANS=Y K DIR
.I AGANS="L" S SHOWINAC=$S(SHOWINAC=1:0,1:1) D ^AGINS
I $D(AGSEENLY) D
.S DIR(0)="FO^1:3"
.S DIR("A")="Enter the insurer number to view. "
.D ^DIR S X=Y,Y=$$UP^XLFSTR(X) S AGANS=Y K DIR
Q
AGED4A1 ; IHS/ASDS/EFG - PAGE 4 - INSURANCE SUMMARY PART 2;
+1 ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
+2 ;
HEADING ;EP -
+1 DO ^AGED
+2 WRITE !,AGLINE("-")
+3 WRITE !?0,"SEQ",?9,"INSURER",?33,"COVERAGE TYPE",?56,"ELIG BEGIN",?67,"-",?69,"ELIG END"
+4 WRITE !?10,"SUBSCRIBER",?34,"POLICY NUMBER"
+5 WRITE !,AGLINE("EQ")
+6 QUIT
ADDMSG ;EP - ELIGIBILITY MESSAGE
+1 WRITE !!,"YOU HAVE ADDED NEW ELIGIBILITY, YOU MAY NEED TO RESEQUENCE INSURERS."
+2 HANG 2
+3 KILL ADDCHK
+4 QUIT
GUARDIS(CATREC) ;EP - DISPLAY GUARANTOR ON SEQUENCED DISPLAY. CALLED FROM AGED4A
+1 NEW CORECPTR,GLOREC,GUARPTR,GUARNAME
+2 ;W !?8,"NOTHING IN THE GUARANTOR FILE FOR THIS PATIENT" Q ;IHS/OKCAO/POC 12/5/2005 REPORTED BY POC AG*7.1*1
IF $PIECE(CATREC,U,11)=""
QUIT
+3 SET CORECPTR=$PIECE(CATREC,U,11)_",0)"
+4 ;S CORECPTR=$P(CATREC,U,9)_",0)" ;IHS/SD/TPF AG*7.1*1 9/7/2005 NO IM
+5 SET GLOREF="^AUPNGUAR("_CORECPTR
+6 ;W !?8,"NO ENTRY IN THE GUARANTOR FIELD FOR THIS PATIENT" Q ;IHS/OKCAO/POC 12/5/2005 REPORTED BY POC AG*7.1*1
IF $GET(@GLOREF)']""
QUIT
+7 SET GUARREC=$PIECE($PIECE($GET(@GLOREF),U),";")
+8 SET GUARGLO=U_$PIECE($PIECE($GET(@GLOREF),U),";",2)
+9 SET GUARPTR=GUARGLO_GUARREC_",0)"
+10 SET GUARPO=$PIECE($GET(@GLOREF),U,3)
+11 IF GUARGLO[("AUPNPAT")
IF $PIECE($GET(@GUARPTR),U)
SET GUARNAME=$PIECE($GET(^DPT($PIECE(@GUARPTR,U),0)),U)
+12 IF '$TEST
SET GUARNAME=$PIECE(@GUARPTR,U)
+13 SET Y=$PIECE(CATREC,U,3)
XECUTE ^DD("DD")
SET GUAREFF=Y
+14 SET Y=$PIECE(CATREC,U,4)
XECUTE ^DD("DD")
SET GUAREND=Y
+15 WRITE ?8,GUARNAME,?33,"GUARANTOR",?56,GUAREFF,?69,GUAREND
+16 WRITE !?10,$PIECE($GET(^DPT(DFN,0)),U),?34,GUARPO
+17 QUIT
TPLDIS(CATREC) ;EP - DISPLAY THIRD PARTY LIABILITY ON SEQUENCED DISPLAY. CALLED FROM AGED4A
+1 NEW TPLPTR,INSURPTR,INSURNAM,POLNUM,TPLEFF,TPLEND,TPLRESP
+2 ;AG*7.1*2 IM20280
IF $PIECE(CATREC,U,11)=""
QUIT
+3 SET TPLPTR="^AUPNTPL("_$PIECE(CATREC,U,11)_",0)"
+4 SET TPLPTR2="^AUPNTPL("_$PIECE(CATREC,U,11)_",1)"
+5 SET INSURPTR=$PIECE($GET(@TPLPTR),U,2)
+6 SET INSURNAM=$SELECT($GET(INSURPTR)'="":$PIECE($GET(^AUTNINS(INSURPTR,0)),U),1:"UNDEFINED")
+7 SET POLNUM=$PIECE($GET(@TPLPTR),U,3)
+8 SET TPLRESP=$PIECE($GET(@TPLPTR2),U)
+9 SET Y=$PIECE($GET(@TPLPTR),U,4)
XECUTE ^DD("DD")
SET TPLEFF=Y
+10 SET Y=$PIECE($GET(@TPLPTR),U,5)
XECUTE ^DD("DD")
SET TPLEND=Y
+11 WRITE ?8,INSURNAM,?33,"TPL",?56,TPLEFF,?69,TPLEND
+12 WRITE !?10,TPLRESP,?34,POLNUM
+13 QUIT
DISPCAT ;EP
DISPCATA ;
+1 SET AGSEL=0
+2 IF $GET(CATPTR)=""
QUIT
+3 ;I $D(CATPTR),('$D(AGCAT(CATPTR))) D Q
+4 ;AG*7.1*2 AG/SD/TPF 6/26/2006 PAGE 37 OF TASK ORDER
IF $DATA(CATPTR)
IF ('$DATA(AGCAT(CATPTR)))
IF ($GET(CATPTR)'="U")
Begin DoDot:1
+5 WRITE !!
+6 WRITE !?10,"*** THIS PATIENT HAS NOTHING SET UP IN THIS CATEGORY. ***"
+7 WRITE !?10,"*** TO ENTER DATA INTO THIS CATEGORY, USE ""Sequence"". ***"
+8 WRITE !!
+9 KILL DIR
+10 SET DIR(0)="E"
+11 DO ^DIR
+12 ;AG*7.1*2 AG/SD/TPF 6/26/2006 PAGE 37 OF TASK ORDER
+13 ;D HEADING^AGED4A1 ;AG*7.1*2 AG/SD/TPF 6/26/2006 PAGE 37 OF TASK ORDER
+14 ;D DISPLAYN
End DoDot:1
QUIT
+15 ;AG*7.1*2 AG/SD/TPF 6/26/2006 PAGE 37 OF TASK ORDER
DO HEADING^AGED4A1
+16 IF $DATA(CATPTR)
IF ('$DATA(AGCAT(CATPTR)))
QUIT
+17 IF $DATA(CATPTR)
IF ($DATA(AGCAT(CATPTR)))
Begin DoDot:1
+18 ;S SQDT="",CNT=0
+19 IF $GET(VIEWDT)
SET SQDT=VIEWDT+.01
SET CNT=0
KILL VIEWDT
+20 ;AG*7.1*2 AG/SD/TPF 6/26/2006 PAGE 37 OF TASK ORDER
IF '$TEST
SET SQDT=DT+.01
SET CNT=0
+21 ;S SQDT=DT+.01,CNT=0 ;IHS/SD/TPF 5/1/2006 AG*7.1*2 IM20494 ;AG*7.1*2 AG/SD/TPF
+22 FOR
SET SQDT=$ORDER(AGCAT(CATPTR,SQDT),-1)
IF 'SQDT
QUIT
Begin DoDot:2
+23 SET CNT=CNT+1
+24 IF CNT>1
QUIT
+25 WRITE !,"SEQ DATE: ",$EXTRACT(SQDT,4,5)_"/"_$EXTRACT(SQDT,6,7)_"/"_($EXTRACT(SQDT,1,3)+1700)
+26 WRITE !
+27 IF $DATA(AGFRMMSG)
WRITE ?5,$$S^AGVDF("RVN"),$$S^AGVDF("BLN"),"*** NEW "_AGFRMSG2_" SEQUENCE REQUIRED FOR ",AGFRMMSG," ***",$$S^AGVDF("BLF"),$$S^AGVDF("RVF")
+28 KILL AGFRMMSG,AGFRMSG2
+29 SET SEQFLG=SQDT
+30 SET AGSEL=0
+31 FOR
SET AGSEL=$ORDER(AGCAT(CATPTR,SQDT,AGSEL))
IF 'AGSEL
QUIT
Begin DoDot:3
+32 SET CATREC=$GET(AGCAT(CATPTR,SQDT,AGSEL))
+33 ;REQUEST TO NOT DISPLAY INACTIVE ELIGIBILITIES WOULD GO HERE
+34 ;ATTACHMENT VIII.1 PATCH 2
+35 ;DID ADRIAN CANCEL THIS REQUEST?
+36 ;END CODE
+37 WRITE !
+38 WRITE ?1,AGSEL,"."
+39 IF $PIECE(CATREC,U,2)="G"
DO GUARDIS^AGED4A1(CATREC)
QUIT
+40 IF $PIECE(CATREC,U,2)="T"
DO TPLDIS^AGED4A1(CATREC)
QUIT
+41 ;BEGIN NEW CODE AG*7.1*1 ITEM 2
+42 IF $PIECE(CATREC,U,2)="D"
IF ($PIECE(CATREC,U)=2)
Begin DoDot:4
+43 SET IENS=$PIECE(CATREC,U,11)
+44 IF IENS=""
QUIT
+45 SET PARTDGLO="^AUPNMCR("_IENS_")"
+46 SET PLANPTR=$PIECE($GET(@PARTDGLO),U,4)
+47 IF PLANPTR'=""
WRITE ?8,$EXTRACT($PIECE($GET(^AUTNINS(PLANPTR,0)),U),1,20)
QUIT
+48 WRITE ?8,"UNDEFINED"
+49 ;END NEW CODE
End DoDot:4
+50 ;IM HANDLE RR WITH DD
+51 IF $PIECE(CATREC,U,2)="D"
IF ($PIECE(CATREC,U)=1)
Begin DoDot:4
+52 SET IENS=$PIECE(CATREC,U,11)
+53 IF IENS=""
QUIT
+54 SET PARTDGLO="^AUPNRRE("_IENS_")"
+55 SET PLANPTR=$PIECE($GET(@PARTDGLO),U,4)
+56 IF PLANPTR'=""
WRITE ?8,$EXTRACT($PIECE($GET(^AUTNINS(PLANPTR,0)),U),1,20)
QUIT
+57 WRITE ?8,"UNDEFINED"
End DoDot:4
+58 IF $EXTRACT($PIECE(CATREC,U,5),1,1)="D"
Begin DoDot:4
+59 SET RECPTR=$EXTRACT($PIECE(CATREC,U,5),2,10)
+60 SET STPTR=$PIECE($GET(^AUPNMCD(RECPTR,0)),U,4)
+61 IF STPTR'=""
WRITE ?8,$PIECE($GET(^DIC(5,STPTR,0)),U,2)_" "
+62 IF STPTR=""
WRITE ?8," "
+63 ;I $P(CATREC,U,8)="" W "MEDICAID"
+64 ;I $P(CATREC,U,8)="" W "UNDEFINED" ;AG*7.1*1 ITEM 3C
+65 ;AG*7.1*2 IM20270
+66 IF $PIECE(CATREC,U,8)=""
WRITE "MEDICAID"
QUIT
+67 IF $PIECE(CATREC,U,8)'=""
WRITE ?8,$EXTRACT($PIECE($GET(^AUTNINS($PIECE(CATREC,U,8),0)),U),1,24)
End DoDot:4
+68 ;I $E($P(CATREC,U,5),1,1)'="D" D
+69 IF $EXTRACT($PIECE(CATREC,U,5),1,1)'="D"
IF ($PIECE(CATREC,U,2)'="D")
Begin DoDot:4
+70 ;IHS/SD/TPF AG*7.1*1 IM18805
IF $PIECE(CATREC,U)=""
WRITE !,"UNDEFINED"
QUIT
+71 WRITE ?8,$EXTRACT($PIECE($GET(^AUTNINS($PIECE(CATREC,U),0)),U),1,24)
End DoDot:4
+72 IF ($PIECE(CATREC,U,2)="D")
IF (($PIECE(CATREC,U)'=1))
IF (($PIECE(CATREC,U)'=2))
Begin DoDot:4
+73 IF $PIECE(CATREC,U)'=""
WRITE $PIECE($GET(^AUTNINS($PIECE(CATREC,U),0)),U)
End DoDot:4
+74 WRITE ?33,$PIECE(CATREC,U,2)
+75 SET EFF=$PIECE(CATREC,U,3)
+76 IF EFF'=""
WRITE ?56,$EXTRACT(EFF,4,5)_"/"_$EXTRACT(EFF,6,7)_"/"_($EXTRACT(EFF,1,3)+1700)
+77 SET END=$PIECE(CATREC,U,4)
+78 IF END'=""
WRITE ?69,$EXTRACT(END,4,5)_"/"_$EXTRACT(END,6,7)_"/"_($EXTRACT(END,1,3)+1700)
+79 WRITE !
SET RECPTR=$PIECE(CATREC,U,5)
+80 IF $EXTRACT(RECPTR)="D"
WRITE ?10,$PIECE($GET(^AUPNMCD($EXTRACT(RECPTR,2,10),21)),U)
+81 IF $EXTRACT(RECPTR)="M"
WRITE ?10,$PIECE($GET(^AUPNMCR($EXTRACT(RECPTR,2,10),21)),U)
+82 IF $EXTRACT(RECPTR)="R"
WRITE ?10,$PIECE($GET(^AUPNRRE($EXTRACT(RECPTR,2,10),21)),U)
+83 IF $EXTRACT(RECPTR)="P"
WRITE ?10,$PIECE($GET(^AUPN3PPH($EXTRACT(RECPTR,2,10),0)),U)
+84 WRITE ?34,$PIECE(AGCAT(CATPTR,SQDT,AGSEL),U,6)
End DoDot:3
End DoDot:2
End DoDot:1
+85 IF $DATA(CATPTR)
IF ($DATA(AGCAT(CATPTR)))
Begin DoDot:1
+86 WRITE !!?6,"*** THIS SEQUENCE REFLECTS THE LATEST PRIORITY SEQUENCE DATE ***"
End DoDot:1
+87 WRITE !,$GET(AGLINE("-"))
DO VERIF2^AGUTILS
WRITE !,AGLINE("EQ")
+88 KILL AG("ED"),AG("ERR"),DFOUT,DTOUT,DUOUT,DQOUT,DLOUT,DIROUT,DIR
+89 ;S DIR("A")="Enter S(equence), A(dd) insurer, E(dit) insurer, T(oggle seq category) "
+90 ;S DIR("?")="Enter an ""S"" to sequence insurers, a ""T"" to ""toggle"" to a category to see if there's anything in that category."
+91 ;AG*7.1*2 IHS/SD/TPF 6/26/2006 PAGE 36
SET DIR("A")="Enter S(equence), A(dd) insurer, E(dit) insurer, T(oggle seq category) V(iew) Historical Sequence Dates:"
+92 SET DIR("?")="Enter an ""S"" to sequence insurers, a ""T"" to ""toggle"" to a category to see if there's anything in that category."
+93 SET DIR(0)="FO^1:3"
DO ^DIR
SET X=Y
SET Y=$$UP^XLFSTR(X)
SET AGANS=Y
KILL DIR
+94 ;VIEW PROMPT AG*7.1*2 IHS/SD/TPF 6/26/2006 PAGE 37
IF AGANS="V"
DO VPROMPT^AGED4A2(CATPTR)
GOTO DISPCATA
+95 ;TO ACCOMODATE CHANGE TO DEFAULT DISPLAY IHS/SD/TPF 4/12/2006 AG*7.1*2 ITEM 2 PAGE 35
IF AGANS="T"
DO CPROMPT^AGED4A
IF CATPTR="U"
QUIT
GOTO DISPCATA
+96 IF AGANS="S"
DO CPROMPT^AGED4A
IF CATPTR="U"
KILL CATHD
IF CATPTR="U"
QUIT
IF $GET(CATPTR)'="U"
DO SPROMPT^AGED4A
IF $GET(CATPTR)="U"
SET AGANS=""
GOTO DISPCATA
+97 ;AG*7.1*2 IHS/SD/TPF 6/26/2006 PAGE 37 RESET TO SUMMARY PAGE IF EXITING SEQUENCE DISPLAY
SET CATPTR="U"
KILL CATHD
+98 QUIT
DISPLAYN ;EP - MCR/RAILROAD
+1 ;IHS/SD/TPF 12/5/05 PER PATCH 1 ITEM 1, DISPLAY MCR PART D ON ITS OWN LINE.
DISPLAG ;
+1 SET GLO="AGINSNN("""")"
+2 SET OLDSEL=""
+3 FOR
SET GLO=$QUERY(@GLO)
IF GLO=""
QUIT
Begin DoDot:1
+4 WRITE !
+5 SET ISACTIVE=$PIECE(@GLO,U,13)
+6 SET END=$PIECE(@GLO,U,6)
+7 IF $LENGTH(GLO,",")>1
SET SEL=$PIECE($PIECE(GLO,","),"(",2)
+8 IF '$TEST
SET SEL=$PIECE($PIECE(GLO,")"),"(",2)
+9 IF OLDSEL=SEL
+10 IF '$TEST
WRITE ?1,SEL,"."
+11 IF $PIECE(@GLO,U,10)="D"!($PIECE(@GLO,U,10)="K")
Begin DoDot:2
+12 SET MCDREC=$PIECE(@GLO,U,11)
+13 SET STPTR=$SELECT(MCDREC="":"",1:$PIECE($GET(^AUPNMCD($PIECE(MCDREC,","),0)),U,4))
+14 IF STPTR'=""
SET ST=$PIECE($GET(^DIC(5,STPTR,0)),U,2)
+15 IF STPTR'=""
WRITE ?8,ST
+16 IF $PIECE(@GLO,U,12)'=""
WRITE ?11,$EXTRACT($PIECE($GET(^AUTNINS($PIECE(@GLO,U,12),0)),U),1,24)
+17 ;I $P(@GLO,U,12)="" W ?11,"MEDICAID"
+18 ;I $P(@GLO,U,12)="" W ?11,"UNDEFINED" ;IHS/SD/TPF 12/5/05 AG*7.1*1 ITEM 3C
+19 ;;AG*7.1*2 IM20270
IF $PIECE(@GLO,U,12)=""
WRITE ?11,"MEDICAID"
End DoDot:2
+20 ;I $P(@GLO,U,10)'="D"&($P(@GLO,U,10)'="K") W ?8,$E($P(@GLO,U),1,24)
+21 IF $PIECE(@GLO,U,10)'="D"&($PIECE(@GLO,U,10)'="K")
IF ($PIECE(@GLO,U,4)'="D")
WRITE ?8,$EXTRACT($PIECE(@GLO,U),1,24)
+22 ;BEGIN NEW CODE ;IHS/SD/TPF 12/5/05 AG*7.1*1 ITEM 2
+23 ;IHS/SD/TPF 5/2/2006 AG*7.1*2
IF $PIECE(@GLO,U,4)="D"
IF ($PIECE(@GLO,U,2)=2)
Begin DoDot:2
+24 SET IENS=$PIECE(@GLO,U,11)
+25 IF IENS=""
QUIT
+26 SET PARTDGLO="^AUPNMCR("_IENS_")"
+27 SET PLANPTR=$PIECE($GET(@PARTDGLO),U,4)
+28 IF PLANPTR'=""
WRITE ?8,$EXTRACT($PIECE($GET(^AUTNINS(PLANPTR,0)),U),1,20)
QUIT
+29 WRITE ?8,"UNDEFINED"
End DoDot:2
+30 ;END NEW CODE
+31 ;IHS/SD/TPF 5/2/2006 AG*7.1*2
IF $PIECE(@GLO,U,4)="D"
IF ($PIECE(@GLO,U,2)=1)
Begin DoDot:2
+32 SET IENS=$PIECE(@GLO,U,11)
+33 IF IENS=""
QUIT
+34 SET PARTDGLO="^AUPNRRE("_IENS_")"
+35 SET PLANPTR=$PIECE($GET(@PARTDGLO),U,4)
+36 IF PLANPTR'=""
WRITE ?8,$EXTRACT($PIECE($GET(^AUTNINS(PLANPTR,0)),U),1,20)
QUIT
+37 WRITE ?8,"UNDEFINED"
End DoDot:2
+38 ;END NEW CODE
+39 ;IHS/SD/TPF 5/2/2006 AG*7.1*2
IF $PIECE(@GLO,U,4)="D"
IF ($PIECE(@GLO,U,2)'=1)
IF ($PIECE(@GLO,U,2)'=2)
Begin DoDot:2
+40 SET PLANPTR=$PIECE($GET(@GLO),U,2)
+41 IF PLANPTR'=""
WRITE ?8,$EXTRACT($PIECE($GET(^AUTNINS(PLANPTR,0)),U),1,20)
QUIT
+42 WRITE ?8,"UNDEFINED"
End DoDot:2
+43 ;END NEW CODE
+44 WRITE ?33,$SELECT($PIECE(@GLO,U,4)="T"!($PIECE(@GLO,U,4)="W")!($PIECE(@GLO,U,4)="G"):"",1:$PIECE(@GLO,U,4))
+45 SET EFF=$PIECE(@GLO,U,5)
+46 IF EFF'=""
WRITE ?56,$EXTRACT(EFF,4,5)_"/"_$EXTRACT(EFF,6,7)_"/"_($EXTRACT(EFF,1,3)+1700)
+47 IF END'=""
WRITE ?69,$EXTRACT(END,4,5)_"/"_$EXTRACT(END,6,7)_"/"_($EXTRACT(END,1,3)+1700)
+48 WRITE ?79,$SELECT(ISACTIVE:"A",1:"I")
+49 WRITE !?10,$PIECE(@GLO,U,8),?34,$PIECE(@GLO,U,9)
+50 SET OLDSEL=SEL
End DoDot:1
+51 WRITE !,$GET(AGLINE("-"))
+52 WRITE !,AGLINE("EQ")
+53 KILL AG("ED"),AG("ERR"),DFOUT,DTOUT,DUOUT,DQOUT,DLOUT,DIROUT,DIR
+54 IF $GET(AGANS)="S"
QUIT
+55 IF '$DATA(AGSEENLY)
Begin DoDot:1
+56 ;I '$D(AGINS),$$NEEDTOSQ^AGUTILS(DFN,DUZ(2)) W !!!,"THIS PATIENT DOES NOT HAVE A SEQUENCE SET UP AND YOUR SITE REQUIRES SEQUENCING!!" S AGANS="S" D CPROMPT^AGED4A S AGANS="REQSEQ" Q ;AG*7.1*1 SAC RTN SIZE
+57 ;D CPROMPT^AGED4A S AGANS="REQSEQ" Q ;AG*7.1*2 IM20351
IF $DATA(AGINS)
IF $$NEEDTOSQ^AGUTILS(DFN,DUZ(2))
WRITE !!!,"THIS PATIENT DOES NOT HAVE A SEQUENCE SET UP AND YOUR SITE REQUIRES SEQUENCING!!"
SET AGANS="S"
GOTO REQ
+58 ;I $G(AGANS)'="E" S DIR("A")="Enter S(equence), A(dd) insurer, E(dit) insurer, T(oggle seq category) "
+59 IF $GET(AGANS)'="E"
Begin DoDot:2
+60 SET DIR("A")="Enter S(equence), A(dd) insurer, E(dit) insurer, T(oggle seq category)"
+61 ;AG*7.1*2 IHS/SD/TPF 6/26/2006 PAGE 36
SET DIR("A")=DIR("A")_" V(iew) Historical Sequence Dates "_$SELECT($GET(SHOWINAC):"L(ist active eligibilities)",1:"L(ist inactive eligibilities)")
End DoDot:2
+62 ;I $G(AGANS)'="E" S DIR("?")="Enter an ""S"" to sequence insurers, a ""T"" to ""toggle"" to a category to see if there's anything in that category."
+63 IF $GET(AGANS)'="E"
Begin DoDot:2
+64 SET DIR("?")="Enter an ""S"" to sequence insurers, a ""T"" to"
+65 SET DIR("?")=DIR("?")_" ""toggle"" to a category to see if there's anything in that category, or ""V"" to view sequences set up for this patient, or "_$SELECT($GET(SHOWINAC):"L to view active eligiblities",1:"L to view inactive
eligibilities")_"."
End DoDot:2
+66 IF $GET(AGANS)'="E"
SET DIR(0)="FO^1:3"
+67 IF $GET(AGANS)="E"
SET DIR("A")="Enter the insurer number to edit. "
+68 IF $GET(AGANS)="E"
SET DIR(0)="NO"
+69 DO ^DIR
SET X=Y
SET Y=$$UP^XLFSTR(X)
SET AGANS=Y
KILL DIR
+70 IF AGANS="L"
SET SHOWINAC=$SELECT(SHOWINAC=1:0,1:1)
DO ^AGINS
End DoDot:1
+71 ;VIEW PROMPT AG*7.1*2 IHS/SD/TPF 6/26/2006 PAGE 37
IF AGANS="V"
DO CPROMPT^AGED4A
IF $GET(CATPTR)'="U"
DO VPROMPT^AGED4A2(CATPTR)
SET CATPTR="U"
KILL CATHD
DO HEADING^AGED4A1
IF AGANS="A"!(AGANS="E")
SET AGVIEWSQ=1
IF AGANS="A"!(AGANS="E")
QUIT
GOTO DISPLAG
+72 ;TO ACCOMODATE CHNAGE TO DEFAULT DISPLAY IHS/SD/TPF 4/12/2006 AG*7.1*2 ITEM 2 PAGE 35
IF AGANS="T"
DO CPROMPT^AGED4A
IF $GET(CATPTR)'="U"
DO DISPCAT
IF $GET(AGANS)="E"!($GET(AGANS)="A")
QUIT
DO HEADING^AGED4A1
GOTO DISPLAG
REQ IF AGANS="S"
Begin DoDot:1
+1 DO CPROMPT^AGED4A
+2 IF $GET(CATPTR)'="U"
DO SPROMPT^AGED4A
+3 IF $GET(CATPTR)="U"
SET AGANS=""
SET CATPTR="U"
KILL CATHD
+4 DO HEADING^AGED4A1
End DoDot:1
KILL AGANS
GOTO DISPLAG
+5 IF $DATA(AGSEENLY)
SET DIR(0)="FO^1:3"
SET DIR("A")="Enter the insurer number to view. "
DO ^DIR
SET X=Y
SET Y=$$UP^XLFSTR(X)
SET AGANS=Y
KILL DIR
+6 QUIT
DISPINS ;EP - DISPLAY INSURERS
+1 SET SEL=0
+2 FOR
SET SEL=$ORDER(AGINS(SEL))
IF 'SEL
QUIT
Begin DoDot:1
+3 SET ISACTIVE=$PIECE(AGINS(SEL),U,13)
+4 WRITE !
+5 SET END=$PIECE(AGINS(SEL),U,6)
+6 WRITE ?1,SEL
+7 ;NEW CODE AG*7.1*1 ITEM 2
+8 ;I $P(AGINS(SEL),U,4)="D" D
+9 ;IHS/SD/TPF 5/2/2006 AG*7.1*2
IF $PIECE(AGINS(SEL),U,4)="D"
IF ($PIECE(AGINS(SEL),U,2)=2)
Begin DoDot:2
+10 SET IENS=$PIECE(AGINS(SEL),U,11)
+11 IF IENS=""
QUIT
+12 SET PARTDGLO="^AUPNMCR("_IENS_")"
+13 SET PLANPTR=$PIECE($GET(@PARTDGLO),U,4)
+14 IF PLANPTR'=""
WRITE ?8,$EXTRACT($PIECE($GET(^AUTNINS(PLANPTR,0)),U),1,20)
QUIT
+15 WRITE ?8,"UNDEFINED"
End DoDot:2
+16 ;END NEW
+17 ;IHS/SD/TPF 5/2/2006 AG*7.1*2
IF $PIECE(AGINS(SEL),U,4)="D"
IF ($PIECE(AGINS(SEL),U,2)'=2)
IF ($PIECE(AGINS(SEL),U,2)'=1)
Begin DoDot:2
+18 SET PLANPTR=$PIECE($GET(AGINS(SEL)),U,2)
+19 IF PLANPTR'=""
WRITE ?8,$EXTRACT($PIECE($GET(^AUTNINS(PLANPTR,0)),U),1,20)
QUIT
+20 WRITE ?8,"UNDEFINED"
End DoDot:2
+21 ;IM HANDLE RR WITH DD ;IHS/SD/TPF 5/2/2006 AG*7.1*2
+22 IF $PIECE(AGINS(SEL),U,4)="D"
IF ($PIECE(AGINS(SEL),U,2)=1)
Begin DoDot:2
+23 SET IENS=$PIECE(AGINS(SEL),U,11)
+24 IF IENS=""
QUIT
+25 SET PARTDGLO="^AUPNRRE("_IENS_")"
+26 SET PLANPTR=$PIECE($GET(@PARTDGLO),U,4)
+27 IF PLANPTR'=""
WRITE ?8,$EXTRACT($PIECE($GET(^AUTNINS(PLANPTR,0)),U),1,20)
QUIT
+28 WRITE ?8,"UNDEFINED"
End DoDot:2
+29 IF $PIECE(AGINS(SEL),U,10)="D"!($PIECE(AGINS(SEL),U,10)="K")
Begin DoDot:2
+30 SET MCDREC=$PIECE(AGINS(SEL),U,11)
+31 SET STPTR=$SELECT(MCDREC="":"",1:$PIECE($GET(^AUPNMCD($PIECE(MCDREC,","),0)),U,4))
+32 IF STPTR'=""
SET ST=$PIECE($GET(^DIC(5,STPTR,0)),U,2)
+33 IF STPTR'=""
WRITE ?8,ST
+34 IF $PIECE($GET(AGINS(SEL)),U,12)'=""
WRITE ?11,$EXTRACT($PIECE($GET(^AUTNINS($PIECE(AGINS(SEL),U,12),0)),U),1,24)
QUIT
+35 IF $PIECE($GET(AGINS(SEL)),U,12)=""
WRITE ?11,"MEDICAID"
End DoDot:2
+36 ;I $P(AGINS(SEL),U,10)'="D"&($P(AGINS(SEL),U,10)'="K") W ?8,$E($P(AGINS(SEL),U),1,24)
+37 IF $PIECE(AGINS(SEL),U,4)'="D"
IF $PIECE(AGINS(SEL),U,10)'="D"&($PIECE(AGINS(SEL),U,10)'="K")
WRITE ?8,$EXTRACT($PIECE(AGINS(SEL),U),1,24)
+38 WRITE ?33,$PIECE(AGINS(SEL),U,4)
+39 SET EFF=$PIECE(AGINS(SEL),U,5)
+40 IF EFF'=""
WRITE ?56,$EXTRACT(EFF,4,5)_"/"_$EXTRACT(EFF,6,7)_"/"_($EXTRACT(EFF,1,3)+1700)
+41 IF END'=""
WRITE ?69,$EXTRACT(END,4,5)_"/"_$EXTRACT(END,6,7)_"/"_($EXTRACT(END,1,3)+1700)
+42 WRITE !?10,$PIECE(AGINS(SEL),U,8),?34,$PIECE(AGINS(SEL),U,9)
End DoDot:1
+43 WRITE !,AGLINE("EQ")
+44 KILL AG("ED"),AG("ERR")
+45 KILL DFOUT,DTOUT,DUOUT,DQOUT,DLOUT,DIROUT,DIR
+46 IF $GET(AGANS)="S"
QUIT
+47 ;
IF $GET(AGVIEWSQ)
QUIT
+48 IF '$DATA(AGSEENLY)
Begin DoDot:1
+49 ;I $G(AGANS)'="E" S DIR("A")="Enter S(equence), A(dd) insurer, E(dit) insurer, T(oggle seq category) "
+50 ;AG*7.1*2 IHS/SD/TPF 6/26/2006 PAGE 36
IF $GET(AGANS)'="E"
Begin DoDot:2
+51 SET DIR("A")="Enter S(equence), A(dd) insurer, E(dit) insurer, T(oggle seq category)"
+52 SET DIR("A")=DIR("A")_" V(iew) Historical Sequence Dates "
+53 SET DIR("A")=DIR("A")_$SELECT($GET(SHOWINAC):"L(ist active eligibilities)",1:"L(ist inactive eligibilities)")
End DoDot:2
+54 ;I $G(AGANS)'="E" S DIR("?")="Enter an ""S"" to sequence insurers, a ""T"" to ""toggle"" to a category to see if there's anything in that category."
+55 IF $GET(AGANS)'="E"
Begin DoDot:2
+56 SET DIR("?")="Enter an ""S"" to sequence insurers, a ""T"" to ""toggle"" to a"
+57 SET DIR("?")=DIR("?")_" category to see if there's anything in that category, or ""V"" to view sequences set up for this patient, or "_$SELECT($GET(SHOWINAC):"L to view active eligiblities",1:"L to view inactive eligibilities")_
"."
End DoDot:2
+58 IF $GET(AGANS)'="E"
SET DIR(0)="FO^1:3"
+59 IF $GET(AGANS)="E"
SET DIR("A")="Enter the insurer number to edit. "
+60 IF $GET(AGANS)="E"
SET DIR(0)="NO"
+61 DO ^DIR
SET X=Y
SET Y=$$UP^XLFSTR(X)
SET AGANS=Y
KILL DIR
+62 IF AGANS="L"
SET SHOWINAC=$SELECT(SHOWINAC=1:0,1:1)
DO ^AGINS
End DoDot:1
+63 IF $DATA(AGSEENLY)
Begin DoDot:1
+64 SET DIR(0)="FO^1:3"
+65 SET DIR("A")="Enter the insurer number to view. "
+66 DO ^DIR
SET X=Y
SET Y=$$UP^XLFSTR(X)
SET AGANS=Y
KILL DIR
End DoDot:1
+67 QUIT
