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'.",!
Q
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
Q
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)=""
Q
; 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
+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
