IB20P244 ;ISP/TDP - Post-Init routine for IB*2.0*244 ;10/14/2003
;;2.0;INTEGRATED BILLING;**244**;21-MAR-94
POST ; This routine is to remove hyphens from the SUBSCRIBER ID (#1) field
; of the INSURANCE TYPE SUB-FIELD (#2.312) file of the PATIENT (#2)
; file. It also will delete invalid entries from the IB DM EXTRACT
; DATA (#351.71) file.
;
EN ; Start of Post-Init process.
N %,IBDATE,IBNOW,IBPURGE,X,X1,X2
D NOW^%DTC S (IBNOW,X1)=X,IBDATE=%
S X2=120
D C^%DTC S IBPURGE=X
;K ^XTMP("IB20P244",IBDATE)
S ^XTMP("IB20P244",0)=IBPURGE_"^"_IBNOW_"^"_$G(DUZ)
D SUBSCR
D INSUR
D END
Q
SUBSCR ;Remove all hyphens from subscriber ID's in the INSURANCE TYPE
;SUB-FIELD (#2.312) file of the PATIENT (#2) file.
D MES^XPDUTL("SUBSCRIBER ID clean up started in the")
D MES^XPDUTL(" INSURANCE TYPE SUB-FIELD (#2.312) file.")
D MES^XPDUTL("> Searching for SUBSCRIBER ID's containing invalid characters.")
D MES^XPDUTL(" ")
N DA,DFN,DIE,DR,IBCHAR,IBCHAR1,IBCNT,IBHICN,IBINS,IBINSCO,IBNAME,IBNODE
N IBRC,IBSSN,IBSUB,IBSUB1,IBSUB2,IBWNR
K ^TMP("IB20P244",$J)
S ^TMP("IB20P244",$J)=""
S IBCHAR="~` !@#$%^&*()_-+={}[]|\/:;<>,.?'"""
S IBCHAR1="~`!@$%^&*()_+={}[]|:;<>?'"""
S IBWNR=+$$GETWNR^IBCNSMM1
S (DFN,IBRC,IBCNT)=0
; Loop through Patient (#2) file
F S DFN=$O(^DPT(DFN)) Q:DFN="" D
. S IBINS=0
. ; Loop through Insurance Type Sub-Field
. F S IBINS=$O(^DPT(DFN,.312,IBINS)) Q:IBINS="" D
.. S IBCNT=IBCNT+1 I IBCNT>999 W ". " S IBCNT=0
.. S IBNODE=$G(^DPT(DFN,.312,IBINS,0))
.. ; Get Subscriber ID
.. S IBSUB=$P(IBNODE,U,2) I IBSUB="" Q
.. S IBSSN=$TR($P($G(^DPT(DFN,0)),U,9),IBCHAR,"")
.. S IBNAME=$P($G(^DPT(DFN,0)),U,1)
.. ; Remove non-alphanumeric characters
.. I $P(IBNODE,U,1)=IBWNR D ;Medicare
... S IBSUB1=$TR(IBSUB,IBCHAR,"")
... ; Check for invalid HICN format and no date of death
... I '$$VALHIC^IBCNSMM(IBSUB1),'$P($G(^DPT(DFN,.35)),U,1) S ^TMP("IB20P244",$J,"HICN INVALID",IBNAME_" ("_IBSSN_")")=IBSUB_"^"_IBSUB1
.. I $P(IBNODE,U,1)'=IBWNR D ;non-Medicare
... S IBSUB1=$TR(IBSUB,IBCHAR1,"")
... ;If subscriber id is SSN, then remove all extraneous characters
... S IBSUB2=$TR(IBSUB1," #-/\,.","")
... I IBSUB2=IBSSN,$L(IBSSN)=9 S IBSUB1=IBSUB2
.. ;I IBHICN S ^TMP("IB20P244",$J,"HICN INVALID",IBNAME_" ("_IBSSN_")")=IBSUB_"^"_IBSUB1 S IBHICN=0
.. ; Quit if no change in data
.. I IBSUB1=IBSUB Q
.. S IBINSCO=$P($G(^DIC(36,$P($G(^DPT(DFN,.312,IBINS,0)),U,1),0)),U,1)
.. S IBRC=IBRC+1
.. S ^XTMP("IB20P244",IBDATE,"SUB",DFN,IBINS)=IBSUB_"^"_IBSUB1
.. ; Save newly cleaned Subscriber ID
.. S DA=IBINS,DA(1)=DFN,DR="1////"_$S(IBSUB1="":"@",1:IBSUB1),DIE="^DPT(DFN,.312," D ^DIE
.. ;D MES^XPDUTL(">> Converted SUBSCRIBER ID of patient "_IBNAME_" ("_IBSSN_") from "_IBSUB_" to "_IBSUB1_" for insurance company "_IBINSCO)
D BMES^XPDUTL("> "_IBRC_" total SUBSCRIBER ID(S) were cleaned up.")
I $D(^TMP("IB20P244",$J,"HICN INVALID")) D MESSAGE
K ^TMP("IB20P244",$J)
Q
;
END ; display message that post-init has completed successfully
K X,Y
D MES^XPDUTL(" ")
D BMES^XPDUTL("Data clean up conversions complete.")
Q
;
INSUR ;This will remove all future dates and all past date entries which
;contain a day other than "00". For example, 3031000 is a valid entry
;while 3051200 and 3031014 are not based on a current date of 3031015.
N FTDT,PTDT
D MES^XPDUTL(" ")
D BMES^XPDUTL("IB DM EXTRACT DATA (#351.71) file clean up started.")
D MES^XPDUTL("> Searching for invalid entries.")
D FUTURE
D PAST
D MES^XPDUTL(" ")
I FTDT D MES^XPDUTL(">> "_FTDT_" invalid future date entries were deleted.")
I 'FTDT D MES^XPDUTL(">> There were no invalid future date entries found.")
I PTDT D MES^XPDUTL(">> "_PTDT_" invalid past date entries were deleted.")
I 'PTDT D MES^XPDUTL(">> There were no invalid past date entries found.")
D BMES^XPDUTL("> IB DM EXTRACT DATA (#351.71) file clean up completed.")
INSURQ Q
;
FUTURE ;This utility searches for and deletes future date entries from file
;351.71.
;Outputs: FTDT - number of future date entries deleted from 351.71.
; ^XTMP("IB20P244",IBDATE,"INS","FUT") - This global is created
; to temporarily store the data from the deleted future
; date entries. Will not exist if no future dates are
; found.
N CDT,DA,DATE,DIK
S FTDT=0
D NOW^%DTC S CDT=X
S DATE=99999999
F S DATE=$O(^IBE(351.71,DATE),-1) Q:DATE'>CDT D
. M ^XTMP("IB20P244",IBDATE,"INS","FUT",DATE)=^IBE(351.71,DATE)
. S DIK="^IBE(351.71,",DA=DATE D ^DIK
. S FTDT=FTDT+1
. Q
Q
;
PAST ;This utility searches for and deletes past date entries from file
;351.71 that end with something other than "00".
;Outputs: PTDT - number of entries deleted from 351.71.
; ^XTMP("IB20P244",IBDATE,"INS","PST") - This global is created
; to temporarily store the data from the deleted past
; date entries. Will not exist if no past dates are
; found.
N DA,DATE,DIK
S PTDT=0
S DATE=0
F S DATE=$O(^IBE(351.71,DATE)) Q:DATE="" D
. I $E(DATE,6,7)="00" Q
. I 'DATE Q
. M ^XTMP("IB20P244",IBDATE,"INS","PST",DATE)=^IBE(351.71,DATE)
. S DIK="^IBE(351.71,",DA=DATE D ^DIK
. S PTDT=PTDT+1
. Q
Q
;
MESSAGE ; Send message reporting invalid HICN format
N IBC,IBBCNT,IBCNT,IBDATA,IBFCNT,IBIDENT,IBGROUP,IBGRP,IBINSCO,IBMMSG
N IBMSG,IBNETNM,IBPARAM,IBSUB,IBTCNT,IBTST,IBTXT,XMDUZ,XMERR,XMSUB
N XMTEXT,XMY
S IBTCNT=0,IBIDENT=""
F S IBIDENT=$O(^TMP("IB20P244",$J,"HICN INVALID",IBIDENT)) Q:IBIDENT="" D
. S IBTCNT=IBTCNT+1
S IBSUB=0
D MSGHDR
I DUZ="" N DUZ S DUZ=.5 ; if user not defined set to postmaster
S XMDUZ=DUZ,XMTEXT=$NA(^TMP($J))
S IBPARAM("FROM")="PATCH IB*2.0*244 POST-INIT"
S IBGROUP="IB EDI SUPERVISOR"
S IBGRP=$O(^XMB(3.8,"B",IBGROUP,"")) I IBGRP D ;billing group defined
. I +$P($G(^XMB(3.8,IBGRP,1,0)),U,4)'>0 Q ; no members defined
. S XMY("G."_IBGROUP)="" ; send message to the group.
;I '$D(^XMB(3.8,"B",IBGROUP)) S IBGROUP=DUZ ; billing group not defined - send to the user
;E S IBGROUP="G."_IBGROUP
S XMY(DUZ)="" ; send message to user
;Send to developer if not test account (next 3 lines)
S IBTST=".TEST.MIR.TST.MIRROR.TRAIN." ; various test names
S IBNETNM=$G(^XMB("NETNAME"))
I IBNETNM'="",('$F(IBTST,"."_$P(IBNETNM,".",1)_".")) S XMY("PHELPS,TY@DOMAIN.EXT")=""
;
S IBINSCO=$P($G(^DIC(36,IBWNR,0)),U,1)
MSG1 S IBC=0
S IBC=IBC+1,^TMP($J,IBC)="This message has been sent by patch IB*2.0*244 at the completion of"
S IBC=IBC+1,^TMP($J,IBC)="the post-init routine."
S IBC=IBC+1,^TMP($J,IBC)="The following "_IBINSCO_" SUBSCRIBER ID entries remain in an invalid state:"
S IBC=IBC+1,^TMP($J,IBC)=" "
S IBC=IBC+1,^TMP($J,IBC)="NAME(SSN) ^ ORIGINAL ID ^ MODIFIED ID"
S IBC=IBC+1,^TMP($J,IBC)=" "
S (IBMMSG,IBMSG)=0
I IBSUB=1 S IBCNT=0,IBIDENT="",IBBCNT=1
I IBSUB>1 S IBBCNT=IBCNT+1
F S IBIDENT=$O(^TMP("IB20P244",$J,"HICN INVALID",IBIDENT)) Q:IBIDENT="" D G:IBMSG MSG1
. S IBDATA=$G(^TMP("IB20P244",$J,"HICN INVALID",IBIDENT))
. S IBC=IBC+1,^TMP($J,IBC)=IBIDENT_"^"_IBDATA
. S IBCNT=IBCNT+1
. I 'IBMMSG S IBMMSG=1
. I IBC>9500 S IBFCNT=IBCNT D
.. S IBC=IBC+1,^TMP($J,IBC)=" "
.. S IBC=IBC+1,^TMP($J,IBC)="This message contains "_IBBCNT_" thru "_IBFCNT_" of "_IBTCNT_" total"
.. S IBC=IBC+1,^TMP($J,IBC)="records left in an invalid state."
.. D SNDMSG,MSGHDR S IBMSG=1
S IBC=IBC+1,^TMP($J,IBC)=" "
I IBSUB=1 D
.S IBC=IBC+1,^TMP($J,IBC)="Total records left in an invalid state: "_IBCNT_"."
I IBSUB>1 D
. S IBC=IBC+1,^TMP($J,IBC)="This message contains "_IBBCNT_" thru "_IBCNT_" of "_IBTCNT_" total"
. S IBC=IBC+1,^TMP($J,IBC)="records left in an invalid state."
I IBMMSG D SNDMSG
Q
SNDMSG ;
D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.IBPARAM,"","")
S IBTXT="Invalid Medicare SUBSCRIBER ID message #"_IBSUB_" "_$S($D(XMERR):"not sent due to error in message set up.",1:"sent to ")_$S($D(XMY("G.IB EDI SUPERVISOR")):"IB EDI SUPERVISOR mail group, ",1:"")
D BMES^XPDUTL(IBTXT)
S IBTXT=" the "_$S(DUZ=.5:"POSTMASTER ",1:"user ")_"and the patch developer."
D MES^XPDUTL(IBTXT)
K ^TMP($J)
Q
;
MSGHDR ;Creates message subject line
K ^TMP($J)
S IBSUB=IBSUB+1
S XMSUB="SUBSCRIBER ID CLEAN UP COMPLETE"
I IBSUB>1 S XMSUB=XMSUB_" (MSG #"_IBSUB_")"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P244 8350 printed Dec 13, 2024@02:01:59 Page 2
IB20P244 ;ISP/TDP - Post-Init routine for IB*2.0*244 ;10/14/2003
+1 ;;2.0;INTEGRATED BILLING;**244**;21-MAR-94
POST ; This routine is to remove hyphens from the SUBSCRIBER ID (#1) field
+1 ; of the INSURANCE TYPE SUB-FIELD (#2.312) file of the PATIENT (#2)
+2 ; file. It also will delete invalid entries from the IB DM EXTRACT
+3 ; DATA (#351.71) file.
+4 ;
EN ; Start of Post-Init process.
+1 NEW %,IBDATE,IBNOW,IBPURGE,X,X1,X2
+2 DO NOW^%DTC
SET (IBNOW,X1)=X
SET IBDATE=%
+3 SET X2=120
+4 DO C^%DTC
SET IBPURGE=X
+5 ;K ^XTMP("IB20P244",IBDATE)
+6 SET ^XTMP("IB20P244",0)=IBPURGE_"^"_IBNOW_"^"_$GET(DUZ)
+7 DO SUBSCR
+8 DO INSUR
+9 DO END
+10 QUIT
SUBSCR ;Remove all hyphens from subscriber ID's in the INSURANCE TYPE
+1 ;SUB-FIELD (#2.312) file of the PATIENT (#2) file.
+2 DO MES^XPDUTL("SUBSCRIBER ID clean up started in the")
+3 DO MES^XPDUTL(" INSURANCE TYPE SUB-FIELD (#2.312) file.")
+4 DO MES^XPDUTL("> Searching for SUBSCRIBER ID's containing invalid characters.")
+5 DO MES^XPDUTL(" ")
+6 NEW DA,DFN,DIE,DR,IBCHAR,IBCHAR1,IBCNT,IBHICN,IBINS,IBINSCO,IBNAME,IBNODE
+7 NEW IBRC,IBSSN,IBSUB,IBSUB1,IBSUB2,IBWNR
+8 KILL ^TMP("IB20P244",$JOB)
+9 SET ^TMP("IB20P244",$JOB)=""
+10 SET IBCHAR="~` !@#$%^&*()_-+={}[]|\/:;<>,.?'"""
+11 SET IBCHAR1="~`!@$%^&*()_+={}[]|:;<>?'"""
+12 SET IBWNR=+$$GETWNR^IBCNSMM1
+13 SET (DFN,IBRC,IBCNT)=0
+14 ; Loop through Patient (#2) file
+15 FOR
SET DFN=$ORDER(^DPT(DFN))
if DFN=""
QUIT
Begin DoDot:1
+16 SET IBINS=0
+17 ; Loop through Insurance Type Sub-Field
+18 FOR
SET IBINS=$ORDER(^DPT(DFN,.312,IBINS))
if IBINS=""
QUIT
Begin DoDot:2
+19 SET IBCNT=IBCNT+1
IF IBCNT>999
WRITE ". "
SET IBCNT=0
+20 SET IBNODE=$GET(^DPT(DFN,.312,IBINS,0))
+21 ; Get Subscriber ID
+22 SET IBSUB=$PIECE(IBNODE,U,2)
IF IBSUB=""
QUIT
+23 SET IBSSN=$TRANSLATE($PIECE($GET(^DPT(DFN,0)),U,9),IBCHAR,"")
+24 SET IBNAME=$PIECE($GET(^DPT(DFN,0)),U,1)
+25 ; Remove non-alphanumeric characters
+26 ;Medicare
IF $PIECE(IBNODE,U,1)=IBWNR
Begin DoDot:3
+27 SET IBSUB1=$TRANSLATE(IBSUB,IBCHAR,"")
+28 ; Check for invalid HICN format and no date of death
+29 IF '$$VALHIC^IBCNSMM(IBSUB1)
IF '$PIECE($GET(^DPT(DFN,.35)),U,1)
SET ^TMP("IB20P244",$JOB,"HICN INVALID",IBNAME_" ("_IBSSN_")")=IBSUB_"^"_IBSUB1
End DoDot:3
+30 ;non-Medicare
IF $PIECE(IBNODE,U,1)'=IBWNR
Begin DoDot:3
+31 SET IBSUB1=$TRANSLATE(IBSUB,IBCHAR1,"")
+32 ;If subscriber id is SSN, then remove all extraneous characters
+33 SET IBSUB2=$TRANSLATE(IBSUB1," #-/\,.","")
+34 IF IBSUB2=IBSSN
IF $LENGTH(IBSSN)=9
SET IBSUB1=IBSUB2
End DoDot:3
+35 ;I IBHICN S ^TMP("IB20P244",$J,"HICN INVALID",IBNAME_" ("_IBSSN_")")=IBSUB_"^"_IBSUB1 S IBHICN=0
+36 ; Quit if no change in data
+37 IF IBSUB1=IBSUB
QUIT
+38 SET IBINSCO=$PIECE($GET(^DIC(36,$PIECE($GET(^DPT(DFN,.312,IBINS,0)),U,1),0)),U,1)
+39 SET IBRC=IBRC+1
+40 SET ^XTMP("IB20P244",IBDATE,"SUB",DFN,IBINS)=IBSUB_"^"_IBSUB1
+41 ; Save newly cleaned Subscriber ID
+42 SET DA=IBINS
SET DA(1)=DFN
SET DR="1////"_$SELECT(IBSUB1="":"@",1:IBSUB1)
SET DIE="^DPT(DFN,.312,"
DO ^DIE
+43 ;D MES^XPDUTL(">> Converted SUBSCRIBER ID of patient "_IBNAME_" ("_IBSSN_") from "_IBSUB_" to "_IBSUB1_" for insurance company "_IBINSCO)
End DoDot:2
End DoDot:1
+44 DO BMES^XPDUTL("> "_IBRC_" total SUBSCRIBER ID(S) were cleaned up.")
+45 IF $DATA(^TMP("IB20P244",$JOB,"HICN INVALID"))
DO MESSAGE
+46 KILL ^TMP("IB20P244",$JOB)
+47 QUIT
+48 ;
END ; display message that post-init has completed successfully
+1 KILL X,Y
+2 DO MES^XPDUTL(" ")
+3 DO BMES^XPDUTL("Data clean up conversions complete.")
+4 QUIT
+5 ;
INSUR ;This will remove all future dates and all past date entries which
+1 ;contain a day other than "00". For example, 3031000 is a valid entry
+2 ;while 3051200 and 3031014 are not based on a current date of 3031015.
+3 NEW FTDT,PTDT
+4 DO MES^XPDUTL(" ")
+5 DO BMES^XPDUTL("IB DM EXTRACT DATA (#351.71) file clean up started.")
+6 DO MES^XPDUTL("> Searching for invalid entries.")
+7 DO FUTURE
+8 DO PAST
+9 DO MES^XPDUTL(" ")
+10 IF FTDT
DO MES^XPDUTL(">> "_FTDT_" invalid future date entries were deleted.")
+11 IF 'FTDT
DO MES^XPDUTL(">> There were no invalid future date entries found.")
+12 IF PTDT
DO MES^XPDUTL(">> "_PTDT_" invalid past date entries were deleted.")
+13 IF 'PTDT
DO MES^XPDUTL(">> There were no invalid past date entries found.")
+14 DO BMES^XPDUTL("> IB DM EXTRACT DATA (#351.71) file clean up completed.")
INSURQ QUIT
+1 ;
FUTURE ;This utility searches for and deletes future date entries from file
+1 ;351.71.
+2 ;Outputs: FTDT - number of future date entries deleted from 351.71.
+3 ; ^XTMP("IB20P244",IBDATE,"INS","FUT") - This global is created
+4 ; to temporarily store the data from the deleted future
+5 ; date entries. Will not exist if no future dates are
+6 ; found.
+7 NEW CDT,DA,DATE,DIK
+8 SET FTDT=0
+9 DO NOW^%DTC
SET CDT=X
+10 SET DATE=99999999
+11 FOR
SET DATE=$ORDER(^IBE(351.71,DATE),-1)
if DATE'>CDT
QUIT
Begin DoDot:1
+12 MERGE ^XTMP("IB20P244",IBDATE,"INS","FUT",DATE)=^IBE(351.71,DATE)
+13 SET DIK="^IBE(351.71,"
SET DA=DATE
DO ^DIK
+14 SET FTDT=FTDT+1
+15 QUIT
End DoDot:1
+16 QUIT
+17 ;
PAST ;This utility searches for and deletes past date entries from file
+1 ;351.71 that end with something other than "00".
+2 ;Outputs: PTDT - number of entries deleted from 351.71.
+3 ; ^XTMP("IB20P244",IBDATE,"INS","PST") - This global is created
+4 ; to temporarily store the data from the deleted past
+5 ; date entries. Will not exist if no past dates are
+6 ; found.
+7 NEW DA,DATE,DIK
+8 SET PTDT=0
+9 SET DATE=0
+10 FOR
SET DATE=$ORDER(^IBE(351.71,DATE))
if DATE=""
QUIT
Begin DoDot:1
+11 IF $EXTRACT(DATE,6,7)="00"
QUIT
+12 IF 'DATE
QUIT
+13 MERGE ^XTMP("IB20P244",IBDATE,"INS","PST",DATE)=^IBE(351.71,DATE)
+14 SET DIK="^IBE(351.71,"
SET DA=DATE
DO ^DIK
+15 SET PTDT=PTDT+1
+16 QUIT
End DoDot:1
+17 QUIT
+18 ;
MESSAGE ; Send message reporting invalid HICN format
+1 NEW IBC,IBBCNT,IBCNT,IBDATA,IBFCNT,IBIDENT,IBGROUP,IBGRP,IBINSCO,IBMMSG
+2 NEW IBMSG,IBNETNM,IBPARAM,IBSUB,IBTCNT,IBTST,IBTXT,XMDUZ,XMERR,XMSUB
+3 NEW XMTEXT,XMY
+4 SET IBTCNT=0
SET IBIDENT=""
+5 FOR
SET IBIDENT=$ORDER(^TMP("IB20P244",$JOB,"HICN INVALID",IBIDENT))
if IBIDENT=""
QUIT
Begin DoDot:1
+6 SET IBTCNT=IBTCNT+1
End DoDot:1
+7 SET IBSUB=0
+8 DO MSGHDR
+9 ; if user not defined set to postmaster
IF DUZ=""
NEW DUZ
SET DUZ=.5
+10 SET XMDUZ=DUZ
SET XMTEXT=$NAME(^TMP($JOB))
+11 SET IBPARAM("FROM")="PATCH IB*2.0*244 POST-INIT"
+12 SET IBGROUP="IB EDI SUPERVISOR"
+13 ;billing group defined
SET IBGRP=$ORDER(^XMB(3.8,"B",IBGROUP,""))
IF IBGRP
Begin DoDot:1
+14 ; no members defined
IF +$PIECE($GET(^XMB(3.8,IBGRP,1,0)),U,4)'>0
QUIT
+15 ; send message to the group.
SET XMY("G."_IBGROUP)=""
End DoDot:1
+16 ;I '$D(^XMB(3.8,"B",IBGROUP)) S IBGROUP=DUZ ; billing group not defined - send to the user
+17 ;E S IBGROUP="G."_IBGROUP
+18 ; send message to user
SET XMY(DUZ)=""
+19 ;Send to developer if not test account (next 3 lines)
+20 ; various test names
SET IBTST=".TEST.MIR.TST.MIRROR.TRAIN."
+21 SET IBNETNM=$GET(^XMB("NETNAME"))
+22 IF IBNETNM'=""
IF ('$FIND(IBTST,"."_$PIECE(IBNETNM,".",1)_"."))
SET XMY("PHELPS,TY@DOMAIN.EXT")=""
+23 ;
+24 SET IBINSCO=$PIECE($GET(^DIC(36,IBWNR,0)),U,1)
MSG1 SET IBC=0
+1 SET IBC=IBC+1
SET ^TMP($JOB,IBC)="This message has been sent by patch IB*2.0*244 at the completion of"
+2 SET IBC=IBC+1
SET ^TMP($JOB,IBC)="the post-init routine."
+3 SET IBC=IBC+1
SET ^TMP($JOB,IBC)="The following "_IBINSCO_" SUBSCRIBER ID entries remain in an invalid state:"
+4 SET IBC=IBC+1
SET ^TMP($JOB,IBC)=" "
+5 SET IBC=IBC+1
SET ^TMP($JOB,IBC)="NAME(SSN) ^ ORIGINAL ID ^ MODIFIED ID"
+6 SET IBC=IBC+1
SET ^TMP($JOB,IBC)=" "
+7 SET (IBMMSG,IBMSG)=0
+8 IF IBSUB=1
SET IBCNT=0
SET IBIDENT=""
SET IBBCNT=1
+9 IF IBSUB>1
SET IBBCNT=IBCNT+1
+10 FOR
SET IBIDENT=$ORDER(^TMP("IB20P244",$JOB,"HICN INVALID",IBIDENT))
if IBIDENT=""
QUIT
Begin DoDot:1
+11 SET IBDATA=$GET(^TMP("IB20P244",$JOB,"HICN INVALID",IBIDENT))
+12 SET IBC=IBC+1
SET ^TMP($JOB,IBC)=IBIDENT_"^"_IBDATA
+13 SET IBCNT=IBCNT+1
+14 IF 'IBMMSG
SET IBMMSG=1
+15 IF IBC>9500
SET IBFCNT=IBCNT
Begin DoDot:2
+16 SET IBC=IBC+1
SET ^TMP($JOB,IBC)=" "
+17 SET IBC=IBC+1
SET ^TMP($JOB,IBC)="This message contains "_IBBCNT_" thru "_IBFCNT_" of "_IBTCNT_" total"
+18 SET IBC=IBC+1
SET ^TMP($JOB,IBC)="records left in an invalid state."
+19 DO SNDMSG
DO MSGHDR
SET IBMSG=1
End DoDot:2
End DoDot:1
if IBMSG
GOTO MSG1
+20 SET IBC=IBC+1
SET ^TMP($JOB,IBC)=" "
+21 IF IBSUB=1
Begin DoDot:1
+22 SET IBC=IBC+1
SET ^TMP($JOB,IBC)="Total records left in an invalid state: "_IBCNT_"."
End DoDot:1
+23 IF IBSUB>1
Begin DoDot:1
+24 SET IBC=IBC+1
SET ^TMP($JOB,IBC)="This message contains "_IBBCNT_" thru "_IBCNT_" of "_IBTCNT_" total"
+25 SET IBC=IBC+1
SET ^TMP($JOB,IBC)="records left in an invalid state."
End DoDot:1
+26 IF IBMMSG
DO SNDMSG
+27 QUIT
SNDMSG ;
+1 DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.IBPARAM,"","")
+2 SET IBTXT="Invalid Medicare SUBSCRIBER ID message #"_IBSUB_" "_$SELECT($DATA(XMERR):"not sent due to error in message set up.",1:"sent to ")_$SELECT($DATA(XMY("G.IB EDI SUPERVISOR")):"IB EDI SUPERVISOR mail group, ",1:"")
+3 DO BMES^XPDUTL(IBTXT)
+4 SET IBTXT=" the "_$SELECT(DUZ=.5:"POSTMASTER ",1:"user ")_"and the patch developer."
+5 DO MES^XPDUTL(IBTXT)
+6 KILL ^TMP($JOB)
+7 QUIT
+8 ;
MSGHDR ;Creates message subject line
+1 KILL ^TMP($JOB)
+2 SET IBSUB=IBSUB+1
+3 SET XMSUB="SUBSCRIBER ID CLEAN UP COMPLETE"
+4 IF IBSUB>1
SET XMSUB=XMSUB_" (MSG #"_IBSUB_")"
+5 QUIT
