- 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
