AGEDMCD1 ; IHS/ASDS/TPF - NEW EDIT/DISP MCD SCREEN - CODE OVERFLOW ;
;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
;
HDR ;EP - CALLED BY AGEDMCD
S AGPAT=$P($G(^DPT(DFN,0)),U)
S AGCHRT=$S($D(^AUPNPAT(DFN,41,DUZ(2),0)):$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2),1:"xxxxx")
S AG("AUPN")=""
S:$D(^AUPNPAT(DFN,0)) AG("AUPN")=^(0)
S AGLINE("-")=$TR($J(" ",78)," ","-")
S AGLINE("EQ")=$TR($J(" ",78)," ","=")
S $P(AGLINE("PGLN"),"=",81)=""
W $$S^AGVDF("IOF"),!
S ROUTID=$P($T(+1)," ")
S SUBS=$P($G(AGSELECT),U,11)
D PROGVIEW^AGUTILS(DUZ,SUBS)
W "IHS REGISTRATION ",$S($D(AGSEENLY):"VIEW SCREEN",1:"EDITOR")
W ?36,"MEDICAID"
W ?80-$L($P($G(^DIC(4,DUZ(2),0)),U)),$P($G(^DIC(4,DUZ(2),0)),U)
S AGLINE("-")=$TR($J(" ",80)," ","-")
S AGLINE("EQ")=$TR($J(" ",80)," ","=")
W !,AGLINE("EQ")
W !,$E(AGPAT,1,23)
W ?23,$$DTEST^AGUTILS(DFN)
I $D(AGCHRT) W ?42,"HRN#:",AGCHRT
;GET ELIG STAT
S AGELSTS=$P($G(^AUPNPAT(DFN,11)),U,12)
W ?56,"(",$S(AGELSTS="C":"CHS & DIRECT",AGELSTS="I":"INELIGIBLE",AGELSTS="D":"DIRECT ONLY",AGELSTS="P":"PENDING VERIFICATION",1:"NONE"),")"
W !,AGLINE("EQ")
W !,?3,"NUMBER",?22,"(updated)",?39,"ELIG DATE",?53,"COVERAGE",?64,"ELIG END"
W !,AGLINE("-")
S DA=DFN
K AG("EDIT")
Q
GETDATES(WD0) ;EP - GET THE DTS USING LIST^DIC
S FLAGS=""
S FIELDS=";.01I;.02I;.03I"
D LIST^DIC(9000004.11,","_WD0_",",FIELDS,FLAGS,"*",,,,,,"RESULT","ERROR")
D DATESORT(.RESULT)
Q
DATESHOW(RESULT) ;
N REC
S REC=0
F S REC=$O(RESULT("DILIST","ID",REC)) Q:'REC D
. I REC'=1 W !
. S Y=RESULT("DILIST","ID",REC,.01) X ^DD("DD")
. W ?39,Y
. W ?59,RESULT("DILIST","ID",REC,.03)
. S Y=RESULT("DILIST","ID",REC,.02) X ^DD("DD")
. W ?71,Y
. W ?79,$S($$ISACTIVE^AGINS(RESULT("DILIST","ID",REC,.01),RESULT("DILIST","ID",REC,.02)):"A",1:"I")
DATESORT(RESULT) ;EP - TAKE LIST RETURNED BY FILE^DIC AND SORT IT
;BASED ON SPECS
N DATESORT,SPECSUB,EFFDT,ENDDT,CVG
S REC=0
F S REC=$O(RESULT("DILIST","ID",REC)) Q:'REC D
.S ENDDT=RESULT("DILIST","ID",REC,.02)
.S EFFDT=RESULT("DILIST","ID",REC,.01)
.S CVG=RESULT("DILIST","ID",REC,.03)
.S SPECSUB=$S(ENDDT="":"O",1:"T") ;O=OPEN ENDED, T=TERM DATE
.I SPECSUB="O" S DATESORT(SPECSUB,EFFDT)=ENDDT_U_CVG
.E S DATESORT(SPECSUB,-ENDDT)=EFFDT_U_CVG
S DEFEDDT=$O(DATESORT("O","")) ;GET DEFAULT EDIT DT. FIRST ONE IN DISP
I DEFEDDT="" S DEFEDDT=$O(DATESORT("T","")) S:DEFEDDT'="" DEFEDDT=$P(DATESORT("T",DEFEDDT),U)
D SHOWNEW(.DATESORT)
Q
SHOWNEW(DATESORT) ;EP
N SPECSUB,DATE,DATE1,CVG,EFFDT,ENDDT,REC
S SPECSUB=""
S REC=1
I '$D(DATESORT("O")) F S SPECSUB=$O(DATESORT(SPECSUB)) Q:SPECSUB="" D ALLTERM Q
F S SPECSUB=$O(DATESORT(SPECSUB)) Q:SPECSUB="" D
.S DATE=""
.F S DATE=$O(DATESORT(SPECSUB,DATE)) Q:DATE="" D
..S DATE1=$P(DATESORT(SPECSUB,DATE),U)
..S CVG=$P(DATESORT(SPECSUB,DATE),U,2)
..I SPECSUB="O" S EFFDT=DATE,ENDDT=""
..E S EFFDT=DATE1,ENDDT=-DATE
..I REC'=1 W !
..S Y=EFFDT X ^DD("DD")
..W ?39,Y
..W ?57,CVG
..S Y=ENDDT X ^DD("DD")
..W ?64,Y
..W ?79,$S($$ISACTIVE^AGINS(EFFDT,ENDDT):"A",1:"I")
..S REC=REC+1
Q
ALLTERM ;EP
S DATE=""
F S DATE=$O(DATESORT(SPECSUB,DATE),-1) Q:DATE="" D
.S DATE1=$P(DATESORT(SPECSUB,DATE),U)
.S CVG=$P(DATESORT(SPECSUB,DATE),U,2)
.I SPECSUB="O" S EFFDT=DATE,ENDDT=""
.E S EFFDT=DATE1,ENDDT=-DATE
.I REC'=1 W !
.S Y=EFFDT X ^DD("DD")
.W ?39,Y
.W ?57,CVG
.S Y=ENDDT X ^DD("DD")
.W ?64,Y
.W ?79,$S($$ISACTIVE^AGINS(EFFDT,ENDDT):"A",1:"I")
.S REC=REC+1
Q
AGEDMCD1 ; IHS/ASDS/TPF - NEW EDIT/DISP MCD SCREEN - CODE OVERFLOW ;
+1 ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
+2 ;
HDR ;EP - CALLED BY AGEDMCD
+1 SET AGPAT=$PIECE($GET(^DPT(DFN,0)),U)
+2 SET AGCHRT=$SELECT($DATA(^AUPNPAT(DFN,41,DUZ(2),0)):$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2),1:"xxxxx")
+3 SET AG("AUPN")=""
+4 IF $DATA(^AUPNPAT(DFN,0))
SET AG("AUPN")=^(0)
+5 SET AGLINE("-")=$TRANSLATE($JUSTIFY(" ",78)," ","-")
+6 SET AGLINE("EQ")=$TRANSLATE($JUSTIFY(" ",78)," ","=")
+7 SET $PIECE(AGLINE("PGLN"),"=",81)=""
+8 WRITE $$S^AGVDF("IOF"),!
+9 SET ROUTID=$PIECE($TEXT(+1)," ")
+10 SET SUBS=$PIECE($GET(AGSELECT),U,11)
+11 DO PROGVIEW^AGUTILS(DUZ,SUBS)
+12 WRITE "IHS REGISTRATION ",$SELECT($DATA(AGSEENLY):"VIEW SCREEN",1:"EDITOR")
+13 WRITE ?36,"MEDICAID"
+14 WRITE ?80-$LENGTH($PIECE($GET(^DIC(4,DUZ(2),0)),U)),$PIECE($GET(^DIC(4,DUZ(2),0)),U)
+15 SET AGLINE("-")=$TRANSLATE($JUSTIFY(" ",80)," ","-")
+16 SET AGLINE("EQ")=$TRANSLATE($JUSTIFY(" ",80)," ","=")
+17 WRITE !,AGLINE("EQ")
+18 WRITE !,$EXTRACT(AGPAT,1,23)
+19 WRITE ?23,$$DTEST^AGUTILS(DFN)
+20 IF $DATA(AGCHRT)
WRITE ?42,"HRN#:",AGCHRT
+21 ;GET ELIG STAT
+22 SET AGELSTS=$PIECE($GET(^AUPNPAT(DFN,11)),U,12)
+23 WRITE ?56,"(",$SELECT(AGELSTS="C":"CHS & DIRECT",AGELSTS="I":"INELIGIBLE",AGELSTS="D":"DIRECT ONLY",AGELSTS="P":"PENDING VERIFICATION",1:"NONE"),")"
+24 WRITE !,AGLINE("EQ")
+25 WRITE !,?3,"NUMBER",?22,"(updated)",?39,"ELIG DATE",?53,"COVERAGE",?64,"ELIG END"
+26 WRITE !,AGLINE("-")
+27 SET DA=DFN
+28 KILL AG("EDIT")
+29 QUIT
GETDATES(WD0) ;EP - GET THE DTS USING LIST^DIC
+1 SET FLAGS=""
+2 SET FIELDS=";.01I;.02I;.03I"
+3 DO LIST^DIC(9000004.11,","_WD0_",",FIELDS,FLAGS,"*",,,,,,"RESULT","ERROR")
+4 DO DATESORT(.RESULT)
+5 QUIT
DATESHOW(RESULT) ;
+1 NEW REC
+2 SET REC=0
+3 FOR
SET REC=$ORDER(RESULT("DILIST","ID",REC))
IF 'REC
QUIT
Begin DoDot:1
+4 IF REC'=1
WRITE !
+5 SET Y=RESULT("DILIST","ID",REC,.01)
XECUTE ^DD("DD")
+6 WRITE ?39,Y
+7 WRITE ?59,RESULT("DILIST","ID",REC,.03)
+8 SET Y=RESULT("DILIST","ID",REC,.02)
XECUTE ^DD("DD")
+9 WRITE ?71,Y
+10 WRITE ?79,$SELECT($$ISACTIVE^AGINS(RESULT("DILIST","ID",REC,.01),RESULT("DILIST","ID",REC,.02)):"A",1:"I")
End DoDot:1
DATESORT(RESULT) ;EP - TAKE LIST RETURNED BY FILE^DIC AND SORT IT
+1 ;BASED ON SPECS
+2 NEW DATESORT,SPECSUB,EFFDT,ENDDT,CVG
+3 SET REC=0
+4 FOR
SET REC=$ORDER(RESULT("DILIST","ID",REC))
IF 'REC
QUIT
Begin DoDot:1
+5 SET ENDDT=RESULT("DILIST","ID",REC,.02)
+6 SET EFFDT=RESULT("DILIST","ID",REC,.01)
+7 SET CVG=RESULT("DILIST","ID",REC,.03)
+8 ;O=OPEN ENDED, T=TERM DATE
SET SPECSUB=$SELECT(ENDDT="":"O",1:"T")
+9 IF SPECSUB="O"
SET DATESORT(SPECSUB,EFFDT)=ENDDT_U_CVG
+10 IF '$TEST
SET DATESORT(SPECSUB,-ENDDT)=EFFDT_U_CVG
End DoDot:1
+11 ;GET DEFAULT EDIT DT. FIRST ONE IN DISP
SET DEFEDDT=$ORDER(DATESORT("O",""))
+12 IF DEFEDDT=""
SET DEFEDDT=$ORDER(DATESORT("T",""))
IF DEFEDDT'=""
SET DEFEDDT=$PIECE(DATESORT("T",DEFEDDT),U)
+13 DO SHOWNEW(.DATESORT)
+14 QUIT
SHOWNEW(DATESORT) ;EP
+1 NEW SPECSUB,DATE,DATE1,CVG,EFFDT,ENDDT,REC
+2 SET SPECSUB=""
+3 SET REC=1
+4 IF '$DATA(DATESORT("O"))
FOR
SET SPECSUB=$ORDER(DATESORT(SPECSUB))
IF SPECSUB=""
QUIT
DO ALLTERM
QUIT
+5 FOR
SET SPECSUB=$ORDER(DATESORT(SPECSUB))
IF SPECSUB=""
QUIT
Begin DoDot:1
+6 SET DATE=""
+7 FOR
SET DATE=$ORDER(DATESORT(SPECSUB,DATE))
IF DATE=""
QUIT
Begin DoDot:2
+8 SET DATE1=$PIECE(DATESORT(SPECSUB,DATE),U)
+9 SET CVG=$PIECE(DATESORT(SPECSUB,DATE),U,2)
+10 IF SPECSUB="O"
SET EFFDT=DATE
SET ENDDT=""
+11 IF '$TEST
SET EFFDT=DATE1
SET ENDDT=-DATE
+12 IF REC'=1
WRITE !
+13 SET Y=EFFDT
XECUTE ^DD("DD")
+14 WRITE ?39,Y
+15 WRITE ?57,CVG
+16 SET Y=ENDDT
XECUTE ^DD("DD")
+17 WRITE ?64,Y
+18 WRITE ?79,$SELECT($$ISACTIVE^AGINS(EFFDT,ENDDT):"A",1:"I")
+19 SET REC=REC+1
End DoDot:2
End DoDot:1
+20 QUIT
ALLTERM ;EP
+1 SET DATE=""
+2 FOR
SET DATE=$ORDER(DATESORT(SPECSUB,DATE),-1)
IF DATE=""
QUIT
Begin DoDot:1
+3 SET DATE1=$PIECE(DATESORT(SPECSUB,DATE),U)
+4 SET CVG=$PIECE(DATESORT(SPECSUB,DATE),U,2)
+5 IF SPECSUB="O"
SET EFFDT=DATE
SET ENDDT=""
+6 IF '$TEST
SET EFFDT=DATE1
SET ENDDT=-DATE
+7 IF REC'=1
WRITE !
+8 SET Y=EFFDT
XECUTE ^DD("DD")
+9 WRITE ?39,Y
+10 WRITE ?57,CVG
+11 SET Y=ENDDT
XECUTE ^DD("DD")
+12 WRITE ?64,Y
+13 WRITE ?79,$SELECT($$ISACTIVE^AGINS(EFFDT,ENDDT):"A",1:"I")
+14 SET REC=REC+1
End DoDot:1
+15 QUIT
