AG71A ;IHS/SD/EFG - Patient Registration 7.1 POST INSTALL ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
PRE ;EP - From KIDS.
;FILE 9009061.5 IS DINUMED AND HAS IDENTIFIERS. KIDS WILL NOT TRANSFER
;NEW DTAT FOR THOSE FIELDS WIHTOUT FIRST KILLING THE GLOBAL DTAT FIRST.
S IEN="" F S IEN=$O(^AGEDERRS(IEN)) Q:IEN="" K ^AGEDERRS(IEN)
Q
POST ;EP - From KIDS.
D BMES^XPDUTL("Beginning post-install routine (POST^AG71A)."),TS
;
D AGFAC
;
D BMES^XPDUTL("Fixing private eligibility with missing .01 field."),TS
D PRVT
;
D BMES^XPDUTL("Fixing Railroad Eligibility file with erroneous ""B"" cross reference"),TS
D RRE
;
D BMES^XPDUTL("Fixing Medicaid eligibility with missing .01 field."),TS
D MCD
;
D BMES^XPDUTL("Fixing Medicare eligibility B cross references."),TS
D MCR
;
D BMES^XPDUTL("Fixing Medicaid sub file node counts."),TS
D ^AGMCDCNT
;
D BMES^XPDUTL("Converting AUPNPAT field 3401 to a POINTER."),TS
D ^AGCNVMOD ;CONVERT AUPNPAT FIELD 3401 TO A POINTER
;
;
;CONVERT ENTRIES FROM .09 FIELD IN AUPNPAT TO
;NEW 1201 MULTIPLE FIELD IN AUPNPAT
D BMES^XPDUTL("Converting AUPNPAT field .09 to new multiple field 1201."),TS
D ^AGCNVIMP
;
;CONVERT ENTRIES FROM OLD 'AUTO/LIABILITY' FILE
;TO NEW 'THIRD PARTY LIABILITY' FILE
D BMES^XPDUTL("Converting AUTO/LIABILITY entries to new file."),TS
D ^AGCNVTPL
;
;CONVERT ENTRIES FROM OLD WORKMAN'S COMP FILE TO NEW WORKMAN'S
;COMPENSATION FILE
D BMES^XPDUTL("Converting WORKMAN'S COMP entries to new file."),TS
D START^AGCNVWC
;
;CONVERT ENTRIES FROM FIELD 3301 IN AUPNPAT TO NEW
;FILE AUPNBENR
D BMES^XPDUTL("Converting entries from AUPNPAT field 3301 to new file."),TS
D ^AGCNVBEN
;
;CONVERT ENTRIES IN .17 AND .18 IN AUPNPAT TO
;NEW MULTIPLE FIELD 7101 IN AUPNPAT
D BMES^XPDUTL("Converting AUPNPAT fields .17 and .18 to new multiple field 7101."),TS
D ^AGCNVAOB
;
;POPULATE NEW 'MANDATORY FIELDS (SITE)' IN REGISTRATION PARAMETER
;FILE
D BMES^XPDUTL("Populating mandatory site fields..."),TS
D ^AG71POST
;
I $$INSTALLD^AG71ENV("AG*7.1") D
. D TS,BMES^XPDUTL("Delivering AG*7.1 install message to select users ...")
. D MAIL
. D BMES^XPDUTL("Post-install routine is complete."),TS
;
Q:$$INSTALLD^AG71ENV("AG*7.1")
;
D TS,OPTRES("AGMENU")
;
D TS,BMES^XPDUTL("Delivering AG*7.1 install message to select users...")
;
D MAIL
;
D BMES^XPDUTL("Post-install routine is complete."),TS
Q
MAIL ;Send install mail message.
N DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
K ^TMP("AG71MS",$J)
S ^TMP("AG71MS",$J,1)=" --- AG v 7.1 has been installed into this uci ---"
S ^TMP("AG71MS",$J,2)=" "
S ^TMP("AG71MS",$J,3)="UNPOPULATED STATE FIELDS IN MEDICAID ELIGIBILITY FILE"
S ^TMP("AG71MS",$J,4)="YOU WILL HAVE TO USE FILEMAN TO ENTER THE PROPER STATE INTO THIS FIELD"
S CNT=5
D STATEMSG(.AGERRLST,.CNT)
K AGERRLST
S %=0
F S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'% S ^TMP("AG71MS",$J,(%+CNT))=" "_^(%,0)
S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AG71MS"",$J,",XMY(1)="",XMY(DUZ)=""
F %="AGZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
D ^XMD
K ^TMP("AG71MS",$J)
Q
SINGLE(K) ;EP - Get holders of a single key K.
N Y
S Y=0
Q:'$D(^XUSEC(K))
F S Y=$O(^XUSEC(K,Y)) Q:'Y S XMY(Y)=""
Q
;
OPTRES(AGM) ;
D BMES^XPDUTL("Restoring '"_AGM_"' option to PRE-install configuration...")
NEW AG,AGI
I '$D(^XTMP("AG71",7.2,"OPTSAV",AGM)) D BMES^XPDUTL("FAILED. Option '"_AGM_"' was not previously saved.") Q
S AG=0
F S AG=$O(^XTMP("AG71",7.2,"OPTSAV",AGM,AG)) Q:'AG S AGI=^(AG) I '$$ADD^XPDMENU(AGM,$P(AGI,U),$P(AGI,U,2),$P(AGI,U,3)) D BMES^XPDUTL("....FAILED to re-attach "_$P(AGI,U)_" to "_AGM_".")
;D BMES^XPDUTL("Attaching ""RHI1"" option to the Registration Reports menu ""RPT"".")
;I $$ADD^XPDMENU("AGREPORTS","AGRHI1","RHI1",20) D BMES^XPDUTL("....successfully atch'd.") I 1
;E D BMES^XPDUTL("....Attachment *FAILED*.")
Q
TS D MES^XPDUTL($$HTE^XLFDT($H)) Q
AGFAC ;POPULATE NEW REGISTRATION PARAMETERS IF BLANK
S AGFAC=0
F S AGFAC=$O(^AGFAC("B",AGFAC)) Q:'AGFAC D
. S AGFACPTR=0
. F S AGFACPTR=$O(^AGFAC("B",AGFAC,AGFACPTR)) Q:'AGFACPTR D
.. I $P($G(^AGFAC(AGFACPTR,0)),U,22)="" S $P(^AGFAC(AGFACPTR,0),U,22)=0
.. I $P($G(^AGFAC(AGFACPTR,0)),U,23)="" S $P(^AGFAC(AGFACPTR,0),U,23)="N"
.. I $P($G(^AGFAC(AGFACPTR,0)),U,24)="" S $P(^AGFAC(AGFACPTR,0),U,24)="N"
.. I $P($G(^AGFAC(AGFACPTR,0)),U,25)="" S $P(^AGFAC(AGFACPTR,0),U,25)="N"
.. S AGVAL("TMP",1)="I CERTIFY THAT THE ABOVE INFORMATION IS ACCURATE TO THE BEST OF MY KNOWLEDGE."
.. S AGVAL("TMP",2)=" "
.. S AGVAL("TMP",3)="SIGNED: _____________________________________________ DATE: ______________"
.. S AGVAL("TMP",4)=" PATIENT/GUARDIAN/AUTHORIZED REPRESENTATIVE"
.. I '$D(^AGFAC(AGFACPTR,4,0)) D
... D WP^DIE(9009061,AGFACPTR_",",40,,"AGVAL(""TMP"")")
K AGFAC,AGFACPTR,AGVAL
Q
PRVT ;CLEAR ANY PRIVATE ELIG RECORDS MISSING INSURER POINTER
;MUST DO DIRECT KILL BECAUSE X-REF NOT THERE. BOMBS ON USE OF ^DIK
S RECNO=0
F S RECNO=$O(^AUPNPRVT(RECNO)) Q:'RECNO D
.S D1=0
.F S D1=$O(^AUPNPRVT(RECNO,11,D1)) Q:'D1 D
..I $P($G(^AUPNPRVT(RECNO,11,D1,0)),U)="" K ^AUPNPRVT(RECNO,11,D1) Q
..I $P($G(^AUPNPRVT(RECNO,11,D1,0)),U,8)="" S DA=D1,DA(1)=RECNO,DIK="^AUPNPRVT("_DA(1)_",11," D ^DIK
..I $O(^AUPNPRVT(RECNO,11,0)) Q
..S DA=RECNO,DIK="^AUPNPRVT(" D ^DIK
S RECNO=0 F S RECNO=$O(^AUPNPRVT("B",RECNO)) Q:RECNO="" D
.S IEN=0 F S IEN=$O(^AUPNPRVT("B",RECNO,IEN)) Q:'IEN D
..I $P($G(^AUPNPRVT(IEN,0)),U)="" K ^AUPNPRVT(IEN),^AUPNPRVT("B",RECNO,IEN)
Q
MCD ;CLEAR MCD RECORDS MISSING .01 FIELD
;MUST DO DIRECT KILL BECAUSE X-REF NOT THERE. BOMBS ON USE OF ^DIK
K AGERRLST
N HRN,DFN,ST,MCDNUM
S RECNO=0
F S RECNO=$O(^AUPNMCD(RECNO)) Q:'RECNO D
.I $P($G(^AUPNMCD(RECNO,0)),U)="" K ^AUPNMCD(RECNO) Q ;GET RID OF WHOLE THING INCLUDING SUBFILE
.;IF THE INS. PTR IS MISSING LETS FIX IT SO TPB CLAIMS GENERATOR DOESN'T BLOW UP
.I $P($G(^AUPNMCD(RECNO,0)),U,2)="" S DA=RECNO,DIE="^AUPNMCD(",DR=".02///3" D ^DIE
.I $P($G(^AUPNMCD(RECNO,0)),U,4)="" S DFN=$P($G(^AUPNMCD(RECNO,0)),U),AGERRLST(RECNO)=$P($G(^DPT(DFN,0)),U)_U_$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
.S D1=0
.F S D1=$O(^AUPNMCD(RECNO,11,D1)) Q:'D1 D
..I $P($G(^AUPNMCD(RECNO,11,D1,0)),U)="" K ^AUPNMCD(RECNO,11,D1)
;NOTE: MCD ELIGIBILITY HEADER FIXED IN ^AGMCDCNT
S DFN=""
F S DFN=$O(^AUPNMCD("AB",DFN)) Q:DFN="" D
.S ST="" F S ST=$O(^AUPNMCD("AB",DFN,ST)) Q:ST="" D
..S MCDNUM="" F S MCDNUM=$O(^AUPNMCD("AB",DFN,ST,MCDNUM)) Q:MCDNUM="" D
...S RECNO="" F S RECNO=$O(^AUPNMCD("AB",DFN,ST,MCDNUM,RECNO)) Q:RECNO="" D
....I $P($G(^AUPNMCD(RECNO,0)),U)="" K ^AUPNMCD(RECNO),^AUPNMCD("AB",DFN,ST,MCDNUM,RECNO)
Q
RRE ;FIX "B" X-REF ENTRIES WITH NO ZERO RECORD
;MUST DO DIRECT KILL BECAUSE RECORD NOT THERE. BOMBS ON USE OF ^DIK DOESN'T WORK
S RECNO=""
F S RECNO=$O(^AUPNRRE("B",RECNO)) Q:'RECNO D
.I $P($G(^AUPNRRE(RECNO,0)),U)="" K ^AUPNRRE(RECNO),^AUPNRRE("B",RECNO)
S RECNO=0
F S RECNO=$O(^AUPNRRE(RECNO)) Q:'RECNO D
.I $P($G(^AUPNRRE(RECNO,0)),U)="" K ^AUPNRRE(RECNO),^AUPNRRE("B",RECNO)
Q
MCR ;
S RECNO=""
F S RECNO=$O(^AUPNMCR("B",RECNO)) Q:'RECNO D
.I $P($G(^AUPNMCR(RECNO,0)),U)="" K ^AUPNMCR(RECNO),^AUPNMCR("B",RECNO)
S RECNO=0
F S RECNO=$O(^AUPNMCR(RECNO)) Q:'RECNO D
.I $P($G(^AUPNMCR(RECNO,0)),U)="" K ^AUPNMCR(RECNO),^AUPNMCR("B",RECNO)
Q
STATEMSG(ARRAY,LN) ;EP - SEND MSG ABOUT MEDICAID ENTRIES MISSING STATE FIELD
N IEN
S IEN=""
F LN=LN:1 S IEN=$O(ARRAY(IEN)) Q:IEN="" D
.S ^TMP("AG71MS",$J,LN)="HRN # "_$P(ARRAY(IEN),U,2)_" IS MISSIING THE STATE FIELD IN MEDICAID ELIGIBILITY ENTRY "_IEN
Q
AG71A ;IHS/SD/EFG - Patient Registration 7.1 POST INSTALL ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
PRE ;EP - From KIDS.
+1 ;FILE 9009061.5 IS DINUMED AND HAS IDENTIFIERS. KIDS WILL NOT TRANSFER
+2 ;NEW DTAT FOR THOSE FIELDS WIHTOUT FIRST KILLING THE GLOBAL DTAT FIRST.
+3 SET IEN=""
FOR
SET IEN=$ORDER(^AGEDERRS(IEN))
IF IEN=""
QUIT
KILL ^AGEDERRS(IEN)
+4 QUIT
POST ;EP - From KIDS.
+1 DO BMES^XPDUTL("Beginning post-install routine (POST^AG71A).")
DO TS
+2 ;
+3 DO AGFAC
+4 ;
+5 DO BMES^XPDUTL("Fixing private eligibility with missing .01 field.")
DO TS
+6 DO PRVT
+7 ;
+8 DO BMES^XPDUTL("Fixing Railroad Eligibility file with erroneous ""B"" cross reference")
DO TS
+9 DO RRE
+10 ;
+11 DO BMES^XPDUTL("Fixing Medicaid eligibility with missing .01 field.")
DO TS
+12 DO MCD
+13 ;
+14 DO BMES^XPDUTL("Fixing Medicare eligibility B cross references.")
DO TS
+15 DO MCR
+16 ;
+17 DO BMES^XPDUTL("Fixing Medicaid sub file node counts.")
DO TS
+18 DO ^AGMCDCNT
+19 ;
+20 DO BMES^XPDUTL("Converting AUPNPAT field 3401 to a POINTER.")
DO TS
+21 ;CONVERT AUPNPAT FIELD 3401 TO A POINTER
DO ^AGCNVMOD
+22 ;
+23 ;
+24 ;CONVERT ENTRIES FROM .09 FIELD IN AUPNPAT TO
+25 ;NEW 1201 MULTIPLE FIELD IN AUPNPAT
+26 DO BMES^XPDUTL("Converting AUPNPAT field .09 to new multiple field 1201.")
DO TS
+27 DO ^AGCNVIMP
+28 ;
+29 ;CONVERT ENTRIES FROM OLD 'AUTO/LIABILITY' FILE
+30 ;TO NEW 'THIRD PARTY LIABILITY' FILE
+31 DO BMES^XPDUTL("Converting AUTO/LIABILITY entries to new file.")
DO TS
+32 DO ^AGCNVTPL
+33 ;
+34 ;CONVERT ENTRIES FROM OLD WORKMAN'S COMP FILE TO NEW WORKMAN'S
+35 ;COMPENSATION FILE
+36 DO BMES^XPDUTL("Converting WORKMAN'S COMP entries to new file.")
DO TS
+37 DO START^AGCNVWC
+38 ;
+39 ;CONVERT ENTRIES FROM FIELD 3301 IN AUPNPAT TO NEW
+40 ;FILE AUPNBENR
+41 DO BMES^XPDUTL("Converting entries from AUPNPAT field 3301 to new file.")
DO TS
+42 DO ^AGCNVBEN
+43 ;
+44 ;CONVERT ENTRIES IN .17 AND .18 IN AUPNPAT TO
+45 ;NEW MULTIPLE FIELD 7101 IN AUPNPAT
+46 DO BMES^XPDUTL("Converting AUPNPAT fields .17 and .18 to new multiple field 7101.")
DO TS
+47 DO ^AGCNVAOB
+48 ;
+49 ;POPULATE NEW 'MANDATORY FIELDS (SITE)' IN REGISTRATION PARAMETER
+50 ;FILE
+51 DO BMES^XPDUTL("Populating mandatory site fields...")
DO TS
+52 DO ^AG71POST
+53 ;
+54 IF $$INSTALLD^AG71ENV("AG*7.1")
Begin DoDot:1
+55 DO TS
DO BMES^XPDUTL("Delivering AG*7.1 install message to select users ...")
+56 DO MAIL
+57 DO BMES^XPDUTL("Post-install routine is complete.")
DO TS
End DoDot:1
+58 ;
+59 IF $$INSTALLD^AG71ENV("AG*7.1")
QUIT
+60 ;
+61 DO TS
DO OPTRES("AGMENU")
+62 ;
+63 DO TS
DO BMES^XPDUTL("Delivering AG*7.1 install message to select users...")
+64 ;
+65 DO MAIL
+66 ;
+67 DO BMES^XPDUTL("Post-install routine is complete.")
DO TS
+68 QUIT
MAIL ;Send install mail message.
+1 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
+2 KILL ^TMP("AG71MS",$JOB)
+3 SET ^TMP("AG71MS",$JOB,1)=" --- AG v 7.1 has been installed into this uci ---"
+4 SET ^TMP("AG71MS",$JOB,2)=" "
+5 SET ^TMP("AG71MS",$JOB,3)="UNPOPULATED STATE FIELDS IN MEDICAID ELIGIBILITY FILE"
+6 SET ^TMP("AG71MS",$JOB,4)="YOU WILL HAVE TO USE FILEMAN TO ENTER THE PROPER STATE INTO THIS FIELD"
+7 SET CNT=5
+8 DO STATEMSG(.AGERRLST,.CNT)
+9 KILL AGERRLST
+10 SET %=0
+11 FOR
SET %=$ORDER(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%))
IF '%
QUIT
SET ^TMP("AG71MS",$JOB,(%+CNT))=" "_^(%,0)
+12 SET XMSUB=$PIECE($PIECE($TEXT(+1),";",2)," ",3,99)
SET XMDUZ=$SELECT($GET(DUZ):DUZ,1:.5)
SET XMTEXT="^TMP(""AG71MS"",$J,"
SET XMY(1)=""
SET XMY(DUZ)=""
+13 FOR %="AGZMENU","XUMGR","XUPROG","XUPROGMODE"
DO SINGLE(%)
+14 DO ^XMD
+15 KILL ^TMP("AG71MS",$JOB)
+16 QUIT
SINGLE(K) ;EP - Get holders of a single key K.
+1 NEW Y
+2 SET Y=0
+3 IF '$DATA(^XUSEC(K))
QUIT
+4 FOR
SET Y=$ORDER(^XUSEC(K,Y))
IF 'Y
QUIT
SET XMY(Y)=""
+5 QUIT
+6 ;
OPTRES(AGM) ;
+1 DO BMES^XPDUTL("Restoring '"_AGM_"' option to PRE-install configuration...")
+2 NEW AG,AGI
+3 IF '$DATA(^XTMP("AG71",7.2,"OPTSAV",AGM))
DO BMES^XPDUTL("FAILED. Option '"_AGM_"' was not previously saved.")
QUIT
+4 SET AG=0
+5 FOR
SET AG=$ORDER(^XTMP("AG71",7.2,"OPTSAV",AGM,AG))
IF 'AG
QUIT
SET AGI=^(AG)
IF '$$ADD^XPDMENU(AGM,$PIECE(AGI,U),$PIECE(AGI,U,2),$PIECE(AGI,U,3))
DO BMES^XPDUTL("....FAILED to re-attach "_$PIECE(AGI,U)_" to "_AGM_".")
+6 ;D BMES^XPDUTL("Attaching ""RHI1"" option to the Registration Reports menu ""RPT"".")
+7 ;I $$ADD^XPDMENU("AGREPORTS","AGRHI1","RHI1",20) D BMES^XPDUTL("....successfully atch'd.") I 1
+8 ;E D BMES^XPDUTL("....Attachment *FAILED*.")
+9 QUIT
TS DO MES^XPDUTL($$HTE^XLFDT($HOROLOG))
QUIT
AGFAC ;POPULATE NEW REGISTRATION PARAMETERS IF BLANK
+1 SET AGFAC=0
+2 FOR
SET AGFAC=$ORDER(^AGFAC("B",AGFAC))
IF 'AGFAC
QUIT
Begin DoDot:1
+3 SET AGFACPTR=0
+4 FOR
SET AGFACPTR=$ORDER(^AGFAC("B",AGFAC,AGFACPTR))
IF 'AGFACPTR
QUIT
Begin DoDot:2
+5 IF $PIECE($GET(^AGFAC(AGFACPTR,0)),U,22)=""
SET $PIECE(^AGFAC(AGFACPTR,0),U,22)=0
+6 IF $PIECE($GET(^AGFAC(AGFACPTR,0)),U,23)=""
SET $PIECE(^AGFAC(AGFACPTR,0),U,23)="N"
+7 IF $PIECE($GET(^AGFAC(AGFACPTR,0)),U,24)=""
SET $PIECE(^AGFAC(AGFACPTR,0),U,24)="N"
+8 IF $PIECE($GET(^AGFAC(AGFACPTR,0)),U,25)=""
SET $PIECE(^AGFAC(AGFACPTR,0),U,25)="N"
+9 SET AGVAL("TMP",1)="I CERTIFY THAT THE ABOVE INFORMATION IS ACCURATE TO THE BEST OF MY KNOWLEDGE."
+10 SET AGVAL("TMP",2)=" "
+11 SET AGVAL("TMP",3)="SIGNED: _____________________________________________ DATE: ______________"
+12 SET AGVAL("TMP",4)=" PATIENT/GUARDIAN/AUTHORIZED REPRESENTATIVE"
+13 IF '$DATA(^AGFAC(AGFACPTR,4,0))
Begin DoDot:3
+14 DO WP^DIE(9009061,AGFACPTR_",",40,,"AGVAL(""TMP"")")
End DoDot:3
End DoDot:2
End DoDot:1
+15 KILL AGFAC,AGFACPTR,AGVAL
+16 QUIT
PRVT ;CLEAR ANY PRIVATE ELIG RECORDS MISSING INSURER POINTER
+1 ;MUST DO DIRECT KILL BECAUSE X-REF NOT THERE. BOMBS ON USE OF ^DIK
+2 SET RECNO=0
+3 FOR
SET RECNO=$ORDER(^AUPNPRVT(RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+4 SET D1=0
+5 FOR
SET D1=$ORDER(^AUPNPRVT(RECNO,11,D1))
IF 'D1
QUIT
Begin DoDot:2
+6 IF $PIECE($GET(^AUPNPRVT(RECNO,11,D1,0)),U)=""
KILL ^AUPNPRVT(RECNO,11,D1)
QUIT
+7 IF $PIECE($GET(^AUPNPRVT(RECNO,11,D1,0)),U,8)=""
SET DA=D1
SET DA(1)=RECNO
SET DIK="^AUPNPRVT("_DA(1)_",11,"
DO ^DIK
+8 IF $ORDER(^AUPNPRVT(RECNO,11,0))
QUIT
+9 SET DA=RECNO
SET DIK="^AUPNPRVT("
DO ^DIK
End DoDot:2
End DoDot:1
+10 SET RECNO=0
FOR
SET RECNO=$ORDER(^AUPNPRVT("B",RECNO))
IF RECNO=""
QUIT
Begin DoDot:1
+11 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNPRVT("B",RECNO,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+12 IF $PIECE($GET(^AUPNPRVT(IEN,0)),U)=""
KILL ^AUPNPRVT(IEN),^AUPNPRVT("B",RECNO,IEN)
End DoDot:2
End DoDot:1
+13 QUIT
MCD ;CLEAR MCD RECORDS MISSING .01 FIELD
+1 ;MUST DO DIRECT KILL BECAUSE X-REF NOT THERE. BOMBS ON USE OF ^DIK
+2 KILL AGERRLST
+3 NEW HRN,DFN,ST,MCDNUM
+4 SET RECNO=0
+5 FOR
SET RECNO=$ORDER(^AUPNMCD(RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+6 ;GET RID OF WHOLE THING INCLUDING SUBFILE
IF $PIECE($GET(^AUPNMCD(RECNO,0)),U)=""
KILL ^AUPNMCD(RECNO)
QUIT
+7 ;IF THE INS. PTR IS MISSING LETS FIX IT SO TPB CLAIMS GENERATOR DOESN'T BLOW UP
+8 IF $PIECE($GET(^AUPNMCD(RECNO,0)),U,2)=""
SET DA=RECNO
SET DIE="^AUPNMCD("
SET DR=".02///3"
DO ^DIE
+9 IF $PIECE($GET(^AUPNMCD(RECNO,0)),U,4)=""
SET DFN=$PIECE($GET(^AUPNMCD(RECNO,0)),U)
SET AGERRLST(RECNO)=$PIECE($GET(^DPT(DFN,0)),U)_U_$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
+10 SET D1=0
+11 FOR
SET D1=$ORDER(^AUPNMCD(RECNO,11,D1))
IF 'D1
QUIT
Begin DoDot:2
+12 IF $PIECE($GET(^AUPNMCD(RECNO,11,D1,0)),U)=""
KILL ^AUPNMCD(RECNO,11,D1)
End DoDot:2
End DoDot:1
+13 ;NOTE: MCD ELIGIBILITY HEADER FIXED IN ^AGMCDCNT
+14 SET DFN=""
+15 FOR
SET DFN=$ORDER(^AUPNMCD("AB",DFN))
IF DFN=""
QUIT
Begin DoDot:1
+16 SET ST=""
FOR
SET ST=$ORDER(^AUPNMCD("AB",DFN,ST))
IF ST=""
QUIT
Begin DoDot:2
+17 SET MCDNUM=""
FOR
SET MCDNUM=$ORDER(^AUPNMCD("AB",DFN,ST,MCDNUM))
IF MCDNUM=""
QUIT
Begin DoDot:3
+18 SET RECNO=""
FOR
SET RECNO=$ORDER(^AUPNMCD("AB",DFN,ST,MCDNUM,RECNO))
IF RECNO=""
QUIT
Begin DoDot:4
+19 IF $PIECE($GET(^AUPNMCD(RECNO,0)),U)=""
KILL ^AUPNMCD(RECNO),^AUPNMCD("AB",DFN,ST,MCDNUM,RECNO)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT
RRE ;FIX "B" X-REF ENTRIES WITH NO ZERO RECORD
+1 ;MUST DO DIRECT KILL BECAUSE RECORD NOT THERE. BOMBS ON USE OF ^DIK DOESN'T WORK
+2 SET RECNO=""
+3 FOR
SET RECNO=$ORDER(^AUPNRRE("B",RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^AUPNRRE(RECNO,0)),U)=""
KILL ^AUPNRRE(RECNO),^AUPNRRE("B",RECNO)
End DoDot:1
+5 SET RECNO=0
+6 FOR
SET RECNO=$ORDER(^AUPNRRE(RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(^AUPNRRE(RECNO,0)),U)=""
KILL ^AUPNRRE(RECNO),^AUPNRRE("B",RECNO)
End DoDot:1
+8 QUIT
MCR ;
+1 SET RECNO=""
+2 FOR
SET RECNO=$ORDER(^AUPNMCR("B",RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+3 IF $PIECE($GET(^AUPNMCR(RECNO,0)),U)=""
KILL ^AUPNMCR(RECNO),^AUPNMCR("B",RECNO)
End DoDot:1
+4 SET RECNO=0
+5 FOR
SET RECNO=$ORDER(^AUPNMCR(RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNMCR(RECNO,0)),U)=""
KILL ^AUPNMCR(RECNO),^AUPNMCR("B",RECNO)
End DoDot:1
+7 QUIT
STATEMSG(ARRAY,LN) ;EP - SEND MSG ABOUT MEDICAID ENTRIES MISSING STATE FIELD
+1 NEW IEN
+2 SET IEN=""
+3 FOR LN=LN:1
SET IEN=$ORDER(ARRAY(IEN))
IF IEN=""
QUIT
Begin DoDot:1
+4 SET ^TMP("AG71MS",$JOB,LN)="HRN # "_$PIECE(ARRAY(IEN),U,2)_" IS MISSIING THE STATE FIELD IN MEDICAID ELIGIBILITY ENTRY "_IEN
End DoDot:1
+5 QUIT
