Routine: AGFIX7A

AGFIX7A ; IHS/ASDS/EFG - FIX MEDICAID ELIGIBLE FILE ;

 ;;7.0;IHS PATIENT REGISTRATION;;MAR 28, 2003

 W !,"IF YOU ARE SURE YOU WANT TO RUN THIS ROUTINE",!!,"PLEASE ENTER AT 'START', I.E. 'D START^AGFIX7A'.",!

START I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y K %DT

 S AGTOTAL=0

MSG S:'$D(DTIME) DTIME=300 W $$S^AGVDF("IOF")

 W !?31,"***   AGFIX7A   ***"

 W !!?5,"THIS REGISTRATION UTILITY READS THRU THE 'B' INDEX OF THE",!!?5,"MEDICAID ELIGIBLE FILE (^AUPNMCD), REMOVES ALL NON-NUMERIC CHARACTERS",!!?5,"FROM THE M'CAID ELIGIBILITY NUMBERS,"

 W !!?5,"AND SETS ^AGPATCH SO THE CORRECTED PATIENTS ARE EXPORTED DURING"

 W !!?5,"THE NEXT REGISTRATION EXPORT.",!!?5,"note:  THE 'AB' INDEX IS KILLED AND REBUILT DURING THE PROCESS",!!!?10,"DO YOU WANT TO CONTINUE? (Y/N)  N // "

 D READ G END:$D(DLOUT)!$D(DUOUT)!$D(DFOUT)!$D(DTOUT)!("Nn"[$E(Y)),MSG:$D(DQOUT)!("Yy"'[$E(Y))

USER W !! S DIC="^VA(200,",DIC("A")="Who are you?",DIC(0)="AEFMNQ" D ^DIC G:+Y<0 END S DUZ=+Y

FACILITY W !! S DIC="^AUTTLOC(",DIC(0)="QAZEM",DIC("A")="Set MEDICAID export for which FACILITY? " D ^DIC K DIC G:+Y<0 END S (DUZ2,DUZ(2))=+Y

QUE W !!,"Do you want to q this process? (Y/N)  Y // " D READ G END:$D(DTOUT)!$D(DFOUT),FACILITY:$D(DUOUT) S Y=$E(Y_"Y") I $D(DQOUT)!("YN"'[Y) W !!,*7,"You can 'q' this process to TaskMan to run at another time.",! G QUE

 I Y="N" G ENTRY

DEV X ^%ZOSF("UCI") S ZTRTN="ENTRY^AGFIX7A",ZTUCI=Y,ZTIO="",ZTDESC="Check MCAID Accounts, non-numerics, for "_$P(^AUTTLOC(DUZ(2),0),U,2)_"." S ZTSAVE=""

 D ^%ZTLOAD G:'$D(ZTSK) QUE W !!,"Task Number = ",ZTSK,!!,"Press RETURN..." R Y:DTIME K AG,AGIO,AGQIO,G,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTUCI D ^%ZISC Q

ENTRY ; EP - TaskMan.

 I '$D(ZTQUEUED) W !! S IOP=ION D ^%ZIS,WAIT^DICD S DX=$X,DY=$Y+1

 S (AGTOTAL,DFN)=0

DFN ;

 S DFN=$O(^AUPNMCD("B",DFN)) G:+DFN<1 END1

 S IEN=0

IEN ;

 S IEN=$O(^AUPNMCD("B",DFN,IEN)) G:+IEN<1 DFN

 I '$D(^AUPNMCD(IEN,0)) K ^AUPNMCD("B",DFN,IEN) G IEN

 S AGST=$P(^AUPNMCD(IEN,0),U,4),AGACCT=$P(^(0),U,3)

 I 'AGST!('$L(AGACCT)) G IEN

 S ^AUPNMCD("AB",DFN,AGST,AGACCT,IEN)=""

 I AGACCT?1N.N G IEN

 S AG("STATE")=$P(^DIC(5,AGST,0),U,2) I AG("STATE")'="NM"&(AG("STATE")'="AZ") G IEN

 S AGNEWNUM="" F I=1:1:$L(AGACCT) I $E(AGACCT,I)?1N S AGNEWNUM=AGNEWNUM_$E(AGACCT,I)

 I '$L(AGNEWNUM) G IEN

 K ^AUPNMCD("AB",DFN,AGST,AGACCT,IEN)

 S $P(^AUPNMCD(IEN,0),U,3)=AGNEWNUM,^AUPNMCD("AB",DFN,AGST,AGNEWNUM,IEN)="",AGTOTAL=AGTOTAL+1

 D NOW^%DTC S AGDTS=%

 S:'$D(^AGPATCH(AGDTS,DUZ(2),DFN)) ^AGPATCH(AGDTS,DUZ(2),DFN)=""

 G IEN

END1 I '$D(ZTQUEUED) W !,AGTOTAL," records changed.",!

 F D=0:0 S D=$O(^AUPNMCD("AB",D)) Q:'D  F S=0:0 S S=$O(^AUPNMCD("AB",D,S)) Q:'S  S A="" F I=0:0 S A=$O(^AUPNMCD("AB",D,S,A)) Q:A=""  F IEN=0:0 S IEN=$O(^AUPNMCD("AB",D,S,A,IEN)) Q:'IEN  I '$D(^AUPNMCD(IEN,0)) K ^AUPNMCD("AB",D,S,A,IEN)

END K %DT,A,AGACCT,AG,D,AGDATE,DFN,DFOUT,DLOUT,DQOUT,DTOUT,DUOUT,DUZ2,DX,DY,IEN,AGNEWNUM,S,AGTOTAL,X,XY,Y,AGST,AGDTS

READ K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT R Y:$S($D(DTIME):DTIME,1:300) I '$T W *7 R Y:5 G READ:Y="." I '$T S (DTOUT,Y)="" Q

 S:Y="/.," (DFOUT,Y)="" S:Y="" DLOUT="" S:Y="^" (DUOUT,Y)="" S:Y?1"?".E!(Y["^") (DQOUT,Y)=""

COMMENT ; This routine is a one-time-only run.

 ; It reads thru the 'B' index of the MEDICAID ELIGIBLE

 ; file (^AUPNMCD) to look for patients who are eligible for MEDICAID,

 ; fix their eligibility numbers if necessary, and

 ; flag them for inclusion with next export.

 ;                                    RPMS/GTH

AGFIX7A   ; IHS/ASDS/EFG - FIX MEDICAID ELIGIBLE FILE ;

 +1       ;;7.0;IHS PATIENT REGISTRATION;;MAR 28, 2003

 +2        WRITE !,"IF YOU ARE SURE YOU WANT TO RUN THIS ROUTINE",!!,"PLEASE ENTER AT 'START', I.E. 'D START^AGFIX7A'.",!

 +3        QUIT

START      IF '$DATA(DT)

               SET %DT=""

               SET X="T"

               DO ^%DT

               SET DT=Y

               KILL %DT

 +1        SET AGTOTAL=0

MSG        IF '$DATA(DTIME)

               SET DTIME=300

           WRITE $$S^AGVDF("IOF")

 +1        WRITE !?31,"***   AGFIX7A   ***"

 +2        WRITE !!?5,"THIS REGISTRATION UTILITY READS THRU THE 'B' INDEX OF THE",!!?5,"MEDICAID ELIGIBLE FILE (^AUPNMCD), REMOVES ALL NON-NUMERIC CHARACTERS",!!?5,"FROM THE M'CAID ELIGIBILITY NUMBERS,"

 +3        WRITE !!?5,"AND SETS ^AGPATCH SO THE CORRECTED PATIENTS ARE EXPORTED DURING"

 +4        WRITE !!?5,"THE NEXT REGISTRATION EXPORT.",!!?5,"note:  THE 'AB' INDEX IS KILLED AND REBUILT DURING THE PROCESS",!!!?10,"DO YOU WANT TO CONTINUE? (Y/N)  N // "

 +5        DO READ

           IF $DATA(DLOUT)!$DATA(DUOUT)!$DATA(DFOUT)!$DATA(DTOUT)!("Nn"[$EXTRACT(Y))

               GOTO END

           IF $DATA(DQOUT)!("Yy"'[$EXTRACT(Y))

               GOTO MSG

USER       WRITE !!

           SET DIC="^VA(200,"

           SET DIC("A")="Who are you?"

           SET DIC(0)="AEFMNQ"

           DO ^DIC

           IF +Y<0

               GOTO END

           SET DUZ=+Y

FACILITY   WRITE !!

           SET DIC="^AUTTLOC("

           SET DIC(0)="QAZEM"

           SET DIC("A")="Set MEDICAID export for which FACILITY? "

           DO ^DIC

           KILL DIC

           IF +Y<0

               GOTO END

           SET (DUZ2,DUZ(2))=+Y

QUE        WRITE !!,"Do you want to q this process? (Y/N)  Y // "

           DO READ

           IF $DATA(DTOUT)!$DATA(DFOUT)

               GOTO END

           IF $DATA(DUOUT)

               GOTO FACILITY

           SET Y=$EXTRACT(Y_"Y")

           IF $DATA(DQOUT)!("YN"'[Y)

               WRITE !!,*7,"You can 'q' this process to TaskMan to run at another time.",!

               GOTO QUE

 +1        IF Y="N"

               GOTO ENTRY

DEV        XECUTE ^%ZOSF("UCI")

           SET ZTRTN="ENTRY^AGFIX7A"

           SET ZTUCI=Y

           SET ZTIO=""

           SET ZTDESC="Check MCAID Accounts, non-numerics, for "_$PIECE(^AUTTLOC(DUZ(2),0),U,2)_"."

           SET ZTSAVE=""

 +1        DO ^%ZTLOAD

           IF '$DATA(ZTSK)

               GOTO QUE

           WRITE !!,"Task Number = ",ZTSK,!!,"Press RETURN..."

           READ Y:DTIME

           KILL AG,AGIO,AGQIO,G,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTUCI

           DO ^%ZISC

           QUIT

ENTRY     ; EP - TaskMan.

 +1        IF '$DATA(ZTQUEUED)

               WRITE !!

               SET IOP=ION

               DO ^%ZIS

               DO WAIT^DICD

               SET DX=$X

               SET DY=$Y+1

 +2        SET (AGTOTAL,DFN)=0

DFN       ;

 +1        SET DFN=$ORDER(^AUPNMCD("B",DFN))

           IF +DFN<1

               GOTO END1

 +2        SET IEN=0

IEN       ;

 +1        SET IEN=$ORDER(^AUPNMCD("B",DFN,IEN))

           IF +IEN<1

               GOTO DFN

 +2        IF '$DATA(^AUPNMCD(IEN,0))

               KILL ^AUPNMCD("B",DFN,IEN)

               GOTO IEN

 +3        SET AGST=$PIECE(^AUPNMCD(IEN,0),U,4)

           SET AGACCT=$PIECE(^(0),U,3)

 +4        IF 'AGST!('$LENGTH(AGACCT))

               GOTO IEN

 +5        SET ^AUPNMCD("AB",DFN,AGST,AGACCT,IEN)=""

 +6        IF AGACCT?1N.N

               GOTO IEN

 +7        SET AG("STATE")=$PIECE(^DIC(5,AGST,0),U,2)

           IF AG("STATE")'="NM"&(AG("STATE")'="AZ")

               GOTO IEN

 +8        SET AGNEWNUM=""

           FOR I=1:1:$LENGTH(AGACCT)

               IF $EXTRACT(AGACCT,I)?1N

                   SET AGNEWNUM=AGNEWNUM_$EXTRACT(AGACCT,I)

 +9        IF '$LENGTH(AGNEWNUM)

               GOTO IEN

 +10       KILL ^AUPNMCD("AB",DFN,AGST,AGACCT,IEN)

 +11       SET $PIECE(^AUPNMCD(IEN,0),U,3)=AGNEWNUM

           SET ^AUPNMCD("AB",DFN,AGST,AGNEWNUM,IEN)=""

           SET AGTOTAL=AGTOTAL+1

 +12       DO NOW^%DTC

           SET AGDTS=%

 +13       IF '$DATA(^AGPATCH(AGDTS,DUZ(2),DFN))

               SET ^AGPATCH(AGDTS,DUZ(2),DFN)=""

 +14       GOTO IEN

END1       IF '$DATA(ZTQUEUED)

               WRITE !,AGTOTAL," records changed.",!

 +1        FOR D=0:0

               SET D=$ORDER(^AUPNMCD("AB",D))

               IF 'D

                   QUIT

               FOR S=0:0

                   SET S=$ORDER(^AUPNMCD("AB",D,S))

                   IF 'S

                       QUIT

                   SET A=""

                   FOR I=0:0

                       SET A=$ORDER(^AUPNMCD("AB",D,S,A))

                       IF A=""

                           QUIT

                       FOR IEN=0:0

                           SET IEN=$ORDER(^AUPNMCD("AB",D,S,A,IEN))

                           IF 'IEN

                               QUIT

                           IF '$DATA(^AUPNMCD(IEN,0))

                               KILL ^AUPNMCD("AB",D,S,A,IEN)

END        KILL %DT,A,AGACCT,AG,D,AGDATE,DFN,DFOUT,DLOUT,DQOUT,DTOUT,DUOUT,DUZ2,DX,DY,IEN,AGNEWNUM,S,AGTOTAL,X,XY,Y,AGST,AGDTS

 +1        QUIT

READ       KILL DFOUT,DTOUT,DUOUT,DQOUT,DLOUT

           READ Y:$SELECT($DATA(DTIME):DTIME,1:300)

           IF '$TEST

               WRITE *7

               READ Y:5

               IF Y="."

                   GOTO READ

               IF '$TEST

                   SET (DTOUT,Y)=""

                   QUIT

 +1        IF Y="/.,"

               SET (DFOUT,Y)=""

           IF Y=""

               SET DLOUT=""

           IF Y="^"

               SET (DUOUT,Y)=""

           IF Y?1"?".E!(Y["^")

               SET (DQOUT,Y)=""

 +2        QUIT

COMMENT   ; This routine is a one-time-only run.

 +1       ; It reads thru the 'B' index of the MEDICAID ELIGIBLE

 +2       ; file (^AUPNMCD) to look for patients who are eligible for MEDICAID,

 +3       ; fix their eligibility numbers if necessary, and

 +4       ; flag them for inclusion with next export.

 +5       ;                                    RPMS/GTH

AGFIX7A.m