AGBIC2 ; IHS/ASDS/EFG - ENTRY UTILITY FOR MANDATORY DATA ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
L1 ;
D S1
D ^AG1
G K^AG0:$D(DFOUT)!$D(DTOUT)
G UP:$D(DUOUT)
I $D(DOG) G:'$D(AG("TEMP CHART")) K^AG0
I $D(AG("TEMP CHART")) D Q
. D S1
. D DOB^AG2A
L4 ;
D S1
D ^AGBIC2B
G L1:$D(DUOUT)!$D(DTOUT)
G K^AG0:$D(DFOUT)
D CMMNR
L5 ;
D S1
D TRIBE^AG2A
G L4:$D(DUOUT)
G K^AG0:$D(DFOUT)!$D(DTOUT)
I $D(^AUPNPAT(DFN,11)),$P(^(11),U,8)]"",$P(^AUTTTRI($P(^AUPNPAT(DFN,11),U,8),0),U,4)="Y" W !,"That TRIBE no longer valid" G L5
D S1
D IQTM^AG2A
G L5:$D(DUOUT)
G K^AG0:$D(DFOUT)!$D(DTOUT)
L5ELIG ;
D S1
D ^AGBIC2C
D CALCELIG
W *7,!!?15,"This patient's eligibility has been computed to be "
W !?80-$L(AG("NARR1"))/2,AG("NARR1")
W !!,"If you wish to have the eligibility recomputed you may reenter the Community,"
W !,"Tribe, and/or Indian Quantum by entering ""^"" at this time. "
D S1
D READ^AG
G K^AG0:$D(DFOUT)!$D(DTOUT)
G L4:$D(DUOUT)
L5AOPT ;
I AGOPT(2)="Y" D G L5:$D(DUOUT) I 1
. D S1
. D TRINUM^AGOPT2
E G L5:$D(DUOUT)
L5OPT ;
I AGOPT(1)="Y" D G L5AOPT:$D(DUOUT) I 1
. D S1
. D TQTM^AGOPT2
E G L5AOPT:$D(DUOUT)
L6OPT ;
I AGOPT(8)="Y" D G L5OPT:$D(DUOUT) I 1
. D S1
. D OTHRTR^AGOPT2
E G L5OPT:$D(DUOUT)
L7 ;
D S1
D BEN^AG2A
G L6OPT:$D(DUOUT)
G K^AG0:$D(DFOUT)!$D(DTOUT)
END ;
K AG
G ^AG3
S1 ;
K DFOUT,DTOUT,DUOUT,DLOUT,DQOUT
Q
UP ;
S AG("EDIT")=""
W !!,*7,*7,"Deleting Patient ",$P(^DPT(DFN,0),U)," ...."
D Z1^AGKPAT
D DFN^AGKPAT
G L1^AG0
CKMINOR ;
S DA=DFN
S DIC=9000001
S DR=1102.99
D ^AGDICLK
S Y="N"
I $D(AG("LKPRINT")) D G L5:$D(DUOUT),K^AG0:$D(DFOUT)!$D(DTOUT)
. D:AG("LKPRINT")<18 ASKMINOR
I Y="T" S Y="B"
Q
ASKMINOR ;
W *7,!!,"IS THIS THE MINOR CHILD OF A TRIBAL MEMBER? (Y/N) // "
D READ^AG
I (Y'["Y")&(Y'["N") D G ASKMINOR
. D YN^AG
Q
CALCELIG ;EP
S AG("ELG")=$P(^AUPNPAT(DFN,11),U,24)
S AG("NARR1")=$S(AG("ELG")'="":$P(^AUTTBICE(AG("ELG"),0),U),1:"")
Q
SETMINOR ;
G:Y'="Y" QUITMNR
S Y=$S($P(^AUPNPAT(DFN,11),U,25)="C":"B",1:"T")
Q
QUITMNR ;
S Y=$S($P(^AUPNPAT(DFN,11),U,25)="C":"C",$P(^(11),U,25)="B":"C",1:"N")
Q
CKMNRES ;
S DA=DFN
S DIC=9000001
S DR=1102.99
D ^DIC
S Y="N"
I $D(AG("LKPRINT")) D G L4:$D(DUOUT),K^AG0:$D(DFOUT)!$D(DTOUT)
. D:AG("LKPRINT")<18 ASKMNRES
Q
ASKMNRES ;
W *7,!!,"IS EITHER PARENT ELIGIBLE FOR DIRECT OR CHS CARE? (Y/N) // "
D READ^AG
I (Y'["Y")&(Y'["N") D G ASKMNRES
. D YN^AG
Q
SETMNRES ;
G:Y'="Y" QUITRES
I $P(^AUPNPAT(DFN,11),U,25)="T" S Y="B" Q
S Y="C"
Q
QUITRES ;
S Y=$S($P(^AUPNPAT(DFN,11),U,25)="T":"T",$P(^(11),U,25)="B":"T",1:"N")
Q
CMMNR ;EP
I $P(^AUPNPAT(DFN,11),U,21)'="Y"&($P(^(11),U,22)'="Y") D Q
. D CKMNRES
. D SETMNRES
. S DA=DFN
. S DR="1125///"_Y
. S DIE="^AUPNPAT("
. D ^DIE
. D S1
Q
TRBMNR ;EP
S AG("TRIBE")="Y"
I $D(^AUPNPAT(DFN,11)),$P(^(11),U,8)]"" S:$P(^AUTTTRI($P(^AUPNPAT(DFN,11),U,8),0),U,2)="000"!($P(^AUTTTRI($P(^AUPNPAT(DFN,11),U,8),0),U,2)>"979") AG("TRIBE")="N"
I AG("TRIBE")="N" D Q
. D CKMINOR
. D SETMINOR
. S DA=DFN
. S DR="1125///"_Y
. S DIE="^AUPNPAT("
. D ^DIE
. D S1
. D TRBFLG^AG2A
Q
TRBVER ;
Q:$D(DUOUT)
S AG("TRBVER")=" "
S:$D(^AUPNPAT(DFN,11)) AG("TRBVER")=$P(^(11),U,19)
W !!,"HAS TRIBAL MEMBERSHIP BEEN VERIFIED? (Y/N/U): "
W:(AG("TRBVER")["Y")!(AG("TRBVER")["N")!(AG("TRBVER")["U") AG("TRBVER")_" // "
S Y=AG("TRBVER")
D READ^AG
S:$D(DLOUT)&(AG("TRBVER")'=" ") Y=AG("TRBVER")
I (Y'["Y")&(Y'["N")&(Y'["U") D G TRBVER
.W !!,"Enter a ""Y"" for YES or an ""N"" for NO OR A ""U"" for UNABLE."
S AG("TRIBE")=Y
SETRBFLG ;
D S1
D TRBFLG^AG2A
I AG("TRIBE")'="Y" D Q
. D CKMINOR
. D SETMINOR
. S DA=DFN
. S DR="1125///"_Y
. S DIE="^AUPNPAT("
. D ^DIE
. D S1
. D TRBFLG^AG2A
Q
AGBIC2 ; IHS/ASDS/EFG - ENTRY UTILITY FOR MANDATORY DATA ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
L1 ;
+1 DO S1
+2 DO ^AG1
+3 IF $DATA(DFOUT)!$DATA(DTOUT)
GOTO K^AG0
+4 IF $DATA(DUOUT)
GOTO UP
+5 IF $DATA(DOG)
IF '$DATA(AG("TEMP CHART"))
GOTO K^AG0
+6 IF $DATA(AG("TEMP CHART"))
Begin DoDot:1
+7 DO S1
+8 DO DOB^AG2A
End DoDot:1
QUIT
L4 ;
+1 DO S1
+2 DO ^AGBIC2B
+3 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO L1
+4 IF $DATA(DFOUT)
GOTO K^AG0
+5 DO CMMNR
L5 ;
+1 DO S1
+2 DO TRIBE^AG2A
+3 IF $DATA(DUOUT)
GOTO L4
+4 IF $DATA(DFOUT)!$DATA(DTOUT)
GOTO K^AG0
+5 IF $DATA(^AUPNPAT(DFN,11))
IF $PIECE(^(11),U,8)]""
IF $PIECE(^AUTTTRI($PIECE(^AUPNPAT(DFN,11),U,8),0),U,4)="Y"
WRITE !,"That TRIBE no longer valid"
GOTO L5
+6 DO S1
+7 DO IQTM^AG2A
+8 IF $DATA(DUOUT)
GOTO L5
+9 IF $DATA(DFOUT)!$DATA(DTOUT)
GOTO K^AG0
L5ELIG ;
+1 DO S1
+2 DO ^AGBIC2C
+3 DO CALCELIG
+4 WRITE *7,!!?15,"This patient's eligibility has been computed to be "
+5 WRITE !?80-$LENGTH(AG("NARR1"))/2,AG("NARR1")
+6 WRITE !!,"If you wish to have the eligibility recomputed you may reenter the Community,"
+7 WRITE !,"Tribe, and/or Indian Quantum by entering ""^"" at this time. "
+8 DO S1
+9 DO READ^AG
+10 IF $DATA(DFOUT)!$DATA(DTOUT)
GOTO K^AG0
+11 IF $DATA(DUOUT)
GOTO L4
L5AOPT ;
+1 IF AGOPT(2)="Y"
Begin DoDot:1
+2 DO S1
+3 DO TRINUM^AGOPT2
End DoDot:1
IF $DATA(DUOUT)
GOTO L5
IF 1
+4 IF '$TEST
IF $DATA(DUOUT)
GOTO L5
L5OPT ;
+1 IF AGOPT(1)="Y"
Begin DoDot:1
+2 DO S1
+3 DO TQTM^AGOPT2
End DoDot:1
IF $DATA(DUOUT)
GOTO L5AOPT
IF 1
+4 IF '$TEST
IF $DATA(DUOUT)
GOTO L5AOPT
L6OPT ;
+1 IF AGOPT(8)="Y"
Begin DoDot:1
+2 DO S1
+3 DO OTHRTR^AGOPT2
End DoDot:1
IF $DATA(DUOUT)
GOTO L5OPT
IF 1
+4 IF '$TEST
IF $DATA(DUOUT)
GOTO L5OPT
L7 ;
+1 DO S1
+2 DO BEN^AG2A
+3 IF $DATA(DUOUT)
GOTO L6OPT
+4 IF $DATA(DFOUT)!$DATA(DTOUT)
GOTO K^AG0
END ;
+1 KILL AG
+2 GOTO ^AG3
S1 ;
+1 KILL DFOUT,DTOUT,DUOUT,DLOUT,DQOUT
+2 QUIT
UP ;
+1 SET AG("EDIT")=""
+2 WRITE !!,*7,*7,"Deleting Patient ",$PIECE(^DPT(DFN,0),U)," ...."
+3 DO Z1^AGKPAT
+4 DO DFN^AGKPAT
+5 GOTO L1^AG0
CKMINOR ;
+1 SET DA=DFN
+2 SET DIC=9000001
+3 SET DR=1102.99
+4 DO ^AGDICLK
+5 SET Y="N"
+6 IF $DATA(AG("LKPRINT"))
Begin DoDot:1
+7 IF AG("LKPRINT")<18
DO ASKMINOR
End DoDot:1
IF $DATA(DUOUT)
GOTO L5
IF $DATA(DFOUT)!$DATA(DTOUT)
GOTO K^AG0
+8 IF Y="T"
SET Y="B"
+9 QUIT
ASKMINOR ;
+1 WRITE *7,!!,"IS THIS THE MINOR CHILD OF A TRIBAL MEMBER? (Y/N) // "
+2 DO READ^AG
+3 IF (Y'["Y")&(Y'["N")
Begin DoDot:1
+4 DO YN^AG
End DoDot:1
GOTO ASKMINOR
+5 QUIT
CALCELIG ;EP
+1 SET AG("ELG")=$PIECE(^AUPNPAT(DFN,11),U,24)
+2 SET AG("NARR1")=$SELECT(AG("ELG")'="":$PIECE(^AUTTBICE(AG("ELG"),0),U),1:"")
+3 QUIT
SETMINOR ;
+1 IF Y'="Y"
GOTO QUITMNR
+2 SET Y=$SELECT($PIECE(^AUPNPAT(DFN,11),U,25)="C":"B",1:"T")
+3 QUIT
QUITMNR ;
+1 SET Y=$SELECT($PIECE(^AUPNPAT(DFN,11),U,25)="C":"C",$PIECE(^(11),U,25)="B":"C",1:"N")
+2 QUIT
CKMNRES ;
+1 SET DA=DFN
+2 SET DIC=9000001
+3 SET DR=1102.99
+4 DO ^DIC
+5 SET Y="N"
+6 IF $DATA(AG("LKPRINT"))
Begin DoDot:1
+7 IF AG("LKPRINT")<18
DO ASKMNRES
End DoDot:1
IF $DATA(DUOUT)
GOTO L4
IF $DATA(DFOUT)!$DATA(DTOUT)
GOTO K^AG0
+8 QUIT
ASKMNRES ;
+1 WRITE *7,!!,"IS EITHER PARENT ELIGIBLE FOR DIRECT OR CHS CARE? (Y/N) // "
+2 DO READ^AG
+3 IF (Y'["Y")&(Y'["N")
Begin DoDot:1
+4 DO YN^AG
End DoDot:1
GOTO ASKMNRES
+5 QUIT
SETMNRES ;
+1 IF Y'="Y"
GOTO QUITRES
+2 IF $PIECE(^AUPNPAT(DFN,11),U,25)="T"
SET Y="B"
QUIT
+3 SET Y="C"
+4 QUIT
QUITRES ;
+1 SET Y=$SELECT($PIECE(^AUPNPAT(DFN,11),U,25)="T":"T",$PIECE(^(11),U,25)="B":"T",1:"N")
+2 QUIT
CMMNR ;EP
+1 IF $PIECE(^AUPNPAT(DFN,11),U,21)'="Y"&($PIECE(^(11),U,22)'="Y")
Begin DoDot:1
+2 DO CKMNRES
+3 DO SETMNRES
+4 SET DA=DFN
+5 SET DR="1125///"_Y
+6 SET DIE="^AUPNPAT("
+7 DO ^DIE
+8 DO S1
End DoDot:1
QUIT
+9 QUIT
TRBMNR ;EP
+1 SET AG("TRIBE")="Y"
+2 IF $DATA(^AUPNPAT(DFN,11))
IF $PIECE(^(11),U,8)]""
IF $PIECE(^AUTTTRI($PIECE(^AUPNPAT(DFN,11),U,8),0),U,2)="000"!($PIECE(^AUTTTRI($PIECE(^AUPNPAT(DFN,11),U,8),0),U,2)>"979")
SET AG("TRIBE")="N"
+3 IF AG("TRIBE")="N"
Begin DoDot:1
+4 DO CKMINOR
+5 DO SETMINOR
+6 SET DA=DFN
+7 SET DR="1125///"_Y
+8 SET DIE="^AUPNPAT("
+9 DO ^DIE
+10 DO S1
+11 DO TRBFLG^AG2A
End DoDot:1
QUIT
+12 QUIT
TRBVER ;
+1 IF $DATA(DUOUT)
QUIT
+2 SET AG("TRBVER")=" "
+3 IF $DATA(^AUPNPAT(DFN,11))
SET AG("TRBVER")=$PIECE(^(11),U,19)
+4 WRITE !!,"HAS TRIBAL MEMBERSHIP BEEN VERIFIED? (Y/N/U): "
+5 IF (AG("TRBVER")["Y")!(AG("TRBVER")["N")!(AG("TRBVER")["U")
WRITE AG("TRBVER")_" // "
+6 SET Y=AG("TRBVER")
+7 DO READ^AG
+8 IF $DATA(DLOUT)&(AG("TRBVER")'=" ")
SET Y=AG("TRBVER")
+9 IF (Y'["Y")&(Y'["N")&(Y'["U")
Begin DoDot:1
+10 WRITE !!,"Enter a ""Y"" for YES or an ""N"" for NO OR A ""U"" for UNABLE."
End DoDot:1
GOTO TRBVER
+11 SET AG("TRIBE")=Y
SETRBFLG ;
+1 DO S1
+2 DO TRBFLG^AG2A
+3 IF AG("TRIBE")'="Y"
Begin DoDot:1
+4 DO CKMINOR
+5 DO SETMINOR
+6 SET DA=DFN
+7 SET DR="1125///"_Y
+8 SET DIE="^AUPNPAT("
+9 DO ^DIE
+10 DO S1
+11 DO TRBFLG^AG2A
End DoDot:1
QUIT
+12 QUIT
