IBY506PO ;ALB/VD - IB*2*506 POST-INSTALL ;23-AUG-2000
;;2.0;INTEGRATED BILLING;**506**;21-MAR-94;Build 74
;;Per VHA Directive 2004-038, this routine should not be modified.
;ICR - 10140
;
EN ;Post Install Routine primary entry point
N IBY,Y,QUIT,ROUT
S QUIT=0
F IBY="BLD","SITEPARM","HOLDLP","NEWSTAT","ESCALATE","UPDATE" D I QUIT Q
. S ROUT=IBY_"^IBY506PO"
. S Y=$$NEWCP^XPDUTL(IBY,ROUT)
. I 'Y D BMES^XPDUTL("ERROR Creating "_IBY_" Checkpoint.") S QUIT=1 Q
Q
;
BLD ; Update ^XUTL("XQORM" for menu protocols. ICR - 10140
N IBX,IBY,X,Y
D MES^XPDUTL("Rebuilding Protocol Menus.")
F IBX="IBCNB LIST SCREEN MENU","IBCNB ENTRY SCREEN MENU" D
.S DIC="^ORD(101,",DIC(0)="F",X=IBX D ^DIC K DIC S IBY=+Y
.I IBY>0 S XQORM=IBY_";ORD(101," D XREF^XQORM
K ORULT,XQORM
Q
;
SITEPARM ; initialize site parameters
; set eIV site parameter # OF RETRIES to "1"
; set eIV site parameter RETRY FLAG to "0" (NO)
; set eIV site parameter FRESHNESS DAYS to "180"
; set eIV site parameter TIMEOUT DAYS to "5"
; set eIV site parameter HL7 RESPONSE PROCESSING to "I" (IMMEDIATE)
D MES^XPDUTL("Reset/Initialize values of eIV site parameters")
N DIE,DA,DR,X,Y
S DIE=350.9,DA=1,DR="51.06///1;51.26///N;51.01///180;51.05///5;51.13///I"
D ^DIE
Q
;
HOLDLP ; loop through all TQ entries that have a status of HOLD and mark them as communication failure.
D MES^XPDUTL("Search through all of the TRANSMISSION QUEUE entries for those having a status")
D MES^XPDUTL("of HOLD and mark them as COMMUNICATION FAILURE.")
N IEN,BUFF,CCODE
S CCODE=$O(^IBE(365.15,"B","C1",""))
; file 365.1, IIV Transmission Queue
S IEN=""
F S IEN=$O(^IBCN(365.1,"AC",4,IEN)) Q:IEN="" D ; node 4 is for only HOLD status.
. S BUFF=$P($G(^IBCN(365.1,IEN,0)),U,5)
. ;
. ; set TQ record to 'communication failure'
. D SST^IBCNEUT2(IEN,5)
. ;
. ; For msg in the Response file set the status to 'Comm Failure'
. D RSTA^IBCNEUT7(IEN)
. ;
. ; Set Buffer symbol to 'C1' (Comm Failure)
. I BUFF'="" D BUFF^IBCNEUT2(BUFF,CCODE) ;set to "#" communication failure
Q
;
NEWSTAT ; add a new code to the IIV STATUS TABLE (#365.15) for COMMUNICATION FAILURE
D MES^XPDUTL("Add a new COMMUNICATION FAILURE code to the IIV STATUS TABLE")
N IBACTN,IBDATA,IBDESC,IBERR,IBIEN
I $D(^IBE(365.15,"B","C1")) D BMES^XPDUTL("*** NEW 'C1' CODE NOT ADDED TO IIV STATUS TABLE...ALREADY EXISTS ***") G NEWSTATX
;
;Set up WP Arrays
S IBDESC("WP",1)="eIV was unable to electronically verify this insurance information"
S IBDESC("WP",2)="due to a communication failure."
;
S IBACTN("WP",1)="Action to take: Contact the insurance company to manually verify"
S IBACTN("WP",2)="this insurance information."
;
;Set up File Nodes
S IBDATA(.01)="C1"
S IBDATA(.02)=35
S IBDATA(.03)=0
S IBDATA(1)=$NA(IBDESC("WP"))
S IBDATA(2)=$NA(IBACTN("WP"))
S IBIEN=$$ADD^IBDFDBS(365.15,,.IBDATA,.IBERR)
I IBERR D BMES^XPDUTL("*** ERROR ADDING 'C1' CODE TO THE IIV STATUS TABLE (#365.15) ***") G NEWSTATX
D BMES^XPDUTL(" NEW 'C1' CODE SUCCESSFULLY ADDED TO IIV STATUS TABLE")
NEWSTATX ;
Q
;
ESCALATE ;Add Escalate Code "$" to the IIV STATUS TABLE (#365.15)
D MES^XPDUTL("Add a new ESCALATE code to the IIV STATUS TABLE")
N IBACTN,IBDATA,IBDESC,IBERR,IBIEN
I $D(^IBE(365.15,"B","E1")) D BMES^XPDUTL("*** NEW 'E1' CODE NOT ADDED TO IIV STATUS TABLE...ALREADY EXISTS ***") G ESCX
;
;Set up WP Arrays
S IBDESC("WP",1)="Information received via electronic inquiry indicates patient has active"
S IBDESC("WP",2)="insurance; however, another verifier did not have the authority to"
S IBDESC("WP",3)="process this entry."
;
S IBACTN("WP",1)="Action to take: Review the details listed in the eIV Response Report"
S IBACTN("WP",2)="before processing this buffer entry."
;
;Set up File Nodes
S IBDATA(.01)="E1"
S IBDATA(.02)=36
S IBDATA(.03)=0
S IBDATA(1)=$NA(IBDESC("WP"))
S IBDATA(2)=$NA(IBACTN("WP"))
S IBIEN=$$ADD^IBDFDBS(365.15,,.IBDATA,.IBERR)
I IBERR D BMES^XPDUTL("*** ERROR ADDING 'E1' CODE TO THE IIV STATUS TABLE (#365.15) ***") G ESCX
D BMES^XPDUTL(" NEW 'E1' CODE SUCCESSFULLY ADDED TO IIV STATUS TABLE")
ESCX ;
Q
;
UPDATE ;Call option to update Insurance Type File
; Schedule through TaskMan to run at night?
N MSG
D MES^XPDUTL("Creating Task to update the Insurance Type File... ")
U IO(0)
UPDATE1 S MSG=$$TASK^IBCNUPD($D(ZTQUEUED)) I MSG["Aborted" D G UPDATE1
. S MSG="You MUST schedule this task in order to continue." D MES^XPDUTL(MSG) H 3
U IO
D BMES^XPDUTL(MSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY506PO 4588 printed Oct 16, 2024@18:34:57 Page 2
IBY506PO ;ALB/VD - IB*2*506 POST-INSTALL ;23-AUG-2000
+1 ;;2.0;INTEGRATED BILLING;**506**;21-MAR-94;Build 74
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;ICR - 10140
+4 ;
EN ;Post Install Routine primary entry point
+1 NEW IBY,Y,QUIT,ROUT
+2 SET QUIT=0
+3 FOR IBY="BLD","SITEPARM","HOLDLP","NEWSTAT","ESCALATE","UPDATE"
Begin DoDot:1
+4 SET ROUT=IBY_"^IBY506PO"
+5 SET Y=$$NEWCP^XPDUTL(IBY,ROUT)
+6 IF 'Y
DO BMES^XPDUTL("ERROR Creating "_IBY_" Checkpoint.")
SET QUIT=1
QUIT
End DoDot:1
IF QUIT
QUIT
+7 QUIT
+8 ;
BLD ; Update ^XUTL("XQORM" for menu protocols. ICR - 10140
+1 NEW IBX,IBY,X,Y
+2 DO MES^XPDUTL("Rebuilding Protocol Menus.")
+3 FOR IBX="IBCNB LIST SCREEN MENU","IBCNB ENTRY SCREEN MENU"
Begin DoDot:1
+4 SET DIC="^ORD(101,"
SET DIC(0)="F"
SET X=IBX
DO ^DIC
KILL DIC
SET IBY=+Y
+5 IF IBY>0
SET XQORM=IBY_";ORD(101,"
DO XREF^XQORM
End DoDot:1
+6 KILL ORULT,XQORM
+7 QUIT
+8 ;
SITEPARM ; initialize site parameters
+1 ; set eIV site parameter # OF RETRIES to "1"
+2 ; set eIV site parameter RETRY FLAG to "0" (NO)
+3 ; set eIV site parameter FRESHNESS DAYS to "180"
+4 ; set eIV site parameter TIMEOUT DAYS to "5"
+5 ; set eIV site parameter HL7 RESPONSE PROCESSING to "I" (IMMEDIATE)
+6 DO MES^XPDUTL("Reset/Initialize values of eIV site parameters")
+7 NEW DIE,DA,DR,X,Y
+8 SET DIE=350.9
SET DA=1
SET DR="51.06///1;51.26///N;51.01///180;51.05///5;51.13///I"
+9 DO ^DIE
+10 QUIT
+11 ;
HOLDLP ; loop through all TQ entries that have a status of HOLD and mark them as communication failure.
+1 DO MES^XPDUTL("Search through all of the TRANSMISSION QUEUE entries for those having a status")
+2 DO MES^XPDUTL("of HOLD and mark them as COMMUNICATION FAILURE.")
+3 NEW IEN,BUFF,CCODE
+4 SET CCODE=$ORDER(^IBE(365.15,"B","C1",""))
+5 ; file 365.1, IIV Transmission Queue
+6 SET IEN=""
+7 ; node 4 is for only HOLD status.
FOR
SET IEN=$ORDER(^IBCN(365.1,"AC",4,IEN))
if IEN=""
QUIT
Begin DoDot:1
+8 SET BUFF=$PIECE($GET(^IBCN(365.1,IEN,0)),U,5)
+9 ;
+10 ; set TQ record to 'communication failure'
+11 DO SST^IBCNEUT2(IEN,5)
+12 ;
+13 ; For msg in the Response file set the status to 'Comm Failure'
+14 DO RSTA^IBCNEUT7(IEN)
+15 ;
+16 ; Set Buffer symbol to 'C1' (Comm Failure)
+17 ;set to "#" communication failure
IF BUFF'=""
DO BUFF^IBCNEUT2(BUFF,CCODE)
End DoDot:1
+18 QUIT
+19 ;
NEWSTAT ; add a new code to the IIV STATUS TABLE (#365.15) for COMMUNICATION FAILURE
+1 DO MES^XPDUTL("Add a new COMMUNICATION FAILURE code to the IIV STATUS TABLE")
+2 NEW IBACTN,IBDATA,IBDESC,IBERR,IBIEN
+3 IF $DATA(^IBE(365.15,"B","C1"))
DO BMES^XPDUTL("*** NEW 'C1' CODE NOT ADDED TO IIV STATUS TABLE...ALREADY EXISTS ***")
GOTO NEWSTATX
+4 ;
+5 ;Set up WP Arrays
+6 SET IBDESC("WP",1)="eIV was unable to electronically verify this insurance information"
+7 SET IBDESC("WP",2)="due to a communication failure."
+8 ;
+9 SET IBACTN("WP",1)="Action to take: Contact the insurance company to manually verify"
+10 SET IBACTN("WP",2)="this insurance information."
+11 ;
+12 ;Set up File Nodes
+13 SET IBDATA(.01)="C1"
+14 SET IBDATA(.02)=35
+15 SET IBDATA(.03)=0
+16 SET IBDATA(1)=$NAME(IBDESC("WP"))
+17 SET IBDATA(2)=$NAME(IBACTN("WP"))
+18 SET IBIEN=$$ADD^IBDFDBS(365.15,,.IBDATA,.IBERR)
+19 IF IBERR
DO BMES^XPDUTL("*** ERROR ADDING 'C1' CODE TO THE IIV STATUS TABLE (#365.15) ***")
GOTO NEWSTATX
+20 DO BMES^XPDUTL(" NEW 'C1' CODE SUCCESSFULLY ADDED TO IIV STATUS TABLE")
NEWSTATX ;
+1 QUIT
+2 ;
ESCALATE ;Add Escalate Code "$" to the IIV STATUS TABLE (#365.15)
+1 DO MES^XPDUTL("Add a new ESCALATE code to the IIV STATUS TABLE")
+2 NEW IBACTN,IBDATA,IBDESC,IBERR,IBIEN
+3 IF $DATA(^IBE(365.15,"B","E1"))
DO BMES^XPDUTL("*** NEW 'E1' CODE NOT ADDED TO IIV STATUS TABLE...ALREADY EXISTS ***")
GOTO ESCX
+4 ;
+5 ;Set up WP Arrays
+6 SET IBDESC("WP",1)="Information received via electronic inquiry indicates patient has active"
+7 SET IBDESC("WP",2)="insurance; however, another verifier did not have the authority to"
+8 SET IBDESC("WP",3)="process this entry."
+9 ;
+10 SET IBACTN("WP",1)="Action to take: Review the details listed in the eIV Response Report"
+11 SET IBACTN("WP",2)="before processing this buffer entry."
+12 ;
+13 ;Set up File Nodes
+14 SET IBDATA(.01)="E1"
+15 SET IBDATA(.02)=36
+16 SET IBDATA(.03)=0
+17 SET IBDATA(1)=$NAME(IBDESC("WP"))
+18 SET IBDATA(2)=$NAME(IBACTN("WP"))
+19 SET IBIEN=$$ADD^IBDFDBS(365.15,,.IBDATA,.IBERR)
+20 IF IBERR
DO BMES^XPDUTL("*** ERROR ADDING 'E1' CODE TO THE IIV STATUS TABLE (#365.15) ***")
GOTO ESCX
+21 DO BMES^XPDUTL(" NEW 'E1' CODE SUCCESSFULLY ADDED TO IIV STATUS TABLE")
ESCX ;
+1 QUIT
+2 ;
UPDATE ;Call option to update Insurance Type File
+1 ; Schedule through TaskMan to run at night?
+2 NEW MSG
+3 DO MES^XPDUTL("Creating Task to update the Insurance Type File... ")
+4 USE IO(0)
UPDATE1 SET MSG=$$TASK^IBCNUPD($DATA(ZTQUEUED))
IF MSG["Aborted"
Begin DoDot:1
+1 SET MSG="You MUST schedule this task in order to continue."
DO MES^XPDUTL(MSG)
HANG 3
End DoDot:1
GOTO UPDATE1
+2 USE IO
+3 DO BMES^XPDUTL(MSG)
+4 QUIT
