AGEL0A.m

AGEL0A ; IHS/ASDS/EFG - Add/Edit Eligibility Information ;   

 ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007

 ;

OPT ;EP - PROMPT TO ADD MEMBER OR EDIT DATA

 NEW DIR,DLOUT

 KILL DIRUT,DIROUT,DTOUT,DUOUT

 S DIR("A")="ENTER ACTION (<E>dit Data,<A>dd Member,<D>elete Member,<V>iew/Edit PH Addr)"

 S DIR(0)="FO"

 D ^DIR

 KILL DIR

 S X=Y,Y=$$UP^XLFSTR(X)

 I $E(Y,1,1)["v" S Y="V"

 I (Y["V"&($L(Y)>1))&($E(Y,2,3)'>12)!($E(Y,2,3)>$G(AGELP("FLDS"))) D  Q

 . W !,"*** YOU MUST ENTER A NUMBER FROM 1 - ",$G(AGELP("FLDS"))

 . H 2

 Q:$G(Y)=$G(AGOPT("ESCAPE"))

 I Y["V" D ^AGPHADDR S Y="V" K:X[(U_U) AGELP("PH") Q

 Q:$D(DTOUT)

 I $E(Y)="^" S DUOUT="" Q

 I Y=""!("Nn"[$E(Y)) S Y="N",DLOUT="" Q

 I +Y>0 S Y="E"_+Y Q

 I "aA"[$E(Y) S Y="A" Q

 I "Dd"[$E(Y),'$D(^XUSEC("AGZMGR",DUZ)) D

 . W:$$DIR^XBDIR("E","Only users with ""AGZMGR"" key can [D]elete") ""

 . S Y="Z"

 .Q

 I "Dd"[$E(Y) S Y="D" Q

 I "eE"[$E(Y) S Y="E"_$S(+$E(Y,2,9):+$E(Y,2,9),1:"") Q

 W:$E(Y)'="?" *7

 W !!?5,"Enter either 'E' to Edit Data, 'A' to Add a Member, 'D' to Delete a member,",!?5  ; IHS/SD/EFG  AG*7*1  02/27/2003

 W "'V' to View/edit the Policy Holder's address info, or 'RETURN' to quit.",!  ; IHS/SD/EFG  AG*7*1  02/27/2003

 G OPT

 Q

FLDS ;EP -  Field Edit Controller

 I +$E(Y,2)>0 S Y=$E(Y,2,99) G EJ

AGN W !

 S DIR(0)="LO^1:"_AGELP("FLDS")

 S DIR(0)="LO^1:"_$G(AGELP("FLDS"))  ;IHS/SD/TPF AG*7.1*1 9/6/2005

 S DIR("A")="     Select the Desired FIELDS"

 D ^DIR

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

 S:Y="" DLOUT=""

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

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

 K DIR

 Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)

EJ S AGELP("FLDS")=Y

 Q

DEL ;EP - DELETE MESSAGE

 I AGELP("TYPE")="MCD" D

 .W *7,!!

 .W ?5,"Sorry, this function is not available for Medicaid yet, you may"

AG .W !?5,"DELETE thru the Medicaid Page in Patient Registration though."

 .H 4 Q

 W !!?5,"------------POLICY MEMBERS------------"

 S Y=0

 F AGEL("I")=1:1 S Y=$O(AGELP(Y)) Q:'+Y  W !?10,AGEL("I"),") ",$P(^DPT(Y,0),U) S AGEL(AGEL("I"),Y)=""

 I AGEL("I")=1 W !!,*7,"No Registered Members Exist for this Policy!" Q

 K DIR S DIR(0)="NO^1:"_(AGEL("I")-1),DIR("A")="  DELETE which Member" D ^DIR K DIR

 Q:+Y<1

 S AGEL("Y")=$O(AGEL(+Y,"")) Q:AGEL("Y")<1

 I AGEL("I")=2 D  Q:'Y

 .W !!?5,*7,$P(^DPT(AGEL("Y"),0),U)," is the only registered member! Deleting this member"

 .W !?5,"will delete this entire private insurance entry from this patient's record."

 .K DIR

 .S DIR("B")="N"

 .S DIR(0)="Y",DIR("A")="Are you sure you wish to delete this entry" D ^DIR

 ;AG*7.1 ITSC/SD/TPF 9/14/2004 ADDED KILL OF AGELP("PH"),ADDCHK FOR PROPER EXIT FROM PRIVATE SCREEN WHEN DELETING LAST MEMBER

 I AGELP("TYPE")="PI" S DA(1)=AGEL("Y"),DIK="^AUPNPRVT("_DA(1)_",11,",DA=$P(AGELP(AGEL("Y")),U,2) D ^DIK K AGELP("PH"),ADDCHK

 K AGELP(AGEL("Y"))

 ;IF THIS IS THE LAST PRIVATE INSURER STORED FOR THIS PATIENT THEN

 ;CLEAN UP TOP RECORD

 I '$O(^AUPNPRVT(DFN,11,0)) D

 .S DA=DFN,DIK="^AUPNPRVT(" D ^DIK K AGELP("PH"),ADDCHK

 .;THE KILL OF AGELP("PH") ALLOWS FOR PROPER EXTING FROM PRIVATE SCREEN WHEN DELETING

 .;ENTIRE ENTRY. KILL ADDCHK BECAUSE NOTHING WAS ADDED

 Q

PKILL S AGELP("Y")=0

 S Y=0

 F  S Y=$O(AGELP(Y)) Q:'+Y  S AGEL("Y")=Y D

 .I AGELP("TYPE")="PI" D

 ..S DA(1)=AGEL("Y")

 ..S DIK="^AUPNPRVT("_DA(1)_",11,"

 ..S DA=$P(AGELP(AGEL("Y")),U,2)

 ..D ^DIK

 Q

AGEL0A    ; IHS/ASDS/EFG - Add/Edit Eligibility Information ;   

 +1       ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007

 +2       ;

OPT       ;EP - PROMPT TO ADD MEMBER OR EDIT DATA

 +1        NEW DIR,DLOUT

 +2        KILL DIRUT,DIROUT,DTOUT,DUOUT

 +3        SET DIR("A")="ENTER ACTION (<E>dit Data,<A>dd Member,<D>elete Member,<V>iew/Edit PH Addr)"

 +4        SET DIR(0)="FO"

 +5        DO ^DIR

 +6        KILL DIR

 +7        SET X=Y

           SET Y=$$UP^XLFSTR(X)

 +8        IF $EXTRACT(Y,1,1)["v"

               SET Y="V"

 +9        IF (Y["V"&($LENGTH(Y)>1))&($EXTRACT(Y,2,3)'>12)!($EXTRACT(Y,2,3)>$GET(AGELP("FLDS")))

               Begin DoDot:1

 +10               WRITE !,"*** YOU MUST ENTER A NUMBER FROM 1 - ",$GET(AGELP("FLDS"))

 +11               HANG 2

               End DoDot:1

               QUIT 

 +12       IF $GET(Y)=$GET(AGOPT("ESCAPE"))

               QUIT 

 +13       IF Y["V"

               DO ^AGPHADDR

               SET Y="V"

               IF X[(U_U)

                   KILL AGELP("PH")

               QUIT 

 +14       IF $DATA(DTOUT)

               QUIT 

 +15       IF $EXTRACT(Y)="^"

               SET DUOUT=""

               QUIT 

 +16       IF Y=""!("Nn"[$EXTRACT(Y))

               SET Y="N"

               SET DLOUT=""

               QUIT 

 +17       IF +Y>0

               SET Y="E"_+Y

               QUIT 

 +18       IF "aA"[$EXTRACT(Y)

               SET Y="A"

               QUIT 

 +19       IF "Dd"[$EXTRACT(Y)

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

                   Begin DoDot:1

 +20                   IF $$DIR^XBDIR("E","Only users with ""AGZMGR"" key can [D]elete")

                           WRITE ""

 +21                   SET Y="Z"

 +22                   QUIT 

                   End DoDot:1

 +23       IF "Dd"[$EXTRACT(Y)

               SET Y="D"

               QUIT 

 +24       IF "eE"[$EXTRACT(Y)

               SET Y="E"_$SELECT(+$EXTRACT(Y,2,9):+$EXTRACT(Y,2,9),1:"")

               QUIT 

 +25       IF $EXTRACT(Y)'="?"

               WRITE *7

 +26      ; IHS/SD/EFG  AG*7*1  02/27/2003

           WRITE !!?5,"Enter either 'E' to Edit Data, 'A' to Add a Member, 'D' to Delete a member,",!?5

 +27      ; IHS/SD/EFG  AG*7*1  02/27/2003

           WRITE "'V' to View/edit the Policy Holder's address info, or 'RETURN' to quit.",!

 +28       GOTO OPT

 +29       QUIT 

FLDS      ;EP -  Field Edit Controller

 +1        IF +$EXTRACT(Y,2)>0

               SET Y=$EXTRACT(Y,2,99)

               GOTO EJ

AGN        WRITE !

 +1        SET DIR(0)="LO^1:"_AGELP("FLDS")

 +2       ;IHS/SD/TPF AG*7.1*1 9/6/2005

           SET DIR(0)="LO^1:"_$GET(AGELP("FLDS"))

 +3        SET DIR("A")="     Select the Desired FIELDS"

 +4        DO ^DIR

 +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        KILL DIR

 +10       IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               QUIT 

EJ         SET AGELP("FLDS")=Y

 +1        QUIT 

DEL       ;EP - DELETE MESSAGE

 +1        IF AGELP("TYPE")="MCD"

               Begin DoDot:1

 +2                WRITE *7,!!

 +3                WRITE ?5,"Sorry, this function is not available for Medicaid yet, you may"

AG                 WRITE !?5,"DELETE thru the Medicaid Page in Patient Registration though."

 +1                HANG 4

                   QUIT 

               End DoDot:1

 +2        WRITE !!?5,"------------POLICY MEMBERS------------"

 +3        SET Y=0

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

               SET Y=$ORDER(AGELP(Y))

               IF '+Y

                   QUIT 

               WRITE !?10,AGEL("I"),") ",$PIECE(^DPT(Y,0),U)

               SET AGEL(AGEL("I"),Y)=""

 +5        IF AGEL("I")=1

               WRITE !!,*7,"No Registered Members Exist for this Policy!"

               QUIT 

 +6        KILL DIR

           SET DIR(0)="NO^1:"_(AGEL("I")-1)

           SET DIR("A")="  DELETE which Member"

           DO ^DIR

           KILL DIR

 +7        IF +Y<1

               QUIT 

 +8        SET AGEL("Y")=$ORDER(AGEL(+Y,""))

           IF AGEL("Y")<1

               QUIT 

 +9        IF AGEL("I")=2

               Begin DoDot:1

 +10               WRITE !!?5,*7,$PIECE(^DPT(AGEL("Y"),0),U)," is the only registered member! Deleting this member"

 +11               WRITE !?5,"will delete this entire private insurance entry from this patient's record."

 +12               KILL DIR

 +13               SET DIR("B")="N"

 +14               SET DIR(0)="Y"

                   SET DIR("A")="Are you sure you wish to delete this entry"

                   DO ^DIR

               End DoDot:1

               IF 'Y

                   QUIT 

 +15      ;AG*7.1 ITSC/SD/TPF 9/14/2004 ADDED KILL OF AGELP("PH"),ADDCHK FOR PROPER EXIT FROM PRIVATE SCREEN WHEN DELETING LAST MEMBER

 +16       IF AGELP("TYPE")="PI"

               SET DA(1)=AGEL("Y")

               SET DIK="^AUPNPRVT("_DA(1)_",11,"

               SET DA=$PIECE(AGELP(AGEL("Y")),U,2)

               DO ^DIK

               KILL AGELP("PH"),ADDCHK

 +17       KILL AGELP(AGEL("Y"))

 +18      ;IF THIS IS THE LAST PRIVATE INSURER STORED FOR THIS PATIENT THEN

 +19      ;CLEAN UP TOP RECORD

 +20       IF '$ORDER(^AUPNPRVT(DFN,11,0))

               Begin DoDot:1

 +21               SET DA=DFN

                   SET DIK="^AUPNPRVT("

                   DO ^DIK

                   KILL AGELP("PH"),ADDCHK

 +22      ;THE KILL OF AGELP("PH") ALLOWS FOR PROPER EXTING FROM PRIVATE SCREEN WHEN DELETING

 +23      ;ENTIRE ENTRY. KILL ADDCHK BECAUSE NOTHING WAS ADDED

               End DoDot:1

 +24       QUIT 

PKILL      SET AGELP("Y")=0

 +1        SET Y=0

 +2        FOR 

               SET Y=$ORDER(AGELP(Y))

               IF '+Y

                   QUIT 

               SET AGEL("Y")=Y

               Begin DoDot:1

 +3                IF AGELP("TYPE")="PI"

                       Begin DoDot:2

 +4                        SET DA(1)=AGEL("Y")

 +5                        SET DIK="^AUPNPRVT("_DA(1)_",11,"

 +6                        SET DA=$PIECE(AGELP(AGEL("Y")),U,2)

 +7                        DO ^DIK

                       End DoDot:2

               End DoDot:1

 +8        QUIT