- 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 Feb 18, 2025@23:28:22 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