IBY283PO ;ALB/ESG - Post Install for IB patch 283 ;24-AUG-2004
;;2.0;INTEGRATED BILLING;**283**;21-MAR-94
; IA#2916 for call to CREIXN^DDMOD
;
EN ;
N XPDIDTOT S XPDIDTOT=4
D TEXT ; new text entries in file 361.3
D ACSA ; new index file for 361
D AUTOFILE ; examine informational messages for auto-file
D PARAM ; site parameter purge value
EX ;
Q
;
TEXT ; Add new text entries in file 361.3 - IB MESSAGE SCREEN TEXT
NEW DATA,TXT,DO,DA,DIC,X,Y
D BMES^XPDUTL(" STEP 1 of 4")
D MES^XPDUTL("-------------")
D MES^XPDUTL("Adding new entries into file 361.3 ....")
S DATA("CLAIM RECEIVED")=""
S DATA("ACK/ACCEPTANCE HAS BEEN ACCEPT")=""
S DATA("COMPLETED: PAYMENT MADE")=""
S DATA("FINALIZED-PAYMENT: PAYMENT REF")=""
S TXT=""
F S TXT=$O(DATA(TXT)) Q:TXT="" D
. I $D(^IBE(361.3,"B",TXT)) Q ; already on file
. S DIC="^IBE(361.3,",DIC(0)="F",X=TXT
. S DIC("DR")=".02////0"
. D FILE^DICN
. Q
TX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(1)
Q
;
ACSA ; Build the new "ACSA" index for file 361
NEW IBMXR,IBMRES,IBMOUT
S IBMXR("FILE")=361
S IBMXR("NAME")="ACSA"
S IBMXR("TYPE")="R"
S IBMXR("USE")="S"
S IBMXR("EXECUTION")="R"
S IBMXR("ACTIVITY")="IR"
S IBMXR("SHORT DESCR")="Index by Message Severity and Review Status"
S IBMXR("DESCR",1)="This index is used in the CSA screen (Claims Status Awaiting"
S IBMXR("DESCR",2)="Resolution). Most often the CSA screen is built with unreviewed"
S IBMXR("DESCR",3)="rejection messages. This index file can immediately locate them."
S IBMXR("VAL",1)=.03
S IBMXR("VAL",1,"SUBSCRIPT")=1
S IBMXR("VAL",1,"COLLATION")="F"
S IBMXR("VAL",2)=.09
S IBMXR("VAL",2,"SUBSCRIPT")=2
S IBMXR("VAL",2,"COLLATION")="F"
;
D BMES^XPDUTL(" STEP 2 of 4")
D MES^XPDUTL("-------------")
D MES^XPDUTL("A new index will now be created for file 361.")
D MES^XPDUTL("This may take some time depending on how many entries are in file 361.")
D CREIXN^DDMOD(.IBMXR,"SW",.IBMRES,"IBMOUT")
I +$G(IBMRES) D MES^XPDUTL("Index successfully created!") G ACSAX
;
; Index not created
D MES^XPDUTL("A PROBLEM WAS ENCOUNTERED. INDEX FILE NOT CREATED!!!")
D MES^XPDUTL("SENDING MAILMAN MESSAGE...")
D MES^XPDUTL("PLACING THE CSA SCREEN OUT-OF-ORDER.")
NEW XMDUZ,XMSUBJ,XMBODY,MSG,XMTO,DA,DIE,DR
S XMDUZ=DUZ,XMSUBJ="IB*2*283 Error: ACSA index not built",XMBODY="MSG"
S MSG(1)="The new ""ACSA"" index for file 361 was not created at"
S MSG(2)=" "
S MSG(3)=" "_$$SITE^VASITE
S MSG(4)=" "
S MSG(5)="The CSA screen has been placed out of order."
;
; recipients of message
S XMTO(DUZ)=""
S XMTO("eric.gustafson@daou.com")=""
S XMTO("G.PATCHES")=""
S XMTO("G.IB EDI")=""
S XMTO("G.IB EDI SUPERVISOR")=""
;
D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)
;
; place CSA screen out of order
S DA=$O(^DIC(19,"B","IBCE CLAIMS STATUS AWAITING",""))
I DA S DIE=19,DR="2///IB Patch 283 Installation Failure" D ^DIE
ACSAX ;
D UPDATE^XPDID(2)
Q
;
AUTOFILE ; Loop through the informational status messages with
; no Final Review Action and check to see if they qualify for
; auto-file with no review.
;
NEW IBDA,IBCNT,IB,Z,STOP,IBAUTO,TXT,NOREVU,IBREV
D BMES^XPDUTL(" STEP 3 of 4")
D MES^XPDUTL("-------------")
D MES^XPDUTL("Now looking at all informational status messages on file to see if any of them")
D MES^XPDUTL("can be auto-filed with no review needed. Each ""."" represents 1000 messages.")
D MES^XPDUTL("")
S IBDA=0,IBCNT=0
F S IBDA=$O(^IBM(361,"ASV","I",IBDA)) Q:'IBDA D
. S IBCNT=IBCNT+1 W:(IBCNT#1000=0)&'$D(ZTQUEUED) "."
. S IB=$G(^IBM(361,IBDA,0))
. ;
. I $P(IB,U,10)'="" Q ; final review action exists so quit out
. ;
. ; if this message was previously auto-filed with no review, then
. ; update the final review information and quit out
. I $P(IB,U,9)=2,$P(IB,U,14)=1 D Q
.. N DIE,DR,DA
.. S DIE=361,DR=".1////F",DA=IBDA D ^DIE
.. Q
. ;
. ; IBAUTO - flag indicating that the whole message can be auto-filed
. ; with no review needed
. ; NOREVU - flag indicating that one of the message lines had 'No
. ; Review Needed' text
. ; IBREV - flag indicating that one of the message lines had 'Review
. ; Always Needed' text (so the whole message needs review)
. ;
. S Z=0,STOP=0,IBAUTO=0
. F S Z=$O(^IBM(361,IBDA,1,Z)) Q:'Z D Q:STOP
.. S TXT=$G(^IBM(361,IBDA,1,Z,0)) Q:TXT="" ; text line Z
.. S NOREVU=$$CKREVU^IBCEM4(TXT,,,.IBREV) ; call function
.. I IBREV S STOP=1,IBAUTO=0 Q ; 'review always needed' text found
.. I NOREVU S IBAUTO=1 ; 'no review needed' text found
.. Q
. ;
. I IBAUTO D
.. N DIE,DR,DA
.. S DIE=361,DR=".09////2;.14////1;.1////F",DA=IBDA D ^DIE
.. Q
. Q
;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(3)
Q
;
PARAM ; Ensure there is a value in IB site parameter field 350.9,8.02
; "Days to wait to purge messages"
; If not defined, set it to be 90 days.
;
N A
S A=$G(^IBE(350.9,1,8))
D BMES^XPDUTL(" STEP 4 of 4")
D MES^XPDUTL("-------------")
;
I $P(A,U,2) D G PARAMX ; quit out if field is defined
. D MES^XPDUTL("IB site parameter value ""Days to wait to purge status messages"" is set to "_$P(A,U,2)_".")
. D MES^XPDUTL(" No changes made.")
. Q
;
D MES^XPDUTL("IB site parameter value ""Days to wait to purge status messages"" is not defined.")
D MES^XPDUTL("Setting this parameter value to 90 ....")
S $P(^IBE(350.9,1,8),U,2)=90 ; set to 90 days if undefined
D MES^XPDUTL(" Done.")
PARAMX ;
D UPDATE^XPDID(4)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY283PO 5618 printed Dec 13, 2024@02:33:36 Page 2
IBY283PO ;ALB/ESG - Post Install for IB patch 283 ;24-AUG-2004
+1 ;;2.0;INTEGRATED BILLING;**283**;21-MAR-94
+2 ; IA#2916 for call to CREIXN^DDMOD
+3 ;
EN ;
+1 NEW XPDIDTOT
SET XPDIDTOT=4
+2 ; new text entries in file 361.3
DO TEXT
+3 ; new index file for 361
DO ACSA
+4 ; examine informational messages for auto-file
DO AUTOFILE
+5 ; site parameter purge value
DO PARAM
EX ;
+1 QUIT
+2 ;
TEXT ; Add new text entries in file 361.3 - IB MESSAGE SCREEN TEXT
+1 NEW DATA,TXT,DO,DA,DIC,X,Y
+2 DO BMES^XPDUTL(" STEP 1 of 4")
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Adding new entries into file 361.3 ....")
+5 SET DATA("CLAIM RECEIVED")=""
+6 SET DATA("ACK/ACCEPTANCE HAS BEEN ACCEPT")=""
+7 SET DATA("COMPLETED: PAYMENT MADE")=""
+8 SET DATA("FINALIZED-PAYMENT: PAYMENT REF")=""
+9 SET TXT=""
+10 FOR
SET TXT=$ORDER(DATA(TXT))
if TXT=""
QUIT
Begin DoDot:1
+11 ; already on file
IF $DATA(^IBE(361.3,"B",TXT))
QUIT
+12 SET DIC="^IBE(361.3,"
SET DIC(0)="F"
SET X=TXT
+13 SET DIC("DR")=".02////0"
+14 DO FILE^DICN
+15 QUIT
End DoDot:1
TX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(1)
+3 QUIT
+4 ;
ACSA ; Build the new "ACSA" index for file 361
+1 NEW IBMXR,IBMRES,IBMOUT
+2 SET IBMXR("FILE")=361
+3 SET IBMXR("NAME")="ACSA"
+4 SET IBMXR("TYPE")="R"
+5 SET IBMXR("USE")="S"
+6 SET IBMXR("EXECUTION")="R"
+7 SET IBMXR("ACTIVITY")="IR"
+8 SET IBMXR("SHORT DESCR")="Index by Message Severity and Review Status"
+9 SET IBMXR("DESCR",1)="This index is used in the CSA screen (Claims Status Awaiting"
+10 SET IBMXR("DESCR",2)="Resolution). Most often the CSA screen is built with unreviewed"
+11 SET IBMXR("DESCR",3)="rejection messages. This index file can immediately locate them."
+12 SET IBMXR("VAL",1)=.03
+13 SET IBMXR("VAL",1,"SUBSCRIPT")=1
+14 SET IBMXR("VAL",1,"COLLATION")="F"
+15 SET IBMXR("VAL",2)=.09
+16 SET IBMXR("VAL",2,"SUBSCRIPT")=2
+17 SET IBMXR("VAL",2,"COLLATION")="F"
+18 ;
+19 DO BMES^XPDUTL(" STEP 2 of 4")
+20 DO MES^XPDUTL("-------------")
+21 DO MES^XPDUTL("A new index will now be created for file 361.")
+22 DO MES^XPDUTL("This may take some time depending on how many entries are in file 361.")
+23 DO CREIXN^DDMOD(.IBMXR,"SW",.IBMRES,"IBMOUT")
+24 IF +$GET(IBMRES)
DO MES^XPDUTL("Index successfully created!")
GOTO ACSAX
+25 ;
+26 ; Index not created
+27 DO MES^XPDUTL("A PROBLEM WAS ENCOUNTERED. INDEX FILE NOT CREATED!!!")
+28 DO MES^XPDUTL("SENDING MAILMAN MESSAGE...")
+29 DO MES^XPDUTL("PLACING THE CSA SCREEN OUT-OF-ORDER.")
+30 NEW XMDUZ,XMSUBJ,XMBODY,MSG,XMTO,DA,DIE,DR
+31 SET XMDUZ=DUZ
SET XMSUBJ="IB*2*283 Error: ACSA index not built"
SET XMBODY="MSG"
+32 SET MSG(1)="The new ""ACSA"" index for file 361 was not created at"
+33 SET MSG(2)=" "
+34 SET MSG(3)=" "_$$SITE^VASITE
+35 SET MSG(4)=" "
+36 SET MSG(5)="The CSA screen has been placed out of order."
+37 ;
+38 ; recipients of message
+39 SET XMTO(DUZ)=""
+40 SET XMTO("eric.gustafson@daou.com")=""
+41 SET XMTO("G.PATCHES")=""
+42 SET XMTO("G.IB EDI")=""
+43 SET XMTO("G.IB EDI SUPERVISOR")=""
+44 ;
+45 DO SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)
+46 ;
+47 ; place CSA screen out of order
+48 SET DA=$ORDER(^DIC(19,"B","IBCE CLAIMS STATUS AWAITING",""))
+49 IF DA
SET DIE=19
SET DR="2///IB Patch 283 Installation Failure"
DO ^DIE
ACSAX ;
+1 DO UPDATE^XPDID(2)
+2 QUIT
+3 ;
AUTOFILE ; Loop through the informational status messages with
+1 ; no Final Review Action and check to see if they qualify for
+2 ; auto-file with no review.
+3 ;
+4 NEW IBDA,IBCNT,IB,Z,STOP,IBAUTO,TXT,NOREVU,IBREV
+5 DO BMES^XPDUTL(" STEP 3 of 4")
+6 DO MES^XPDUTL("-------------")
+7 DO MES^XPDUTL("Now looking at all informational status messages on file to see if any of them")
+8 DO MES^XPDUTL("can be auto-filed with no review needed. Each ""."" represents 1000 messages.")
+9 DO MES^XPDUTL("")
+10 SET IBDA=0
SET IBCNT=0
+11 FOR
SET IBDA=$ORDER(^IBM(361,"ASV","I",IBDA))
if 'IBDA
QUIT
Begin DoDot:1
+12 SET IBCNT=IBCNT+1
if (IBCNT#1000=0)&'$DATA(ZTQUEUED)
WRITE "."
+13 SET IB=$GET(^IBM(361,IBDA,0))
+14 ;
+15 ; final review action exists so quit out
IF $PIECE(IB,U,10)'=""
QUIT
+16 ;
+17 ; if this message was previously auto-filed with no review, then
+18 ; update the final review information and quit out
+19 IF $PIECE(IB,U,9)=2
IF $PIECE(IB,U,14)=1
Begin DoDot:2
+20 NEW DIE,DR,DA
+21 SET DIE=361
SET DR=".1////F"
SET DA=IBDA
DO ^DIE
+22 QUIT
End DoDot:2
QUIT
+23 ;
+24 ; IBAUTO - flag indicating that the whole message can be auto-filed
+25 ; with no review needed
+26 ; NOREVU - flag indicating that one of the message lines had 'No
+27 ; Review Needed' text
+28 ; IBREV - flag indicating that one of the message lines had 'Review
+29 ; Always Needed' text (so the whole message needs review)
+30 ;
+31 SET Z=0
SET STOP=0
SET IBAUTO=0
+32 FOR
SET Z=$ORDER(^IBM(361,IBDA,1,Z))
if 'Z
QUIT
Begin DoDot:2
+33 ; text line Z
SET TXT=$GET(^IBM(361,IBDA,1,Z,0))
if TXT=""
QUIT
+34 ; call function
SET NOREVU=$$CKREVU^IBCEM4(TXT,,,.IBREV)
+35 ; 'review always needed' text found
IF IBREV
SET STOP=1
SET IBAUTO=0
QUIT
+36 ; 'no review needed' text found
IF NOREVU
SET IBAUTO=1
+37 QUIT
End DoDot:2
if STOP
QUIT
+38 ;
+39 IF IBAUTO
Begin DoDot:2
+40 NEW DIE,DR,DA
+41 SET DIE=361
SET DR=".09////2;.14////1;.1////F"
SET DA=IBDA
DO ^DIE
+42 QUIT
End DoDot:2
+43 QUIT
End DoDot:1
+44 ;
+45 DO MES^XPDUTL(" Done.")
+46 DO UPDATE^XPDID(3)
+47 QUIT
+48 ;
PARAM ; Ensure there is a value in IB site parameter field 350.9,8.02
+1 ; "Days to wait to purge messages"
+2 ; If not defined, set it to be 90 days.
+3 ;
+4 NEW A
+5 SET A=$GET(^IBE(350.9,1,8))
+6 DO BMES^XPDUTL(" STEP 4 of 4")
+7 DO MES^XPDUTL("-------------")
+8 ;
+9 ; quit out if field is defined
IF $PIECE(A,U,2)
Begin DoDot:1
+10 DO MES^XPDUTL("IB site parameter value ""Days to wait to purge status messages"" is set to "_$PIECE(A,U,2)_".")
+11 DO MES^XPDUTL(" No changes made.")
+12 QUIT
End DoDot:1
GOTO PARAMX
+13 ;
+14 DO MES^XPDUTL("IB site parameter value ""Days to wait to purge status messages"" is not defined.")
+15 DO MES^XPDUTL("Setting this parameter value to 90 ....")
+16 ; set to 90 days if undefined
SET $PIECE(^IBE(350.9,1,8),U,2)=90
+17 DO MES^XPDUTL(" Done.")
PARAMX ;
+1 DO UPDATE^XPDID(4)
+2 QUIT
+3 ;
