IB20P239 ;ISP/TDP - Post-Init routine for IB*2.0*239 ;11/14/2003
;;2.0;INTEGRATED BILLING;**239**;21-MAR-94
; 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.
;
Q
POST ; Start of Post-Init process.
N BILL,CU,DA,DATA,DBILL,DCU,DFORM,DID,DIE,DINS,DR,FORM,IB35591,IBACCNT
N IBANQCNT,IBCNT,IBNOW,IBPURGE,IBTYPE,ID,IEN,INS,X,X1,X2
D BMES^XPDUTL("PROVIDER ID CARE UNIT clean up started in the")
D MES^XPDUTL(" IB INSURANCE CO LEVEL BILLING PROV ID (#355.91) file.")
;D BMES^XPDUTL(" ")
D BMES^XPDUTL("> Searching for Care Unit values of -1.")
;D BMES^XPDUTL(" ")
K ^XTMP("IB20P239",$J)
D NOW^%DTC S (IBNOW,X1)=X
S X2=30
D C^%DTC S IBPURGE=X
S ^XTMP("IB20P239",0)=IBPURGE_"^"_IBNOW_"^"_$G(DUZ)
S DA="",(IBACCNT,IBANQCNT,IBCNT)=0
;Find and delete the -1 Care Unit values from the records.
F S DA=$O(^IBA(355.91,DA)) Q:DA="" D
. I $P($G(^IBA(355.91,DA,0)),U,3)=-1 D
.. S DR=".03///@",DIE="^IBA(355.91,"
.. S IB35591=$G(^IBA(355.91,DA,0))
.. L +^IBA(355.91,DA) I $T D ^DIE L -^IBA(355.91,DA)
.. S ^XTMP("IB20P239",$J,DA,0)=IB35591,IBCNT=IBCNT+1
.. D MES^XPDUTL(">> Record "_DA_" has been modified.")
;Now, clean up the "AC" and "AUNIQ" cross-references that may have been
;left with -1 Care Unit values or invalid cross-references.
D BMES^XPDUTL("> Searching for invalid ""AUNIQ"" cross-references.")
S INS=""
F S INS=$O(^IBA(355.91,"AUNIQ",INS)) Q:INS="" D
. S CU=""
. F S CU=$O(^IBA(355.91,"AUNIQ",INS,CU)) Q:CU="" D
.. S FORM=""
.. F S FORM=$O(^IBA(355.91,"AUNIQ",INS,CU,FORM)) Q:FORM="" D
... S BILL=""
... F S BILL=$O(^IBA(355.91,"AUNIQ",INS,CU,FORM,BILL)) Q:BILL="" D
.... S ID=""
.... F S ID=$O(^IBA(355.91,"AUNIQ",INS,CU,FORM,BILL,ID)) Q:ID="" D
..... S IEN=""
..... F S IEN=$O(^IBA(355.91,"AUNIQ",INS,CU,FORM,BILL,ID,IEN)) Q:IEN="" D
...... I CU<0 D AUNIQ Q
...... S DATA=$G(^IBA(355.91,IEN,0))
...... I DATA="" D AUNIQ Q
...... S DINS=$P(DATA,"^",1)
...... S DCU=$P(DATA,"^",10)
...... S DFORM=$P(DATA,"^",4)
...... S DBILL=$P(DATA,"^",5)
...... S DID=$P(DATA,"^",6)
...... I DINS'=INS!(DCU'=CU)!(DFORM'=FORM)!(DBILL'=BILL)!(DID'=ID) D AUNIQ Q
D BMES^XPDUTL("> Searching for invalid ""AC"" cross-references.")
F S INS=$O(^IBA(355.91,"AC",INS)) Q:INS="" D
. S ID=""
. F S ID=$O(^IBA(355.91,"AC",INS,ID)) Q:ID="" D
.. S CU=""
.. F S CU=$O(^IBA(355.91,"AC",INS,ID,CU)) Q:CU="" D
... S IEN=""
... F S IEN=$O(^IBA(355.91,"AC",INS,ID,CU,IEN)) Q:IEN="" D
.... I CU<0 D AC Q
.... S DATA=$G(^IBA(355.91,IEN,0))
.... I DATA="" D AC Q
.... S DINS=$P(DATA,"^",1)
.... S DID=$P(DATA,"^",6)
.... S DCU=$P(DATA,"^",10)
.... I DINS'=INS!(DID'=ID)!(DCU'=CU) D AC Q
D BMES^XPDUTL("> Searches have completed.")
I IBACCNT!(IBANQCNT)!(IBCNT) D
. D MES^XPDUTL(" ")
. D MES^XPDUTL("> "_IBCNT_" total records were modified.")
. D MES^XPDUTL("> "_IBACCNT_" total ""AC"" cross-references were modified.")
. D MES^XPDUTL("> "_IBANQCNT_" total ""AUNIQ"" cross-references were modified.")
I 'IBACCNT,'IBANQCNT,'IBCNT D
. D BMES^XPDUTL("> No records needed to be modified.")
;D BMES^XPDUTL(" ")
D BMES^XPDUTL("PROVIDER ID CARE UNIT clean up completed.")
END ; display message that pre-init has completed successfully
K BILL,CU,DA,DATA,DBILL,DCU,DFORM,DID,DIE,DINS,DR,FORM,IB35591,IBACCNT
K IBANQCNT,IBCNT,IBNOW,IBPURGE,IBTYPE,ID,IEN,INS,X,X1,X2
Q
AC ;Set "AC" cross-reference entry into temporary global then kill the
;"AC" cross-reference.
S IBACCNT=IBACCNT+1
S ^XTMP("IB20P239",$J,"AC",INS,ID,CU,IEN)=""
K ^IBA(355.91,"AC",INS,ID,CU,IEN)
Q
AUNIQ ;Set "AUNIQ" cross-reference entry into temporary global then kill the
;"AUNIQ" cross-reference.
S IBANQCNT=IBANQCNT+1
S ^XTMP("IB20P239",$J,"AUNIQ",INS,CU,FORM,BILL,ID,IEN)=""
K ^IBA(355.91,"AUNIQ",INS,CU,FORM,BILL,ID,IEN)
Q
;
MSG ; Send message
N IBC,IBGROUP,IBPARAM,IBTXT,XMDUZ,XMERR,XMSUB,XMTEXT,XMY
S XMSUB="PROVIDER ID CARE UNIT CLEAN UP COMPLETE"
S XMDUZ=DUZ,XMTEXT="IBTXT"
S IBPARAM("FROM")="PATCH IB*2.0*239 POST-INIT"
S IBGROUP="IB EDI SUPERVISOR"
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(IBGROUP)="",XMY("PHELPS.TY@DOMAIN.EXT")=""
;
S IBC=0
S IBC=IBC+1,IBTXT(IBC)="This message has been sent by patch IB*2.0*239 at the completion of"
S IBC=IBC+1,IBTXT(IBC)="the post-init routine."
S IBC=IBC+1,IBTXT(IBC)="The following entries in file 355.91 have been modified:"
S IBC=IBC+1,IBTXT(IBC)=" "
S IBCNT=0,DA=""
F S DA=$O(^XTMP("IB20P239",$J,DA)) Q:DA="" D
. S IBC=IBC+1,IBTXT(IBC)="^IBA(355.91,DA)"
. S IBCNT=IBCNT+1
S IBC=IBC+1,IBTXT(IBC)=" "
S IBC=IBC+1,IBTXT(IBC)="Total records modified: "_IBCNT_"."
D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.IBPARAM,"","")
S IBTXT="Provider ID Care Unit clean up message "_$S($D(XMERR):"not sent due to error in message set up.",1:"sent to IB EDI SUPERVISOR mail group and to the patch developer.")
D BMES^XPDUTL(IBTXT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P239 5208 printed Dec 13, 2024@02:01:56 Page 2
IB20P239 ;ISP/TDP - Post-Init routine for IB*2.0*239 ;11/14/2003
+1 ;;2.0;INTEGRATED BILLING;**239**;21-MAR-94
+2 ; This routine is to remove hyphens from the SUBSCRIBER ID (#1) field
+3 ; of the INSURANCE TYPE SUB-FIELD (#2.312) file of the PATIENT (#2)
+4 ; file. It also will delete invalid entries from the IB DM EXTRACT
+5 ; DATA (#351.71) file.
+6 ;
+7 QUIT
POST ; Start of Post-Init process.
+1 NEW BILL,CU,DA,DATA,DBILL,DCU,DFORM,DID,DIE,DINS,DR,FORM,IB35591,IBACCNT
+2 NEW IBANQCNT,IBCNT,IBNOW,IBPURGE,IBTYPE,ID,IEN,INS,X,X1,X2
+3 DO BMES^XPDUTL("PROVIDER ID CARE UNIT clean up started in the")
+4 DO MES^XPDUTL(" IB INSURANCE CO LEVEL BILLING PROV ID (#355.91) file.")
+5 ;D BMES^XPDUTL(" ")
+6 DO BMES^XPDUTL("> Searching for Care Unit values of -1.")
+7 ;D BMES^XPDUTL(" ")
+8 KILL ^XTMP("IB20P239",$JOB)
+9 DO NOW^%DTC
SET (IBNOW,X1)=X
+10 SET X2=30
+11 DO C^%DTC
SET IBPURGE=X
+12 SET ^XTMP("IB20P239",0)=IBPURGE_"^"_IBNOW_"^"_$GET(DUZ)
+13 SET DA=""
SET (IBACCNT,IBANQCNT,IBCNT)=0
+14 ;Find and delete the -1 Care Unit values from the records.
+15 FOR
SET DA=$ORDER(^IBA(355.91,DA))
if DA=""
QUIT
Begin DoDot:1
+16 IF $PIECE($GET(^IBA(355.91,DA,0)),U,3)=-1
Begin DoDot:2
+17 SET DR=".03///@"
SET DIE="^IBA(355.91,"
+18 SET IB35591=$GET(^IBA(355.91,DA,0))
+19 LOCK +^IBA(355.91,DA)
IF $TEST
DO ^DIE
LOCK -^IBA(355.91,DA)
+20 SET ^XTMP("IB20P239",$JOB,DA,0)=IB35591
SET IBCNT=IBCNT+1
+21 DO MES^XPDUTL(">> Record "_DA_" has been modified.")
End DoDot:2
End DoDot:1
+22 ;Now, clean up the "AC" and "AUNIQ" cross-references that may have been
+23 ;left with -1 Care Unit values or invalid cross-references.
+24 DO BMES^XPDUTL("> Searching for invalid ""AUNIQ"" cross-references.")
+25 SET INS=""
+26 FOR
SET INS=$ORDER(^IBA(355.91,"AUNIQ",INS))
if INS=""
QUIT
Begin DoDot:1
+27 SET CU=""
+28 FOR
SET CU=$ORDER(^IBA(355.91,"AUNIQ",INS,CU))
if CU=""
QUIT
Begin DoDot:2
+29 SET FORM=""
+30 FOR
SET FORM=$ORDER(^IBA(355.91,"AUNIQ",INS,CU,FORM))
if FORM=""
QUIT
Begin DoDot:3
+31 SET BILL=""
+32 FOR
SET BILL=$ORDER(^IBA(355.91,"AUNIQ",INS,CU,FORM,BILL))
if BILL=""
QUIT
Begin DoDot:4
+33 SET ID=""
+34 FOR
SET ID=$ORDER(^IBA(355.91,"AUNIQ",INS,CU,FORM,BILL,ID))
if ID=""
QUIT
Begin DoDot:5
+35 SET IEN=""
+36 FOR
SET IEN=$ORDER(^IBA(355.91,"AUNIQ",INS,CU,FORM,BILL,ID,IEN))
if IEN=""
QUIT
Begin DoDot:6
+37 IF CU<0
DO AUNIQ
QUIT
+38 SET DATA=$GET(^IBA(355.91,IEN,0))
+39 IF DATA=""
DO AUNIQ
QUIT
+40 SET DINS=$PIECE(DATA,"^",1)
+41 SET DCU=$PIECE(DATA,"^",10)
+42 SET DFORM=$PIECE(DATA,"^",4)
+43 SET DBILL=$PIECE(DATA,"^",5)
+44 SET DID=$PIECE(DATA,"^",6)
+45 IF DINS'=INS!(DCU'=CU)!(DFORM'=FORM)!(DBILL'=BILL)!(DID'=ID)
DO AUNIQ
QUIT
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+46 DO BMES^XPDUTL("> Searching for invalid ""AC"" cross-references.")
+47 FOR
SET INS=$ORDER(^IBA(355.91,"AC",INS))
if INS=""
QUIT
Begin DoDot:1
+48 SET ID=""
+49 FOR
SET ID=$ORDER(^IBA(355.91,"AC",INS,ID))
if ID=""
QUIT
Begin DoDot:2
+50 SET CU=""
+51 FOR
SET CU=$ORDER(^IBA(355.91,"AC",INS,ID,CU))
if CU=""
QUIT
Begin DoDot:3
+52 SET IEN=""
+53 FOR
SET IEN=$ORDER(^IBA(355.91,"AC",INS,ID,CU,IEN))
if IEN=""
QUIT
Begin DoDot:4
+54 IF CU<0
DO AC
QUIT
+55 SET DATA=$GET(^IBA(355.91,IEN,0))
+56 IF DATA=""
DO AC
QUIT
+57 SET DINS=$PIECE(DATA,"^",1)
+58 SET DID=$PIECE(DATA,"^",6)
+59 SET DCU=$PIECE(DATA,"^",10)
+60 IF DINS'=INS!(DID'=ID)!(DCU'=CU)
DO AC
QUIT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+61 DO BMES^XPDUTL("> Searches have completed.")
+62 IF IBACCNT!(IBANQCNT)!(IBCNT)
Begin DoDot:1
+63 DO MES^XPDUTL(" ")
+64 DO MES^XPDUTL("> "_IBCNT_" total records were modified.")
+65 DO MES^XPDUTL("> "_IBACCNT_" total ""AC"" cross-references were modified.")
+66 DO MES^XPDUTL("> "_IBANQCNT_" total ""AUNIQ"" cross-references were modified.")
End DoDot:1
+67 IF 'IBACCNT
IF 'IBANQCNT
IF 'IBCNT
Begin DoDot:1
+68 DO BMES^XPDUTL("> No records needed to be modified.")
End DoDot:1
+69 ;D BMES^XPDUTL(" ")
+70 DO BMES^XPDUTL("PROVIDER ID CARE UNIT clean up completed.")
END ; display message that pre-init has completed successfully
+1 KILL BILL,CU,DA,DATA,DBILL,DCU,DFORM,DID,DIE,DINS,DR,FORM,IB35591,IBACCNT
+2 KILL IBANQCNT,IBCNT,IBNOW,IBPURGE,IBTYPE,ID,IEN,INS,X,X1,X2
+3 QUIT
AC ;Set "AC" cross-reference entry into temporary global then kill the
+1 ;"AC" cross-reference.
+2 SET IBACCNT=IBACCNT+1
+3 SET ^XTMP("IB20P239",$JOB,"AC",INS,ID,CU,IEN)=""
+4 KILL ^IBA(355.91,"AC",INS,ID,CU,IEN)
+5 QUIT
AUNIQ ;Set "AUNIQ" cross-reference entry into temporary global then kill the
+1 ;"AUNIQ" cross-reference.
+2 SET IBANQCNT=IBANQCNT+1
+3 SET ^XTMP("IB20P239",$JOB,"AUNIQ",INS,CU,FORM,BILL,ID,IEN)=""
+4 KILL ^IBA(355.91,"AUNIQ",INS,CU,FORM,BILL,ID,IEN)
+5 QUIT
+6 ;
MSG ; Send message
+1 NEW IBC,IBGROUP,IBPARAM,IBTXT,XMDUZ,XMERR,XMSUB,XMTEXT,XMY
+2 SET XMSUB="PROVIDER ID CARE UNIT CLEAN UP COMPLETE"
+3 SET XMDUZ=DUZ
SET XMTEXT="IBTXT"
+4 SET IBPARAM("FROM")="PATCH IB*2.0*239 POST-INIT"
+5 SET IBGROUP="IB EDI SUPERVISOR"
+6 ; billing group not defined - send to the user
IF '$DATA(^XMB(3.8,"B",IBGROUP))
SET IBGROUP=DUZ
+7 IF '$TEST
SET IBGROUP="G."_IBGROUP
+8 SET XMY(IBGROUP)=""
SET XMY("PHELPS.TY@DOMAIN.EXT")=""
+9 ;
+10 SET IBC=0
+11 SET IBC=IBC+1
SET IBTXT(IBC)="This message has been sent by patch IB*2.0*239 at the completion of"
+12 SET IBC=IBC+1
SET IBTXT(IBC)="the post-init routine."
+13 SET IBC=IBC+1
SET IBTXT(IBC)="The following entries in file 355.91 have been modified:"
+14 SET IBC=IBC+1
SET IBTXT(IBC)=" "
+15 SET IBCNT=0
SET DA=""
+16 FOR
SET DA=$ORDER(^XTMP("IB20P239",$JOB,DA))
if DA=""
QUIT
Begin DoDot:1
+17 SET IBC=IBC+1
SET IBTXT(IBC)="^IBA(355.91,DA)"
+18 SET IBCNT=IBCNT+1
End DoDot:1
+19 SET IBC=IBC+1
SET IBTXT(IBC)=" "
+20 SET IBC=IBC+1
SET IBTXT(IBC)="Total records modified: "_IBCNT_"."
+21 DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.IBPARAM,"","")
+22 SET IBTXT="Provider ID Care Unit clean up message "_$SELECT($DATA(XMERR):"not sent due to error in message set up.",1:"sent to IB EDI SUPERVISOR mail group and to the patch developer.")
+23 DO BMES^XPDUTL(IBTXT)
+24 QUIT
