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
