AG71A1 ;IHS/SD/EFG - Patient Registration 7.1 PATCH 1 PRE/POST INSTALL ;
;;7.1;PATIENT REGISTRATION;**1**;AUG 25,2005
;
Q
PRE ;EP - From KIDS.
;'AG PATIENT REGISTRATION ERROR CODES' FILE
;FILE 9009061.5 IS DINUMED AND HAS IDENTIFIERS. KIDS WILL NOT TRANSFER
;NEW DATA FOR THOSE FIELDS WITHOUT FIRST KILLING THE GLOBAL DATA FIRST.
;ONLY NEED IF CHAGING DATA IN THIS FILE
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
;
;CONVERT ENTRIES IN .04 IN AUPNPAT TO
;NEW MULTIPLE FIELD 3601 IN AUPNPAT
D BMES^XPDUTL("Converting 'Release of Information' AUPNPAT field .04 to new multiple field 3601."),TS
D ^AGCNVROI
;
D BMES^XPDUTL("Fixing private eligibility with missing Policy Holder .08 field. or missing insurer pointer"),TS
D PRVT
;
D BMES^XPDUTL("Collecting Medicaid eligibility entries with missing State .04 field."),TS
D MCD
;
D BMES^XPDUTL("Fixing Medicare eligibility B cross references."),TS
D MCR
;
;CAN WE INCLUDE THIS IN AG PATCH 1
D BMES^XPDUTL("Fixing INSUREr IENs containing decimal."),TS
D INSURER
;
D BMES^XPDUTL("Fixing Medicare records with missing .01 fields"),TS
D MCR
;
D BMES^XPDUTL("Fixing Rail Road entries with missing .01 field."),TS
D RRE
;
D BMES^XPDUTL("Fixing incomplete Guarantor records."),TS
D GUAR
;
D BMES^XPDUTL("Fixing patient file with dangling D x-ref"),TS
D PAT
;
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)="PLEASE REPORT TO THE OIT HELP DESK THE FOLLOWING"
S ^TMP("AG71MS",$J,4)="UNPOPULATED STATE FIELDS IN MEDICAID ELIGIBILITY FILE"
S ^TMP("AG71MS",$J,5)="YOU WILL HAVE TO USE FILEMAN TO ENTER THE PROPER STATE INTO THIS FIELD"
S CNT=6
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
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
.;IF THE INS. PTR IS MISSING LETS FIX IT SO TPB CLAIMS GENERATOR DOESN'T BLOW UP
.I '$G(^AUPNMCD(RECNO,0))!('$P($G(^AUPNMCD(RECNO,0)),U)) K ^AUPNMCD(RECNO) Q
.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)
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
INSURER ;EP - CAN WE INCLUDE THIS IN AG PATCH 1??
S RECNO=0
F S RECNO=$O(^AUTNINS(RECNO)) Q:'RECNO D
.I RECNO[(".") K ^AUTNINS(RECNO),^AUTNINS("B",RECNO)
S RECNO=""
F S RECNO=$O(^AUTNINS("B",RECNO)) Q:RECNO="" D
.S RECIEN=""
.F S RECIEN=$O(^AUTNINS("B",RECNO,RECIEN)) Q:RECIEN="" D
..Q:$P($G(^AUTNINS(RECIEN,0)),U)'=""
..K DA,DIR,DIE,DIK,DIC,DR
..S DA=RECIEN,DIK="^AUTNINS(" D ^DIK
Q
PAT ;CLEAN UP D X-REF IN PATIENT FILE
S HRN="" F S HRN=$O(^AUPNPAT("D",HRN)) Q:HRN="" D
.S RECNO="" F S RECNO=$O(^AUPNPAT("D",HRN,RECNO)) Q:RECNO="" D
..I '$D(^AUPNPAT(RECNO))!('$D(^DPT(RECNO))) K ^AUPNPAT("D",HRN,RECNO)
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
GUAR ;CLEAR GUARANTOR RECORDS WITH INCOMPETE ENTRIES
N PATPTR
S PATPTR=0
F S PATPTR=$O(^AUPNGUAR(PATPTR)) Q:'PATPTR D GUAR1(PATPTR)
Q
GUAR1(PATPTR) ;EP - DELETE GUARANTOR ENTRIES WITH MISSING GUARANTORS OR DATES
N SUB1,SUB11,REDO
REDO ;
S SUB1=$O(^AUPNGUAR(PATPTR,1,0))
I 'SUB1 D Q ;NO GUARANTORS FOUND AT ALL
.K DIE,DIK,DA,DIC S DIK="^AUPNGUAR(",DA=PATPTR D ^DIK
;FOR EACH GUARANTOR ARE THERE EFFECTIVE DATES?
S (SUB1,REDO)=0
F S SUB1=$O(^AUPNGUAR(PATPTR,1,SUB1)) Q:'SUB1 D G REDO:REDO
.S SUB11=$O(^AUPNGUAR(PATPTR,1,SUB1,11,0))
.I 'SUB11 D Q
..S REDO=1 K DIE,DIK,DA,DIC S DA(1)=PATPTR,DA=SUB1,DIK="^AUPNGUAR("_DA(1)_",1," D ^DIK
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
VAALERT ;EP - SEND VA ALERT IF WANTED
S XQAMSG="Patient Regsistration "_$P($T(+2),";",3)_" Patch "_$P($T(+2),";",5)_" INSTALL complete."
S XQA("AG MAIL GROUP")=""
D SETUP^XQALERT
Q
AG71A1 ;IHS/SD/EFG - Patient Registration 7.1 PATCH 1 PRE/POST INSTALL ;
+1 ;;7.1;PATIENT REGISTRATION;**1**;AUG 25,2005
+2 ;
+3 QUIT
PRE ;EP - From KIDS.
+1 ;'AG PATIENT REGISTRATION ERROR CODES' FILE
+2 ;FILE 9009061.5 IS DINUMED AND HAS IDENTIFIERS. KIDS WILL NOT TRANSFER
+3 ;NEW DATA FOR THOSE FIELDS WITHOUT FIRST KILLING THE GLOBAL DATA FIRST.
+4 ;ONLY NEED IF CHAGING DATA IN THIS FILE
+5 SET IEN=""
FOR
SET IEN=$ORDER(^AGEDERRS(IEN))
IF IEN=""
QUIT
KILL ^AGEDERRS(IEN)
+6 QUIT
POST ;EP - From KIDS.
+1 DO BMES^XPDUTL("Beginning post-install routine (POST^AG71A).")
DO TS
+2 ;
+3 ;CONVERT ENTRIES IN .04 IN AUPNPAT TO
+4 ;NEW MULTIPLE FIELD 3601 IN AUPNPAT
+5 DO BMES^XPDUTL("Converting 'Release of Information' AUPNPAT field .04 to new multiple field 3601.")
DO TS
+6 DO ^AGCNVROI
+7 ;
+8 DO BMES^XPDUTL("Fixing private eligibility with missing Policy Holder .08 field. or missing insurer pointer")
DO TS
+9 DO PRVT
+10 ;
+11 DO BMES^XPDUTL("Collecting Medicaid eligibility entries with missing State .04 field.")
DO TS
+12 DO MCD
+13 ;
+14 DO BMES^XPDUTL("Fixing Medicare eligibility B cross references.")
DO TS
+15 DO MCR
+16 ;
+17 ;CAN WE INCLUDE THIS IN AG PATCH 1
+18 DO BMES^XPDUTL("Fixing INSUREr IENs containing decimal.")
DO TS
+19 DO INSURER
+20 ;
+21 DO BMES^XPDUTL("Fixing Medicare records with missing .01 fields")
DO TS
+22 DO MCR
+23 ;
+24 DO BMES^XPDUTL("Fixing Rail Road entries with missing .01 field.")
DO TS
+25 DO RRE
+26 ;
+27 DO BMES^XPDUTL("Fixing incomplete Guarantor records.")
DO TS
+28 DO GUAR
+29 ;
+30 DO BMES^XPDUTL("Fixing patient file with dangling D x-ref")
DO TS
+31 DO PAT
+32 ;
+33 IF $$INSTALLD^AG71ENV("AG*7.1")
Begin DoDot:1
+34 DO TS
DO BMES^XPDUTL("Delivering AG*7.1 install message to select users ...")
+35 DO MAIL
+36 DO BMES^XPDUTL("Post-install routine is complete.")
DO TS
End DoDot:1
+37 ;
+38 IF $$INSTALLD^AG71ENV("AG*7.1")
QUIT
+39 ;
+40 DO TS
DO OPTRES("AGMENU")
+41 ;
+42 DO TS
DO BMES^XPDUTL("Delivering AG*7.1 install message to select users...")
+43 ;
+44 DO MAIL
+45 ;
+46 DO BMES^XPDUTL("Post-install routine is complete.")
DO TS
+47 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)="PLEASE REPORT TO THE OIT HELP DESK THE FOLLOWING"
+6 SET ^TMP("AG71MS",$JOB,4)="UNPOPULATED STATE FIELDS IN MEDICAID ELIGIBILITY FILE"
+7 SET ^TMP("AG71MS",$JOB,5)="YOU WILL HAVE TO USE FILEMAN TO ENTER THE PROPER STATE INTO THIS FIELD"
+8 SET CNT=6
+9 DO STATEMSG(.AGERRLST,.CNT)
+10 KILL AGERRLST
+11 SET %=0
+12 FOR
SET %=$ORDER(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%))
IF '%
QUIT
SET ^TMP("AG71MS",$JOB,(%+CNT))=" "_^(%,0)
+13 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)=""
+14 FOR %="AGZMENU","XUMGR","XUPROG","XUPROGMODE"
DO SINGLE(%)
+15 DO ^XMD
+16 KILL ^TMP("AG71MS",$JOB)
+17 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
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 ;IF THE INS. PTR IS MISSING LETS FIX IT SO TPB CLAIMS GENERATOR DOESN'T BLOW UP
+7 IF '$GET(^AUPNMCD(RECNO,0))!('$PIECE($GET(^AUPNMCD(RECNO,0)),U))
KILL ^AUPNMCD(RECNO)
QUIT
+8 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)
End DoDot:1
+9 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
INSURER ;EP - CAN WE INCLUDE THIS IN AG PATCH 1??
+1 SET RECNO=0
+2 FOR
SET RECNO=$ORDER(^AUTNINS(RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+3 IF RECNO[(".")
KILL ^AUTNINS(RECNO),^AUTNINS("B",RECNO)
End DoDot:1
+4 SET RECNO=""
+5 FOR
SET RECNO=$ORDER(^AUTNINS("B",RECNO))
IF RECNO=""
QUIT
Begin DoDot:1
+6 SET RECIEN=""
+7 FOR
SET RECIEN=$ORDER(^AUTNINS("B",RECNO,RECIEN))
IF RECIEN=""
QUIT
Begin DoDot:2
+8 IF $PIECE($GET(^AUTNINS(RECIEN,0)),U)'=""
QUIT
+9 KILL DA,DIR,DIE,DIK,DIC,DR
+10 SET DA=RECIEN
SET DIK="^AUTNINS("
DO ^DIK
End DoDot:2
End DoDot:1
+11 QUIT
PAT ;CLEAN UP D X-REF IN PATIENT FILE
+1 SET HRN=""
FOR
SET HRN=$ORDER(^AUPNPAT("D",HRN))
IF HRN=""
QUIT
Begin DoDot:1
+2 SET RECNO=""
FOR
SET RECNO=$ORDER(^AUPNPAT("D",HRN,RECNO))
IF RECNO=""
QUIT
Begin DoDot:2
+3 IF '$DATA(^AUPNPAT(RECNO))!('$DATA(^DPT(RECNO)))
KILL ^AUPNPAT("D",HRN,RECNO)
End DoDot:2
End DoDot:1
+4 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
GUAR ;CLEAR GUARANTOR RECORDS WITH INCOMPETE ENTRIES
+1 NEW PATPTR
+2 SET PATPTR=0
+3 FOR
SET PATPTR=$ORDER(^AUPNGUAR(PATPTR))
IF 'PATPTR
QUIT
DO GUAR1(PATPTR)
+4 QUIT
GUAR1(PATPTR) ;EP - DELETE GUARANTOR ENTRIES WITH MISSING GUARANTORS OR DATES
+1 NEW SUB1,SUB11,REDO
REDO ;
+1 SET SUB1=$ORDER(^AUPNGUAR(PATPTR,1,0))
+2 ;NO GUARANTORS FOUND AT ALL
IF 'SUB1
Begin DoDot:1
+3 KILL DIE,DIK,DA,DIC
SET DIK="^AUPNGUAR("
SET DA=PATPTR
DO ^DIK
End DoDot:1
QUIT
+4 ;FOR EACH GUARANTOR ARE THERE EFFECTIVE DATES?
+5 SET (SUB1,REDO)=0
+6 FOR
SET SUB1=$ORDER(^AUPNGUAR(PATPTR,1,SUB1))
IF 'SUB1
QUIT
Begin DoDot:1
+7 SET SUB11=$ORDER(^AUPNGUAR(PATPTR,1,SUB1,11,0))
+8 IF 'SUB11
Begin DoDot:2
+9 SET REDO=1
KILL DIE,DIK,DA,DIC
SET DA(1)=PATPTR
SET DA=SUB1
SET DIK="^AUPNGUAR("_DA(1)_",1,"
DO ^DIK
End DoDot:2
QUIT
End DoDot:1
IF REDO
GOTO REDO
+10 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
VAALERT ;EP - SEND VA ALERT IF WANTED
+1 SET XQAMSG="Patient Regsistration "_$PIECE($TEXT(+2),";",3)_" Patch "_$PIECE($TEXT(+2),";",5)_" INSTALL complete."
+2 SET XQA("AG MAIL GROUP")=""
+3 DO SETUP^XQALERT
+4 QUIT
