- 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
