IBY506PO.m

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 ---IBY506PO   4588     printed  Mar 13, 2025@21:39:31                                                                                                                                                                                                    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