AG5 ; IHS/ASDS/EFG - ENTER MEDICAID DATA ;
;;7.1;PATIENT REGISTRATION;**2**;JAN 31, 2007
;
L1 I AGOPT(4)'="Y" G ^AG6
I $D(^AUPNMCD("AB",DFN)) D Q
. W !!,"Any more MEDICAID COVERAGE? (Y/N) NO// "
. S AG("DFLT")="YES"
. G L2
S AG("DFLT")="NO"
W !!,"Does this patient have MEDICAID COVERAGE? (Y/N) NO// "
L2 D READ^AG
S AG("LT")=$S($E(Y)="Y":"YES",1:"NO")
;TESTING USE OF EDIT SCREEN FOR ADDING INSURANCE TO NEW PATIENT 5/13/2005
I $G(^AGFAC(DUZ(2),"NEWADDINS")) I AG("LT")="YES" S AGPAT=$P($G(^DPT(DFN,0)),U) S AGXTERN=1 D EN^AGEDMCD("","",1,"",XQY0) K AGXTERN G:$G(NEWENTRY)=0 ^AG6 G L1
I $G(^AGFAC(DUZ(2),"NEWADDINS")),$D(DUOUT) G DUOUT^AG4
I $G(^AGFAC(DUZ(2),"NEWADDINS")),($G(AG("LT"))="NO") G ^AG6
;TESTING
Q:$D(DTOUT)!$D(DFOUT)
G DUOUT^AG4:$D(DUOUT)
G STATE:Y?1"Y".E,END:Y?1"N".E!$D(DLOUT)
D YN^AG
G L1
ADDNEW ;EP - Add/Edit MediCAID Client.
STATE ;EP - STATE LOOP
W !!,"Enter the MEDICAID STATE: "
D READ^AG
;I $D(DUOUT)!$D(DFOUT)!$D(DLOUT)!$D(DTOUT)!$D(DQOUT)!$D(DIRUT)!(Y=" ") W !,"This is a required field." G STATE
I $D(DUOUT)!$D(DFOUT)!$D(DLOUT)!$D(DTOUT)!(Y=" ") W !,"This is a required field." G STATE ;AG*7.1*2 PROBLEM REPORTED DURING ALPHA TESTING
I $D(DQOUT) D
. S AG("ST")=0
. W !!,"Enter the Medicaid account state."
. W:$D(^AUPNMCD("AB",DFN)) " The following are on file:"
. F AGZ("I")=1:1 S AG("ST")=$O(^AUPNMCD("AB",DFN,AG("ST"))) G:AG("ST")="" STATE W !,$P(^DIC(5,AG("ST"),0),U)
S X=Y
S DIC=5
S DIC(0)="QEM"
D ^DIC
G STATE:+Y<1
S AG("STATE")=+Y
I $D(AG("STPTR")) S $P(^AUPNMCD(AGELPTR,0),U,4)=+Y
Q:$D(AG("STPTR"))
NUMB W !!,"Enter the MEDICAID NUMBER: "
D READ^AG
I $D(DLOUT) W !,"This is a Required field" G NUMB
I $D(DUOUT)!$D(DTOUT)!$D(DFOUT) W !,"This is a Required field" G NUMB ;AG*7.1*2 REPORTED DURING ALPHA
G ^AGED4A:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
I $D(DQOUT) D
.S I=""
. F AGZ("I")=1:1 S I=$O(^AUPNMCD("AB",DFN,AG("STATE"),I)) Q:I="" W !,I
S (X,AG("NUM"))=Y
X $P(^DD(9000004,.03,0),U,5,99) I '$D(X) W !,^(3) G NUMB
L5 ;
LOCK ^AUPNMCD(0)
S (D,DA)=$P(^AUPNMCD(0),"^",3)
F AGZ("I")=1:1 S D=$O(^AUPNMCD(D)) Q:D=""!(D]"@") S DA=D
K D
S DA=DA+1
S ^AUPNMCD(DA,0)=DFN_U_$O(^AUTNINS("B","MEDICAID",0))
S ^AUPNMCD("B",DFN,DA)=""
S $P(^AUPNMCD(0),U,3)=DA
S $P(^AUPNMCD(0),U,4)=$P(^AUPNMCD(0),U,4)+1
LOCK
S AG("MCD")=DA
S DIE="^AUPNMCD("
S DR=".03///"_AG("NUM")_";.04///"_$P(^DIC(5,AG("STATE"),0),U)
D ^DIE
S AGELPTR=DA
S ADDCHK=""
L6 G MCNM:'$D(^DD(9000004,.05)) W !!,"Enter the NAME OF THE INSURED person.",!,"(Enter SAME if the PATIENT is the primary insured person.)",!!,"? " W:$P(^AUPNMCD(AG("MCD"),0),U,5)]"" " ",$P(^AUPNMCD(AG("MCD"),0),U,5),"// " D READ^AG
I $D(DQOUT) W !!,"Enter the name of the person in whose name the main account is carried.",!,"The name must be in the same format as the patient names.",!!,"If the patient is the primary insured person, enter SAME.",!! G L6
G REL:$D(DLOUT)&($P(^AUPNMCD(AG("MCD"),0),U,5)]""),L6:Y="" I Y="SAME" D SAME G L6:$P(^AUPNMCD(AG("MCD"),0),U,5)="" G MCNM
S DIE("NO^")="",DR=".05///"_Y,DA=AG("MCD"),DIE="^AUPNMCD(" D ^DIE G L6:$P(^AUPNMCD(AG("MCD"),0),U,5)=""
REL ;
S DIC="^AUTTRLSH("
S DIC(0)="QAZEM"
S DIC("A")="Enter PATIENT'S RELATIONSHIP to the insured: "
W !
D ^DIC
G REL:+Y<1
S DA=AG("MCD")
S $P(^AUPNMCD(DA,0),U,6)=+Y
K DIC("S"),DIC("A")
SEX W !
S DIE="^AUPNMCD("
S DA=AG("MCD")
S DR=.07
S DIE("NO^")=""
D ^DIE
MCNM ;
I $P($G(^AUPNMCD(AG("MCD"),21)),U)="" D
. S DR=2101
. D ^DIE
PCP W !
S DIE="^AUPNMCD("
S DA=AG("MCD")
S DR=.14
D ^DIE
GROUP W !
S DIE="^AUPNMCD("
S DA=AG("MCD")
S DR=.17
D ^DIE
CC W !
S DIE="^AUPNMCD("
S DA=AG("MCD")
S DR=.15
D ^DIE
CCD W !
S DIE="^AUPNMCD("
S DA=AG("MCD")
S DR=.16
D ^DIE
I '$D(^AUPNMCD(AG("MCD"),21)) G MCDB
D:$P(^AUPNMCD(AG("MCD"),21),U)]"" SETOTHER G MCDB
SETOTHER ;
Q
MCDB ;
I $P($G(^AUPNMCD(AG("MCD"),21)),U,2)="" D
. S DR=2102
. D ^DIE
. W !
;
K DIC("DR"),DR
S DIE("NO^")=""
S DR="1101R",DIE="^AUPNMCD(",DA=AG("MCD")
D ^DIE
D:$D(AG("EDIT")) UPDATE^AGED5
I '$D(AG("EDIT")) K DR S DR=".08///"_DT,DA=AG("MCD"),DIE="^AUPNMCD(" D ^DIE
K DR
W !
S DR=".11;.12"
D ^DIE
END Q:$D(AG("EDIT"))
K AG G ^AG6
SAME S DR=".05///"_$P(^DPT(DFN,0),U)
S DIE="^AUPNMCD("
D ^DIE
S DR=".07///"_$P(^DPT(DFN,0),U,2)_";.06///SELF"
D ^DIE
S DR="2101///"_$P(^DPT(DFN,0),U)
D ^DIE
S DR="2102///"_$P($G(^DPT(DFN,0)),U,3)
D ^DIE
Q
DUOUT ;EP
G L1:AGOPT(4)="Y",DUOUT^AG4
AG5 ; IHS/ASDS/EFG - ENTER MEDICAID DATA ;
+1 ;;7.1;PATIENT REGISTRATION;**2**;JAN 31, 2007
+2 ;
L1 IF AGOPT(4)'="Y"
GOTO ^AG6
+1 IF $DATA(^AUPNMCD("AB",DFN))
Begin DoDot:1
+2 WRITE !!,"Any more MEDICAID COVERAGE? (Y/N) NO// "
+3 SET AG("DFLT")="YES"
+4 GOTO L2
End DoDot:1
QUIT
+5 SET AG("DFLT")="NO"
+6 WRITE !!,"Does this patient have MEDICAID COVERAGE? (Y/N) NO// "
L2 DO READ^AG
+1 SET AG("LT")=$SELECT($EXTRACT(Y)="Y":"YES",1:"NO")
+2 ;TESTING USE OF EDIT SCREEN FOR ADDING INSURANCE TO NEW PATIENT 5/13/2005
+3 IF $GET(^AGFAC(DUZ(2),"NEWADDINS"))
IF AG("LT")="YES"
SET AGPAT=$PIECE($GET(^DPT(DFN,0)),U)
SET AGXTERN=1
DO EN^AGEDMCD("","",1,"",XQY0)
KILL AGXTERN
IF $GET(NEWENTRY)=0
GOTO ^AG6
GOTO L1
+4 IF $GET(^AGFAC(DUZ(2),"NEWADDINS"))
IF $DATA(DUOUT)
GOTO DUOUT^AG4
+5 IF $GET(^AGFAC(DUZ(2),"NEWADDINS"))
IF ($GET(AG("LT"))="NO")
GOTO ^AG6
+6 ;TESTING
+7 IF $DATA(DTOUT)!$DATA(DFOUT)
QUIT
+8 IF $DATA(DUOUT)
GOTO DUOUT^AG4
+9 IF Y?1"Y".E
GOTO STATE
IF Y?1"N".E!$DATA(DLOUT)
GOTO END
+10 DO YN^AG
+11 GOTO L1
ADDNEW ;EP - Add/Edit MediCAID Client.
STATE ;EP - STATE LOOP
+1 WRITE !!,"Enter the MEDICAID STATE: "
+2 DO READ^AG
+3 ;I $D(DUOUT)!$D(DFOUT)!$D(DLOUT)!$D(DTOUT)!$D(DQOUT)!$D(DIRUT)!(Y=" ") W !,"This is a required field." G STATE
+4 ;AG*7.1*2 PROBLEM REPORTED DURING ALPHA TESTING
IF $DATA(DUOUT)!$DATA(DFOUT)!$DATA(DLOUT)!$DATA(DTOUT)!(Y=" ")
WRITE !,"This is a required field."
GOTO STATE
+5 IF $DATA(DQOUT)
Begin DoDot:1
+6 SET AG("ST")=0
+7 WRITE !!,"Enter the Medicaid account state."
+8 IF $DATA(^AUPNMCD("AB",DFN))
WRITE " The following are on file:"
+9 FOR AGZ("I")=1:1
SET AG("ST")=$ORDER(^AUPNMCD("AB",DFN,AG("ST")))
IF AG("ST")=""
GOTO STATE
WRITE !,$PIECE(^DIC(5,AG("ST"),0),U)
End DoDot:1
+10 SET X=Y
+11 SET DIC=5
+12 SET DIC(0)="QEM"
+13 DO ^DIC
+14 IF +Y<1
GOTO STATE
+15 SET AG("STATE")=+Y
+16 IF $DATA(AG("STPTR"))
SET $PIECE(^AUPNMCD(AGELPTR,0),U,4)=+Y
+17 IF $DATA(AG("STPTR"))
QUIT
NUMB WRITE !!,"Enter the MEDICAID NUMBER: "
+1 DO READ^AG
+2 IF $DATA(DLOUT)
WRITE !,"This is a Required field"
GOTO NUMB
+3 ;AG*7.1*2 REPORTED DURING ALPHA
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
WRITE !,"This is a Required field"
GOTO NUMB
+4 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
GOTO ^AGED4A
+5 IF $DATA(DQOUT)
Begin DoDot:1
+6 SET I=""
+7 FOR AGZ("I")=1:1
SET I=$ORDER(^AUPNMCD("AB",DFN,AG("STATE"),I))
IF I=""
QUIT
WRITE !,I
End DoDot:1
+8 SET (X,AG("NUM"))=Y
+9 XECUTE $PIECE(^DD(9000004,.03,0),U,5,99)
IF '$DATA(X)
WRITE !,^(3)
GOTO NUMB
L5 ;
+1 LOCK ^AUPNMCD(0)
+2 SET (D,DA)=$PIECE(^AUPNMCD(0),"^",3)
+3 FOR AGZ("I")=1:1
SET D=$ORDER(^AUPNMCD(D))
IF D=""!(D]"@")
QUIT
SET DA=D
+4 KILL D
+5 SET DA=DA+1
+6 SET ^AUPNMCD(DA,0)=DFN_U_$ORDER(^AUTNINS("B","MEDICAID",0))
+7 SET ^AUPNMCD("B",DFN,DA)=""
+8 SET $PIECE(^AUPNMCD(0),U,3)=DA
+9 SET $PIECE(^AUPNMCD(0),U,4)=$PIECE(^AUPNMCD(0),U,4)+1
+10 LOCK
+11 SET AG("MCD")=DA
+12 SET DIE="^AUPNMCD("
+13 SET DR=".03///"_AG("NUM")_";.04///"_$PIECE(^DIC(5,AG("STATE"),0),U)
+14 DO ^DIE
+15 SET AGELPTR=DA
+16 SET ADDCHK=""
L6 IF '$DATA(^DD(9000004,.05))
GOTO MCNM
WRITE !!,"Enter the NAME OF THE INSURED person.",!,"(Enter SAME if the PATIENT is the primary insured person.)",!!,"? "
IF $PIECE(^AUPNMCD(AG("MCD"),0),U,5)]""
WRITE " ",$PIECE(^AUPNMCD(AG("MCD"),0),U,5),"// "
DO READ^AG
+1 IF $DATA(DQOUT)
WRITE !!,"Enter the name of the person in whose name the main account is carried.",!,"The name must be in the same format as the patient names.",!!,"If the patient is the primary insured person, enter SAME.",!!
GOTO L6
+2 IF $DATA(DLOUT)&($PIECE(^AUPNMCD(AG("MCD"),0),U,5)]"")
GOTO REL
IF Y=""
GOTO L6
IF Y="SAME"
DO SAME
IF $PIECE(^AUPNMCD(AG("MCD"),0),U,5)=""
GOTO L6
GOTO MCNM
+3 SET DIE("NO^")=""
SET DR=".05///"_Y
SET DA=AG("MCD")
SET DIE="^AUPNMCD("
DO ^DIE
IF $PIECE(^AUPNMCD(AG("MCD"),0),U,5)=""
GOTO L6
REL ;
+1 SET DIC="^AUTTRLSH("
+2 SET DIC(0)="QAZEM"
+3 SET DIC("A")="Enter PATIENT'S RELATIONSHIP to the insured: "
+4 WRITE !
+5 DO ^DIC
+6 IF +Y<1
GOTO REL
+7 SET DA=AG("MCD")
+8 SET $PIECE(^AUPNMCD(DA,0),U,6)=+Y
+9 KILL DIC("S"),DIC("A")
SEX WRITE !
+1 SET DIE="^AUPNMCD("
+2 SET DA=AG("MCD")
+3 SET DR=.07
+4 SET DIE("NO^")=""
+5 DO ^DIE
MCNM ;
+1 IF $PIECE($GET(^AUPNMCD(AG("MCD"),21)),U)=""
Begin DoDot:1
+2 SET DR=2101
+3 DO ^DIE
End DoDot:1
PCP WRITE !
+1 SET DIE="^AUPNMCD("
+2 SET DA=AG("MCD")
+3 SET DR=.14
+4 DO ^DIE
GROUP WRITE !
+1 SET DIE="^AUPNMCD("
+2 SET DA=AG("MCD")
+3 SET DR=.17
+4 DO ^DIE
CC WRITE !
+1 SET DIE="^AUPNMCD("
+2 SET DA=AG("MCD")
+3 SET DR=.15
+4 DO ^DIE
CCD WRITE !
+1 SET DIE="^AUPNMCD("
+2 SET DA=AG("MCD")
+3 SET DR=.16
+4 DO ^DIE
+5 IF '$DATA(^AUPNMCD(AG("MCD"),21))
GOTO MCDB
+6 IF $PIECE(^AUPNMCD(AG("MCD"),21),U)]""
DO SETOTHER
GOTO MCDB
SETOTHER ;
+1 QUIT
MCDB ;
+1 IF $PIECE($GET(^AUPNMCD(AG("MCD"),21)),U,2)=""
Begin DoDot:1
+2 SET DR=2102
+3 DO ^DIE
+4 WRITE !
End DoDot:1
+5 ;
+6 KILL DIC("DR"),DR
+7 SET DIE("NO^")=""
+8 SET DR="1101R"
SET DIE="^AUPNMCD("
SET DA=AG("MCD")
+9 DO ^DIE
+10 IF $DATA(AG("EDIT"))
DO UPDATE^AGED5
+11 IF '$DATA(AG("EDIT"))
KILL DR
SET DR=".08///"_DT
SET DA=AG("MCD")
SET DIE="^AUPNMCD("
DO ^DIE
+12 KILL DR
+13 WRITE !
+14 SET DR=".11;.12"
+15 DO ^DIE
END IF $DATA(AG("EDIT"))
QUIT
+1 KILL AG
GOTO ^AG6
SAME SET DR=".05///"_$PIECE(^DPT(DFN,0),U)
+1 SET DIE="^AUPNMCD("
+2 DO ^DIE
+3 SET DR=".07///"_$PIECE(^DPT(DFN,0),U,2)_";.06///SELF"
+4 DO ^DIE
+5 SET DR="2101///"_$PIECE(^DPT(DFN,0),U)
+6 DO ^DIE
+7 SET DR="2102///"_$PIECE($GET(^DPT(DFN,0)),U,3)
+8 DO ^DIE
+9 QUIT
DUOUT ;EP
+1 IF AGOPT(4)="Y"
GOTO L1
GOTO DUOUT^AG4
