AGBIC2P ; IHS/ASDS/EFG - ENTRY UTILITY FOR MANDATORY DATA ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
L1 D S1,^AG1 G K^AG0:$D(DFOUT)!$D(DTOUT),UP:$D(DUOUT)
I $D(AG("TEMP CHART")) D S1,DOB^AG2A Q
L4 D S1,^AGBIC2B G L1:$D(DUOUT)!$D(DTOUT),K^AG0:$D(DFOUT) I $P(^AUPNPAT(DFN,11),U,21)'="Y"&($P(^(11),U,22)'="Y") D CKMNRRES G L4:$D(DUOUT),K^AG0:$D(DFOUT)!$D(DTOUT)
L5 D S1,TRIBE^AG2A G L4:$D(DUOUT),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
S AG("TRIBE")=$S($P(^AUPNPAT(DFN,11),U,8)="":"N",1:"Y") I $P(^(11),U,8)]"" I $P(^AUTTTRI($P(^AUPNPAT(DFN,11),U,8),0),U,2)="000"!($P(^AUTTTRI($P(^AUPNPAT(DFN,11),U,8),0),U,2)>"979") S AG("TRIBE")="N"
I AG("TRIBE")="N" D CKMNRTRB G L5:$D(DUOUT),K^AG0:$D(DFOUT)!$D(DTOUT) D TRBFLG^AG2A G L5B
TRBVER S AG("TRBVER")=" " S:$D(^AUPNPAT(DFN,11)) AG("TRBVER")=$P(^AUPNPAT(DFN,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") G L5:$D(DUOUT) I (Y'["Y")&(Y'["N")&(Y'["U") W !!,"Enter a ""Y"" for YES or an ""N"" for NO OR A ""U"" for UNABLE." G TRBVER
S:Y["N" AG("TRIBE")="N"
SETRBFLG D S1,TRBFLG^AG2A I AG("TRIBE")'="Y" D CKMNRTRB G TRBVER:$D(DUOUT) G:$D(DFOUT)!$D(DTOUT) K^AG0 D TRBFLG^AG2A
L5B D S1,IQTM^AG2A G L5:$D(DUOUT),K^AG0:$D(DFOUT)!$D(DTOUT)
L5ELIG D S1,^AGBIC2C,CALCELIG^AGBIC2
L5AOPT I AGOPT(2)="Y" D S1,TRINUM^AGOPT2 G L5:$D(DUOUT) I 1
E G L5:$D(DUOUT)
L5OPT I AGOPT(1)="Y" D S1,TQTM^AGOPT2 G L5AOPT:$D(DUOUT) I 1
E G L5AOPT:$D(DUOUT)
L6OPT I AGOPT(8)="Y" D S1,OTHRTR^AGOPT2 G L5OPT:$D(DUOUT) I 1
E G L5OPT:$D(DUOUT)
L7 D S1,BEN^AG2A G L6OPT:$D(DUOUT),K^AG0:$D(DFOUT)!$D(DTOUT)
L8 D S1,ELIG^AG2A G L7:$D(DUOUT),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,DFN^AGKPAT
G L1^AG0
CKMNRRES S DA=DFN,DIC=9000001,DR=1102.99 D ^AGDICLK I $D(AG("LKPRINT")) S Y="N" D:AG("LKPRINT")<18 ASKMNRES
S:Y="N" Y="" S:Y="Y" Y="C" Q:Y=""
S:$P(^AUPNPAT(DFN,11),U,25)="T" Y="B"
S DA=DFN,DR="1125///"_Y,DIE="^AUPNPAT(" D ^DIE
Q
ASKMNRES W *7,!!,"IS EITHER PARENT ELIGIBLE FOR ""CHS"" OR ""DIRECT"" CARE? (Y/N) N// " D READ^AG S:$D(DLOUT) Y="N" I '$D(DUOUT)&'$D(DFOUT)&'$D(DTOUT)&(Y'["Y")&(Y'["N") D YN^AG G ASKMNRES
Q
CKMNRTRB S AG("MINOR")="" S DA=DFN,DIC=9000001,DR=1102.99 D ^AGDICLK S Y="N" I $D(AG("LKPRINT")) D:AG("LKPRINT")<18 ASKMNRTB
S:Y="N" Y="" S:Y="Y" Y="T" Q:Y=""
S:$P(^AUPNPAT(DFN,11),U,25)="C" Y="B"
S DA=DFN,DR="1125///"_Y,DIE="^AUPNPAT(" D ^DIE
Q
ASKMNRTB W *7,!!,"IS EITHER PARENT A MEMBER OF A RECOGNIZED TRIBE? (Y/N) N// " D READ^AG S:$D(DLOUT) Y="N" I '$D(DUOUT)&'$D(DFOUT)&'$D(DTOUT)&(Y'["Y")&(Y'["N") D YN^AG G ASKMNRTB
Q
AGBIC2P ; IHS/ASDS/EFG - ENTRY UTILITY FOR MANDATORY DATA ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
L1 DO S1
DO ^AG1
IF $DATA(DFOUT)!$DATA(DTOUT)
GOTO K^AG0
IF $DATA(DUOUT)
GOTO UP
+1 IF $DATA(AG("TEMP CHART"))
DO S1
DO DOB^AG2A
QUIT
L4 DO S1
DO ^AGBIC2B
IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO L1
IF $DATA(DFOUT)
GOTO K^AG0
IF $PIECE(^AUPNPAT(DFN,11),U,21)'="Y"&($PIECE(^(11),U,22)'="Y")
DO CKMNRRES
IF $DATA(DUOUT)
GOTO L4
IF $DATA(DFOUT)!$DATA(DTOUT)
GOTO K^AG0
L5 DO S1
DO TRIBE^AG2A
IF $DATA(DUOUT)
GOTO L4
IF $DATA(DFOUT)!$DATA(DTOUT)
GOTO K^AG0
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
+1 SET AG("TRIBE")=$SELECT($PIECE(^AUPNPAT(DFN,11),U,8)="":"N",1:"Y")
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"
+2 IF AG("TRIBE")="N"
DO CKMNRTRB
IF $DATA(DUOUT)
GOTO L5
IF $DATA(DFOUT)!$DATA(DTOUT)
GOTO K^AG0
DO TRBFLG^AG2A
GOTO L5B
TRBVER SET AG("TRBVER")=" "
IF $DATA(^AUPNPAT(DFN,11))
SET AG("TRBVER")=$PIECE(^AUPNPAT(DFN,11),U,19)
+1 WRITE !!,"HAS TRIBAL MEMBERSHIP BEEN VERIFIED? (Y/N/U): "
IF (AG("TRBVER")["Y")!(AG("TRBVER")["N")!(AG("TRBVER")["U")
WRITE AG("TRBVER")_" // "
SET Y=AG("TRBVER")
DO READ^AG
+2 IF $DATA(DLOUT)&(AG("TRBVER")'=" ")
SET Y=AG("TRBVER")
IF $DATA(DUOUT)
GOTO L5
IF (Y'["Y")&(Y'["N")&(Y'["U")
WRITE !!,"Enter a ""Y"" for YES or an ""N"" for NO OR A ""U"" for UNABLE."
GOTO TRBVER
+3 IF Y["N"
SET AG("TRIBE")="N"
SETRBFLG DO S1
DO TRBFLG^AG2A
IF AG("TRIBE")'="Y"
DO CKMNRTRB
IF $DATA(DUOUT)
GOTO TRBVER
IF $DATA(DFOUT)!$DATA(DTOUT)
GOTO K^AG0
DO TRBFLG^AG2A
L5B DO S1
DO IQTM^AG2A
IF $DATA(DUOUT)
GOTO L5
IF $DATA(DFOUT)!$DATA(DTOUT)
GOTO K^AG0
L5ELIG DO S1
DO ^AGBIC2C
DO CALCELIG^AGBIC2
L5AOPT IF AGOPT(2)="Y"
DO S1
DO TRINUM^AGOPT2
IF $DATA(DUOUT)
GOTO L5
IF 1
+1 IF '$TEST
IF $DATA(DUOUT)
GOTO L5
L5OPT IF AGOPT(1)="Y"
DO S1
DO TQTM^AGOPT2
IF $DATA(DUOUT)
GOTO L5AOPT
IF 1
+1 IF '$TEST
IF $DATA(DUOUT)
GOTO L5AOPT
L6OPT IF AGOPT(8)="Y"
DO S1
DO OTHRTR^AGOPT2
IF $DATA(DUOUT)
GOTO L5OPT
IF 1
+1 IF '$TEST
IF $DATA(DUOUT)
GOTO L5OPT
L7 DO S1
DO BEN^AG2A
IF $DATA(DUOUT)
GOTO L6OPT
IF $DATA(DFOUT)!$DATA(DTOUT)
GOTO K^AG0
L8 DO S1
DO ELIG^AG2A
IF $DATA(DUOUT)
GOTO L7
IF $DATA(DFOUT)!$DATA(DTOUT)
GOTO K^AG0
END KILL AG
+1 GOTO ^AG3
S1 KILL DFOUT,DTOUT,DUOUT,DLOUT,DQOUT
+1 QUIT
UP SET AG("EDIT")=""
WRITE !!,*7,*7,"Deleting Patient ",$PIECE(^DPT(DFN,0),U)," ...."
DO Z1^AGKPAT
DO DFN^AGKPAT
+1 GOTO L1^AG0
CKMNRRES SET DA=DFN
SET DIC=9000001
SET DR=1102.99
DO ^AGDICLK
IF $DATA(AG("LKPRINT"))
SET Y="N"
IF AG("LKPRINT")<18
DO ASKMNRES
+1 IF Y="N"
SET Y=""
IF Y="Y"
SET Y="C"
IF Y=""
QUIT
+2 IF $PIECE(^AUPNPAT(DFN,11),U,25)="T"
SET Y="B"
+3 SET DA=DFN
SET DR="1125///"_Y
SET DIE="^AUPNPAT("
DO ^DIE
+4 QUIT
ASKMNRES WRITE *7,!!,"IS EITHER PARENT ELIGIBLE FOR ""CHS"" OR ""DIRECT"" CARE? (Y/N) N// "
DO READ^AG
IF $DATA(DLOUT)
SET Y="N"
IF '$DATA(DUOUT)&'$DATA(DFOUT)&'$DATA(DTOUT)&(Y'["Y")&(Y'["N")
DO YN^AG
GOTO ASKMNRES
+1 QUIT
CKMNRTRB SET AG("MINOR")=""
SET DA=DFN
SET DIC=9000001
SET DR=1102.99
DO ^AGDICLK
SET Y="N"
IF $DATA(AG("LKPRINT"))
IF AG("LKPRINT")<18
DO ASKMNRTB
+1 IF Y="N"
SET Y=""
IF Y="Y"
SET Y="T"
IF Y=""
QUIT
+2 IF $PIECE(^AUPNPAT(DFN,11),U,25)="C"
SET Y="B"
+3 SET DA=DFN
SET DR="1125///"_Y
SET DIE="^AUPNPAT("
DO ^DIE
+4 QUIT
ASKMNRTB WRITE *7,!!,"IS EITHER PARENT A MEMBER OF A RECOGNIZED TRIBE? (Y/N) N// "
DO READ^AG
IF $DATA(DLOUT)
SET Y="N"
IF '$DATA(DUOUT)&'$DATA(DFOUT)&'$DATA(DTOUT)&(Y'["Y")&(Y'["N")
DO YN^AG
GOTO ASKMNRTB
+1 QUIT
