AGED5.m

AGED5 ; IHS/ASDS/EFG -EDIT PAGE 5 (mcd) ;    

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 ;

OPTION ;

 Q:AGOPT(4)'="Y"&$D(AGSEENLY)

 I AGOPT(4)'="Y" G END

VAR ;EP

 S AG("PG")=5

 I '$D(AGSEENLY)  D

 . I $D(AGADDINS),AGADDINS="E" G HDR

 . S AG("EDIT")="" D ADDNEW^AG5 Q

 Q:$D(DTOUT)!$D(DUOUT)!$D(DFOUT)!$D(DLOUT)

 I $D(AGDELETE) K AGDELETE Q

HDR ;

 I $P($G(^AUPNMCD(AGELPTR,0)),U,4)="" S AG("STPTR")="" D STATE^AG5 K AG("STPTR")

 W $$S^AGVDF("IOF"),!

 W "IHS REGISTRATION ",$S($D(AGSEENLY):"VIEW SCREEN",1:"EDITOR")

 W ?36,"MEDICAID"

 W ?80-$L($P(^DIC(4,DUZ(2),0),U)),$P(^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 ELIGIBILITY STATUS

 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")

 K AG("EDIT")

 K DIR,DA,D0,AG("MCD")

 G L2:$D(^AUPNMCD("AB",DFN))

 Q:$D(AGSEENLY)

 W !!

 S DIR("A")="Do you wish to add MEDICAID? (Y/N) NO// "

 D READ^AGED1

 K DIR

 G END:$D(DLOUT)!(Y["N")!$D(DUOUT),VAR:$D(AG("ERR"))

 G:$D(AG("ED"))&'$D(AGXTERN) @("^AGED"_AG("ED"))

 Q:$D(DTOUT)!$D(DFOUT)  I $D(DQOUT)!(Y'["Y") D YN^AG H 2 G VAR

 I '$D(^AUPNMCD("AB",DFN)) D

 . S AG("EDIT")=""

 . D ADDNEW^AG5

 . G VAR

L2 K AG("TOT")

 S (AG("TOT"),AG("STATE"))=0

 W !?3,"STATE   NUMBER"

 W ?27,"(updated)     ELIG DATE     COVERAGE     ELIG END"

 W !,AGLINE("-")

L3 S AG("STATE")=$P($G(^AUPNMCD(AGELPTR,0)),U,4)

 G L4:AG("STATE")=""

 S AG("TOT")=1

L3A W !,"1.",?4,$P($G(^DIC(5,AG("STATE"),0)),U,2),?9,$P($G(^AUPNMCD(AGELPTR,0)),U,3)

 I $D(^AUPNMCD(AGELPTR,0)),$P($G(^AUPNMCD(AGELPTR,0)),U,8)]"" D

 . S Y=$P($G(^AUPNMCD(AGELPTR,0)),U,8)

 . D DD^%DT

 . W ?25,"(",Y,")"

L3B S DIC=9000004.11,DA=AGELPTR

 F AG("I")=1:1 Q:$D(AG("LKERR"))  D

 .S DR=.01,AG("DRENT")=AG("I")

 .D ^AGDICLK

 .Q:$D(AG("LKERR"))

 .W ?37,"2. "

 .W:AG("I")>1 !

 .W ?40,AG("LKPRINT"),?58,$P(@AGL,U,3)

 .S DR=.02,AG("DRENT")=AG("I")

 .D ^AGDICLK

 .W:$D(AG("LKPRINT")) ?66,AG("LKPRINT")

 S DA=AGELPTR,DIC=9000004,DR=2101

 D ^AGDICLK

 W !!,"3. ","MEDICAID NAME: ",$G(AG("LKPRINT"))

 S DA=DFN,DIC=2,DR=.03

 D ^AGDICLK

 S AGDOB="UNKNOWN"

 I $D(AG("LKPRINT")),AG("LKPRINT")]"" S AGDOB=AG("LKPRINT")

 S DA=AGELPTR,DIC=9000004,DR=2102

 D ^AGDICLK

 I $D(AG("LKPRINT")),AG("LKPRINT")="" S AG("LKPRINT")=AGDOB

 I '$D(AG("LKPRINT")) S AG("LKPRINT")=AGDOB

 K AGDOB

 W ?44,"4. ","MED. DATE OF BIRTH: ",AG("LKPRINT")

 S DA=AGELPTR,DIC=9000004,DR=.14

 D ^AGDICLK

 W !,"5. ","PRIM CARE PROV: ",AG("LKPRINT")

 ;ADD GROUP NAME AND #

 W !,"6. ","GROUP NAME: ",?44,"GROUP NUMBER: "

 S DIQ="AG(",DIQ(0)="E"

 S DIC="^AUPNMCD(",DR=".11;.12"

 D EN^DIQ1

 K DIQ

 W !,"7. ","PLAN NAME: ",AG(9000004,DA,.11,"E")

 W !,"8. ","RATE CODE: ",AG(9000004,DA,.12,"E")

 S DIC=9000004

 S DA=AGELPTR,DR=.15

 D ^AGDICLK

 W !,"9. ","CC ON FILE: ",AG("LKPRINT")

 I $G(AG("LKPRINT"))'="" D

 .S DIC=9000004

 .S DA=AGELPTR,DR=.16

 .D ^AGDICLK

 .W ?28,"DATE: ",AG("LKPRINT")

 W !,AGLINE("-")

 D VERIF^AGUTILS

 W !,AGLINE("EQ")

L4 ;

 I $D(AGSEENLY) D ^DIR,READ^AGED1 G END

 I $D(^XUSEC("AGZMGR",DUZ))  D

 .S DIR("A")="ENTER ACTION (<E>dit Data,<D>elete):"

 I '$D(^XUSEC("AGZMGR",DUZ))  D

 .S DIR("A")="ENTER ACTION (<E>dit Data):"

 D READ

 I $D(^XUSEC("AGZMGR",DUZ))&(Y="D") G DELETE

 G:$D(AG("ED"))&'$D(AGXTERN) @("^AGED"_AG("ED"))

 G L6:Y?1"Y".E,END:$D(DLOUT)!(Y?1"N".E)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)

 Q:$D(DFOUT)!$D(AG("EDIT"))

 I Y?1U&("EA"[Y) G L6:Y="A",EDIT

 G L4:Y'="E"!(Y'="A")!(Y'="D")

 W *7 G VAR

L6 S AG("EDIT")=""

 G VAR

DELETE S:AG("TOT")=1 Y=1

 S DIR("A")="Are you sure you want to DELETE this record ? (Y/N) "

 S DIR(0)="Y"

 S DIR("B")="NO"

 D ^DIR

 I Y'=1 K DIR G END

 G DELETE1:AG("TOT")=1

DELETE1 S AG("SUBSCRPT")="MCD0",AGNXTSUB="MCD1"

 D NOW^%DTC

 S AGDTS=%

 I $D(^AGPATCH(AGDTS,DUZ(2),DFN,"MCD1")) D

 . F AGZ("I")=1:1 Q:AGNXTSUB=""  D

 .. S AG("SUBSCRPT")=AGNXTSUB

 .. S AGNXTSUB=$O(^AGPATCH(AGDTS,DUZ(2),DFN,AGNXTSUB))

 S AG("SUBSCRPT")="MCD"_($E(AG("SUBSCRPT"),4,6)+1)

 S DA=$O(^AUPNMCD(AGELPTR,11,0))

 S:'$D(^AGPATCH(AGDTS,DUZ(2),DFN)) ^(DFN)=""

 S ^AGPATCH(AGDTS,DUZ(2),DFN,AG("SUBSCRPT"))="MCAID^"_$P(^AUPNMCD(AGELPTR,0),U,3,4)

 I DA]"" D

 . S ^AGPATCH(AGDTS,DUZ(2),DFN,AG("SUBSCRPT"))=^AGPATCH(AGDTS,DUZ(2),DFN,AG("SUBSCRPT"))_U_^AUPNMCD(AGELPTR,11,DA,0)

 . S:$P(^AUPNMCD(AGELPTR,11,DA,0),U,2)="" $P(^AGPATCH(AGDTS,DUZ(2),DFN,AG("SUBSCRPT")),U,5)=DT

 K AGNXTSUB,AG("SUBSCRPT")

 S DA=AGELPTR,DR=".01///@",DIE="^AUPNMCD(" D ^DIE W !!!,"The account is deleted.",!,"Press RETURN to continue..." R X:DTIME

 S AGDELETE="" Q

EDIT ;

 K DIR

EDIT1 ;

 S AG("MCD")=AGELPTR

 S AG("STATE")=$P(^AUPNMCD(AG("MCD"),0),U,4)

 S AG("MNUM")=$P(^AUPNMCD(AG("MCD"),0),U,3)

 G EDIT^AGED51

END I $D(DTOUT) S AGTOUT=""

 K AG,DA,DIC,DR,DRENT,AG("DRENT1")

 K AGL,AG("LKDATA"),AG("LKERR"),AG("LKPRINT"),AGNUM,AG("STATE")

 K AG("MCD")

 K Y,AGDTS

 Q:$D(AGXTERN)

 I $D(DIROUT)!$D(DUOUT) K DIROUT,DUOUT Q

 Q

READ ;

 K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT,DIROUT

 S DIR(0)="FO"

 D ^DIR

 Q:$D(DTOUT)

 S:Y="/.,"!(Y="^^") DFOUT=""

 S:Y="" DLOUT=""

 S:Y="^" (DUOUT,Y)=""

 S:Y?1"?".E!(Y["^") (DQOUT,Y)=""

 Q

UPDATE ;EP

 S DA=AG("MCD")

 S DR=".08///"_DT

 S DIE="^AUPNMCD("

 D ^DIE

 D UPDATE1^AGED(DUZ(2),DFN,5,DA)

 Q

AGED5     ; IHS/ASDS/EFG -EDIT PAGE 5 (mcd) ;    

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2       ;

OPTION    ;

 +1        IF AGOPT(4)'="Y"&$DATA(AGSEENLY)

               QUIT 

 +2        IF AGOPT(4)'="Y"

               GOTO END

VAR       ;EP

 +1        SET AG("PG")=5

 +2        IF '$DATA(AGSEENLY)

               Begin DoDot:1

 +3                IF $DATA(AGADDINS)

                       IF AGADDINS="E"

                           GOTO HDR

 +4                SET AG("EDIT")=""

                   DO ADDNEW^AG5

                   QUIT 

               End DoDot:1

 +5        IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DFOUT)!$DATA(DLOUT)

               QUIT 

 +6        IF $DATA(AGDELETE)

               KILL AGDELETE

               QUIT 

HDR       ;

 +1        IF $PIECE($GET(^AUPNMCD(AGELPTR,0)),U,4)=""

               SET AG("STPTR")=""

               DO STATE^AG5

               KILL AG("STPTR")

 +2        WRITE $$S^AGVDF("IOF"),!

 +3        WRITE "IHS REGISTRATION ",$SELECT($DATA(AGSEENLY):"VIEW SCREEN",1:"EDITOR")

 +4        WRITE ?36,"MEDICAID"

 +5        WRITE ?80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U)),$PIECE(^DIC(4,DUZ(2),0),U)

 +6        SET AGLINE("-")=$TRANSLATE($JUSTIFY(" ",80)," ","-")

 +7        SET AGLINE("EQ")=$TRANSLATE($JUSTIFY(" ",80)," ","=")

 +8        WRITE !,AGLINE("EQ")

 +9        WRITE !,$EXTRACT(AGPAT,1,23)

 +10       WRITE ?23,$$DTEST^AGUTILS(DFN)

 +11       IF $DATA(AGCHRT)

               WRITE ?42,"HRN#:",AGCHRT

 +12      ;GET ELIGIBILITY STATUS

 +13       SET AGELSTS=$PIECE($GET(^AUPNPAT(DFN,11)),U,12)

 +14       WRITE ?56,"(",$SELECT(AGELSTS="C":"CHS & DIRECT",AGELSTS="I":"INELIGIBLE",AGELSTS="D":"DIRECT ONLY",AGELSTS="P":"PENDING VERIFICATION",1:"NONE"),")"

 +15       WRITE !,AGLINE("EQ")

 +16       KILL AG("EDIT")

 +17       KILL DIR,DA,D0,AG("MCD")

 +18       IF $DATA(^AUPNMCD("AB",DFN))

               GOTO L2

 +19       IF $DATA(AGSEENLY)

               QUIT 

 +20       WRITE !!

 +21       SET DIR("A")="Do you wish to add MEDICAID? (Y/N) NO// "

 +22       DO READ^AGED1

 +23       KILL DIR

 +24       IF $DATA(DLOUT)!(Y["N")!$DATA(DUOUT)

               GOTO END

           IF $DATA(AG("ERR"))

               GOTO VAR

 +25       IF $DATA(AG("ED"))&'$DATA(AGXTERN)

               GOTO @("^AGED"_AG("ED"))

 +26       IF $DATA(DTOUT)!$DATA(DFOUT)

               QUIT 

           IF $DATA(DQOUT)!(Y'["Y")

               DO YN^AG

               HANG 2

               GOTO VAR

 +27       IF '$DATA(^AUPNMCD("AB",DFN))

               Begin DoDot:1

 +28               SET AG("EDIT")=""

 +29               DO ADDNEW^AG5

 +30               GOTO VAR

               End DoDot:1

L2         KILL AG("TOT")

 +1        SET (AG("TOT"),AG("STATE"))=0

 +2        WRITE !?3,"STATE   NUMBER"

 +3        WRITE ?27,"(updated)     ELIG DATE     COVERAGE     ELIG END"

 +4        WRITE !,AGLINE("-")

L3         SET AG("STATE")=$PIECE($GET(^AUPNMCD(AGELPTR,0)),U,4)

 +1        IF AG("STATE")=""

               GOTO L4

 +2        SET AG("TOT")=1

L3A        WRITE !,"1.",?4,$PIECE($GET(^DIC(5,AG("STATE"),0)),U,2),?9,$PIECE($GET(^AUPNMCD(AGELPTR,0)),U,3)

 +1        IF $DATA(^AUPNMCD(AGELPTR,0))

               IF $PIECE($GET(^AUPNMCD(AGELPTR,0)),U,8)]""

                   Begin DoDot:1

 +2                    SET Y=$PIECE($GET(^AUPNMCD(AGELPTR,0)),U,8)

 +3                    DO DD^%DT

 +4                    WRITE ?25,"(",Y,")"

                   End DoDot:1

L3B        SET DIC=9000004.11

           SET DA=AGELPTR

 +1        FOR AG("I")=1:1

               IF $DATA(AG("LKERR"))

                   QUIT 

               Begin DoDot:1

 +2                SET DR=.01

                   SET AG("DRENT")=AG("I")

 +3                DO ^AGDICLK

 +4                IF $DATA(AG("LKERR"))

                       QUIT 

 +5                WRITE ?37,"2. "

 +6                IF AG("I")>1

                       WRITE !

 +7                WRITE ?40,AG("LKPRINT"),?58,$PIECE(@AGL,U,3)

 +8                SET DR=.02

                   SET AG("DRENT")=AG("I")

 +9                DO ^AGDICLK

 +10               IF $DATA(AG("LKPRINT"))

                       WRITE ?66,AG("LKPRINT")

               End DoDot:1

 +11       SET DA=AGELPTR

           SET DIC=9000004

           SET DR=2101

 +12       DO ^AGDICLK

 +13       WRITE !!,"3. ","MEDICAID NAME: ",$GET(AG("LKPRINT"))

 +14       SET DA=DFN

           SET DIC=2

           SET DR=.03

 +15       DO ^AGDICLK

 +16       SET AGDOB="UNKNOWN"

 +17       IF $DATA(AG("LKPRINT"))

               IF AG("LKPRINT")]""

                   SET AGDOB=AG("LKPRINT")

 +18       SET DA=AGELPTR

           SET DIC=9000004

           SET DR=2102

 +19       DO ^AGDICLK

 +20       IF $DATA(AG("LKPRINT"))

               IF AG("LKPRINT")=""

                   SET AG("LKPRINT")=AGDOB

 +21       IF '$DATA(AG("LKPRINT"))

               SET AG("LKPRINT")=AGDOB

 +22       KILL AGDOB

 +23       WRITE ?44,"4. ","MED. DATE OF BIRTH: ",AG("LKPRINT")

 +24       SET DA=AGELPTR

           SET DIC=9000004

           SET DR=.14

 +25       DO ^AGDICLK

 +26       WRITE !,"5. ","PRIM CARE PROV: ",AG("LKPRINT")

 +27      ;ADD GROUP NAME AND #

 +28       WRITE !,"6. ","GROUP NAME: ",?44,"GROUP NUMBER: "

 +29       SET DIQ="AG("

           SET DIQ(0)="E"

 +30       SET DIC="^AUPNMCD("

           SET DR=".11;.12"

 +31       DO EN^DIQ1

 +32       KILL DIQ

 +33       WRITE !,"7. ","PLAN NAME: ",AG(9000004,DA,.11,"E")

 +34       WRITE !,"8. ","RATE CODE: ",AG(9000004,DA,.12,"E")

 +35       SET DIC=9000004

 +36       SET DA=AGELPTR

           SET DR=.15

 +37       DO ^AGDICLK

 +38       WRITE !,"9. ","CC ON FILE: ",AG("LKPRINT")

 +39       IF $GET(AG("LKPRINT"))'=""

               Begin DoDot:1

 +40               SET DIC=9000004

 +41               SET DA=AGELPTR

                   SET DR=.16

 +42               DO ^AGDICLK

 +43               WRITE ?28,"DATE: ",AG("LKPRINT")

               End DoDot:1

 +44       WRITE !,AGLINE("-")

 +45       DO VERIF^AGUTILS

 +46       WRITE !,AGLINE("EQ")

L4        ;

 +1        IF $DATA(AGSEENLY)

               DO ^DIR

               DO READ^AGED1

               GOTO END

 +2        IF $DATA(^XUSEC("AGZMGR",DUZ))

               Begin DoDot:1

 +3                SET DIR("A")="ENTER ACTION (<E>dit Data,<D>elete):"

               End DoDot:1

 +4        IF '$DATA(^XUSEC("AGZMGR",DUZ))

               Begin DoDot:1

 +5                SET DIR("A")="ENTER ACTION (<E>dit Data):"

               End DoDot:1

 +6        DO READ

 +7        IF $DATA(^XUSEC("AGZMGR",DUZ))&(Y="D")

               GOTO DELETE

 +8        IF $DATA(AG("ED"))&'$DATA(AGXTERN)

               GOTO @("^AGED"_AG("ED"))

 +9        IF Y?1"Y".E

               GOTO L6

           IF $DATA(DLOUT)!(Y?1"N".E)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               GOTO END

 +10       IF $DATA(DFOUT)!$DATA(AG("EDIT"))

               QUIT 

 +11       IF Y?1U&("EA"[Y)

               IF Y="A"

                   GOTO L6

               GOTO EDIT

 +12       IF Y'="E"!(Y'="A")!(Y'="D")

               GOTO L4

 +13       WRITE *7

           GOTO VAR

L6         SET AG("EDIT")=""

 +1        GOTO VAR

DELETE     IF AG("TOT")=1

               SET Y=1

 +1        SET DIR("A")="Are you sure you want to DELETE this record ? (Y/N) "

 +2        SET DIR(0)="Y"

 +3        SET DIR("B")="NO"

 +4        DO ^DIR

 +5        IF Y'=1

               KILL DIR

               GOTO END

 +6        IF AG("TOT")=1

               GOTO DELETE1

DELETE1    SET AG("SUBSCRPT")="MCD0"

           SET AGNXTSUB="MCD1"

 +1        DO NOW^%DTC

 +2        SET AGDTS=%

 +3        IF $DATA(^AGPATCH(AGDTS,DUZ(2),DFN,"MCD1"))

               Begin DoDot:1

 +4                FOR AGZ("I")=1:1

                       IF AGNXTSUB=""

                           QUIT 

                       Begin DoDot:2

 +5                        SET AG("SUBSCRPT")=AGNXTSUB

 +6                        SET AGNXTSUB=$ORDER(^AGPATCH(AGDTS,DUZ(2),DFN,AGNXTSUB))

                       End DoDot:2

               End DoDot:1

 +7        SET AG("SUBSCRPT")="MCD"_($EXTRACT(AG("SUBSCRPT"),4,6)+1)

 +8        SET DA=$ORDER(^AUPNMCD(AGELPTR,11,0))

 +9        IF '$DATA(^AGPATCH(AGDTS,DUZ(2),DFN))

               SET ^(DFN)=""

 +10       SET ^AGPATCH(AGDTS,DUZ(2),DFN,AG("SUBSCRPT"))="MCAID^"_$PIECE(^AUPNMCD(AGELPTR,0),U,3,4)

 +11       IF DA]""

               Begin DoDot:1

 +12               SET ^AGPATCH(AGDTS,DUZ(2),DFN,AG("SUBSCRPT"))=^AGPATCH(AGDTS,DUZ(2),DFN,AG("SUBSCRPT"))_U_^AUPNMCD(AGELPTR,11,DA,0)

 +13               IF $PIECE(^AUPNMCD(AGELPTR,11,DA,0),U,2)=""

                       SET $PIECE(^AGPATCH(AGDTS,DUZ(2),DFN,AG("SUBSCRPT")),U,5)=DT

               End DoDot:1

 +14       KILL AGNXTSUB,AG("SUBSCRPT")

 +15       SET DA=AGELPTR

           SET DR=".01///@"

           SET DIE="^AUPNMCD("

           DO ^DIE

           WRITE !!!,"The account is deleted.",!,"Press RETURN to continue..."

           READ X:DTIME

 +16       SET AGDELETE=""

           QUIT 

EDIT      ;

 +1        KILL DIR

EDIT1     ;

 +1        SET AG("MCD")=AGELPTR

 +2        SET AG("STATE")=$PIECE(^AUPNMCD(AG("MCD"),0),U,4)

 +3        SET AG("MNUM")=$PIECE(^AUPNMCD(AG("MCD"),0),U,3)

 +4        GOTO EDIT^AGED51

END        IF $DATA(DTOUT)

               SET AGTOUT=""

 +1        KILL AG,DA,DIC,DR,DRENT,AG("DRENT1")

 +2        KILL AGL,AG("LKDATA"),AG("LKERR"),AG("LKPRINT"),AGNUM,AG("STATE")

 +3        KILL AG("MCD")

 +4        KILL Y,AGDTS

 +5        IF $DATA(AGXTERN)

               QUIT 

 +6        IF $DATA(DIROUT)!$DATA(DUOUT)

               KILL DIROUT,DUOUT

               QUIT 

 +7        QUIT 

READ      ;

 +1        KILL DFOUT,DTOUT,DUOUT,DQOUT,DLOUT,DIROUT

 +2        SET DIR(0)="FO"

 +3        DO ^DIR

 +4        IF $DATA(DTOUT)

               QUIT 

 +5        IF Y="/.,"!(Y="^^")

               SET DFOUT=""

 +6        IF Y=""

               SET DLOUT=""

 +7        IF Y="^"

               SET (DUOUT,Y)=""

 +8        IF Y?1"?".E!(Y["^")

               SET (DQOUT,Y)=""

 +9        QUIT 

UPDATE    ;EP

 +1        SET DA=AG("MCD")

 +2        SET DR=".08///"_DT

 +3        SET DIE="^AUPNMCD("

 +4        DO ^DIE

 +5        DO UPDATE1^AGED(DUZ(2),DFN,5,DA)

 +6        QUIT