IBY778PR ;AITC/CKB PRE-Installation for IB patch 778; MAR 18, 2024
;;2.0;INTEGRATED BILLING;**778**;MAR 21,1994;Build 28
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to ^XPDUTL in ICR #10141
Q
;
PRE ; pre-install
;
N IBCT,IBTCT,IBXPD,SITE,SITENAME,SITENUM,XPDIDTOT
; total number of work items
S XPDIDTOT=2
;
S SITE=$$SITE^VASITE,SITENAME=$P(SITE,U,2),SITENUM=$P(SITE,U,3)
;
D MES^XPDUTL("")
;
D BMES^XPDUTL("PRE-INSTALL for IB*2.0*778 at "_$G(SITENAME)_":"_$G(SITENUM)_" - Starting.")
;
; Update IIV TRANSMISSION QUEUE file #365.1 where the TRANSMISSION STATUS is (2)'Transmitted'
; with the GROUP NUMBER from the Patient record (#2.312)
D TQTIMING(1)
;
; Update IIV TRANSMISSION QUEUE file #365.1 entries to add GROUP NUMBER from the Buffer (#355.33)
D UPDTQ(2)
;
D BMES^XPDUTL("PRE-INSTALL for IB*2.0*778 at "_$G(SITENAME)_":"_$G(SITENUM)_" - Finished.")
D MES^XPDUTL("")
;
PREX ;
Q
;============================
;
TQTIMING(IBXPD) ; Update the entries in the TQ file #365.1 where the TRANSMISSION STATUS (#.04)
; is set to (2)'Transmitted' with the GROUP NUMBER from the Patient record (#2.312)
;
N IBERR,IBGPIEN,IBGRPNUM,IBINSIEN,IBPAT,IBTCT,IBTQDA
S IBXPD=$G(IBXPD),XPDIDTOT=$G(XPDIDTOT)
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D BMES^XPDUTL("Updating IIV TRANSMISSION QUEUE file (#365.1) entries where the TRANSMSSION")
D MES^XPDUTL(" STATUS is 'Transmitted', with a GROUP NUMBER from the Patient record #2.312.")
;
S (IBERR,IBTCT)=0
S IBTQDA="" F S IBTQDA=$O(^IBCN(365.1,"AC",2,IBTQDA)) Q:IBTQDA="" D
. ; if WHICH EXTRACT is NOT '2' for 'Appt', quit
. I $$GET1^DIQ(365.1,IBTQDA_",",.1,"I")'=2 Q
. ; if GROUP NUMBER is populated, quit
. I $$GET1^DIQ(365.1,IBTQDA_",",1.03)'="" Q
. ; Get the Group Number from the Patient Record
. D CHKPAT
. ; if CHKPAT returned an error (ie, Patient IEN or Group Number not found), quit
. I IBERR Q
. ;
. ;Add GROUP NUMBER to the entry in the TQ file
. D ADDGRP S IBTCT=IBTCT+1
;
D BMES^XPDUTL("Number of IIV TRANSMISSION QUEUE file (#365.1) entries updated: "_IBTCT)
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT_" Complete")
D MES^XPDUTL("---------------------")
Q
;
UPDTQ(IBXPD) ; Update the entries in the TQ file #365.1 to include the GROUP NUMBER #1.03
; get the GROUP NUMBER from the corresponding Buffer #355.33 entry when possible
;
; ** This data converion is needed for the modernization of the Appointment Extract, which now uses the
; PATIENT/PAYER/SUBSCRIBER ID/GROUP NUMBER. Converting TQ entries to include the GROUP NUMBER **
;
N IBBUFDA,IBCNDT,IBERR,IBGPIEN,IBGRPNUM,IBINSIEN,IBPAT,IBRESDA,IBTQDA
S IBXPD=$G(IBXPD),XPDIDTOT=$G(XPDIDTOT)
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D BMES^XPDUTL("Updating IIV TRANSMISSION QUEUE file (#365.1) entries with a GROUP NUMBER")
D MES^XPDUTL(" from the INSURANCE VERIFICATION PROCESSOR file (#355.33).")
;
S (IBCT,IBERR)=0
S IBCNDT=0 F S IBCNDT=$O(^IBA(355.33,"AEST","E",IBCNDT)) Q:'IBCNDT D
. S IBBUFDA=0 F S IBBUFDA=$O(^IBA(355.33,"AEST","E",IBCNDT,IBBUFDA)) Q:'IBBUFDA D
. . ;Buffer file (#355.33) checks
. . I $G(^IBA(355.33,IBBUFDA,0))="" D Q
. . . ;D BMES^XPDUTL("No 0 node for Buffer #"_IBBUFDA_", not updated.")
. . ; if the STATUS is not 'E' for 'ENTERED, quit
. . I $$GET1^DIQ(355.33,IBBUFDA_",",.04,"I")'="E" D Q ;STATUS
. . . ;D BMES^XPDUTL("The STATUS is NOT 'ENTERED' for Buffer #"_IBBUFDA_", not updated.")
. . ; if the SOI is not '5' for 'eIV', quit
. . I $$GET1^DIQ(355.33,IBBUFDA_",",.03,"I")'=5 D Q ;SOURCE OF INFORMATION
. . . ;D BMES^XPDUTL("The SOI is NOT 'eIV' for Buffer #"_IBBUFDA_", not updated.")
. . S IBGRPNUM=$$GET1^DIQ(355.33,IBBUFDA_",",90.02) ;GROUP NUMBER
. . ;
. . ;Response file (#365) checks
. . ; if the cross-reference 'AF' to the Buffer file doesn't exist, quity
. . I '$D(^IBCN(365,"AF",IBBUFDA)) D Q
. . . ;D BMES^XPDUTL("No 'AF' cross-ref for Buffer #"_IBBUFDA_", not updated.")
. . ; Get IIV RESPONSE file (#365) IEN
. . S IBRESDA=$O(^IBCN(365,"AF",IBBUFDA,""))
. . ; if Response IEN is null, do not continue
. . I IBRESDA="" D Q
. . . ;D BMES^XPDUTL("There is no Response IEN associated with Buffer #"_IBBUFDA_", not updated.")
. . ; Get the TQ IEN from the IIV RESPONSE file
. . S IBTQDA=$$GET1^DIQ(365,IBRESDA_",",.05,"I")
. . ; if the TQ IEN does not exist, quit
. . I IBTQDA="" D Q
. . . ;D BMES^XPDUTL("There is no TQ IEN associated with Response #"_IBRESDA_", not updated.")
. . ;
. . ;TQ file (#365.1) checks
. . ; if WHICH EXTRACT is '4' for 'EICD', quit
. . I $$GET1^DIQ(365.1,IBTQDA_",",.1,"I")=4 D Q
. . . ;D BMES^XPDUTL("This entry was created by the EICD extract for TQ #"_IBTQDA_", not updated.")
. . ; if GROUP NUMBER is populated, quit
. . I $$GET1^DIQ(365.1,IBTQDA_",",1.03)'="" D Q
. . . ;D BMES^XPDUTL("Group Number is already populated for TQ #"_IBTQDA_", not updated.")
. . ;
. . ;Check Patient Record for a Group Number on file
. . D CHKPAT
. . ; if CHKPAT returned an error (ie, Patient IEN or Group Number not found), quit
. . I IBERR Q
. . ;
. . ;Add GROUP NUMBER to the entry in the TQ file
. . D ADDGRP S IBCT=IBCT+1
. . ;D BMES^XPDUTL("Group Number "_IBGRPNUM_" was added to TQ #"_IBTQDA_", entry updated.")
. . Q
;
D BMES^XPDUTL("Number of entries in the IIV TRANSMISSION QUEUE file (#365.1) updated: "_IBCT)
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT_" Complete")
D MES^XPDUTL("---------------------")
Q
;
CHKPAT ; Check the Patient Record for existence of a Group Number
;Get the Patient IEN
S IBPAT=$$GET1^DIQ(365.1,IBTQDA_",",.02,"I")
; if the Patient IEN does not exist, quit
I IBPAT="" D S IBERR=1 Q
. ;D BMES^XPDUTL("The Patient IEN is NOT populated for TQ #"_IBTQDA_".")
;
;Get the Patient INSUR RECORD IEN
S IBINSIEN=$$GET1^DIQ(365.1,IBTQDA_",",.13)
; if the INSUR RECORD IEN does not exist, quit
I IBINSIEN="" D S IBERR=1 Q
. ;D BMES^XPDUTL("The Insurance IEN is NOT populated for TQ #"_IBTQDA_".")
; if the Patient INSUR RECORD IEN isn't valid, quit
I '$D(^DPT(IBPAT,.312,IBINSIEN)) D S IBERR=1 Q
. ;D BMES^XPDUTL("The Insurance IEN "_IBINSIEN_" is NOT valid Patient #"_IBPAT_", TQ #"_IBTQDA_".")
;
;Get GROUP PLAN IEN from file #2.312
S IBGPIEN=$$GET1^DIQ(2.312,IBINSIEN_","_IBPAT_",",.18,"I")
; if the GROUP PLAN IEN does not exist, quit
I IBGPIEN="" D S IBERR=1 Q
. ;D BMES^XPDUTL("The Group Plan IEN is NOT populated for "_IBPAT_"-"_IBINSIEN_", TQ #"_IBTQDA_".")
;
;Reset IBGRPNUM, if the GROUP NUMBER is populated in the Patient record (#355.3)
I $$GET1^DIQ(355.3,IBGPIEN_",",2.02,"E")'="" S IBGRPNUM=$$GET1^DIQ(355.3,IBGPIEN_",",2.02,"E")
Q
;
ADDGRP ;Add GROUP NUMBER (#1.03) to the entry in the TQ file (#365.1)
N DA,DIE,DR
S DR="1.03///"_IBGRPNUM
S DA=IBTQDA,DIE="^IBCN(365.1," D ^DIE
;D BMES^XPDUTL("Group Number "_IBGRPNUM_" was added to TQ #"_IBTQDA_".") ;****for testing
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY778PR 7121 printed Dec 13, 2024@02:35:29 Page 2
IBY778PR ;AITC/CKB PRE-Installation for IB patch 778; MAR 18, 2024
+1 ;;2.0;INTEGRATED BILLING;**778**;MAR 21,1994;Build 28
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to ^XPDUTL in ICR #10141
+5 QUIT
+6 ;
PRE ; pre-install
+1 ;
+2 NEW IBCT,IBTCT,IBXPD,SITE,SITENAME,SITENUM,XPDIDTOT
+3 ; total number of work items
+4 SET XPDIDTOT=2
+5 ;
+6 SET SITE=$$SITE^VASITE
SET SITENAME=$PIECE(SITE,U,2)
SET SITENUM=$PIECE(SITE,U,3)
+7 ;
+8 DO MES^XPDUTL("")
+9 ;
+10 DO BMES^XPDUTL("PRE-INSTALL for IB*2.0*778 at "_$GET(SITENAME)_":"_$GET(SITENUM)_" - Starting.")
+11 ;
+12 ; Update IIV TRANSMISSION QUEUE file #365.1 where the TRANSMISSION STATUS is (2)'Transmitted'
+13 ; with the GROUP NUMBER from the Patient record (#2.312)
+14 DO TQTIMING(1)
+15 ;
+16 ; Update IIV TRANSMISSION QUEUE file #365.1 entries to add GROUP NUMBER from the Buffer (#355.33)
+17 DO UPDTQ(2)
+18 ;
+19 DO BMES^XPDUTL("PRE-INSTALL for IB*2.0*778 at "_$GET(SITENAME)_":"_$GET(SITENUM)_" - Finished.")
+20 DO MES^XPDUTL("")
+21 ;
PREX ;
+1 QUIT
+2 ;============================
+3 ;
TQTIMING(IBXPD) ; Update the entries in the TQ file #365.1 where the TRANSMISSION STATUS (#.04)
+1 ; is set to (2)'Transmitted' with the GROUP NUMBER from the Patient record (#2.312)
+2 ;
+3 NEW IBERR,IBGPIEN,IBGRPNUM,IBINSIEN,IBPAT,IBTCT,IBTQDA
+4 SET IBXPD=$GET(IBXPD)
SET XPDIDTOT=$GET(XPDIDTOT)
+5 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+6 DO MES^XPDUTL("-------------")
+7 DO BMES^XPDUTL("Updating IIV TRANSMISSION QUEUE file (#365.1) entries where the TRANSMSSION")
+8 DO MES^XPDUTL(" STATUS is 'Transmitted', with a GROUP NUMBER from the Patient record #2.312.")
+9 ;
+10 SET (IBERR,IBTCT)=0
+11 SET IBTQDA=""
FOR
SET IBTQDA=$ORDER(^IBCN(365.1,"AC",2,IBTQDA))
if IBTQDA=""
QUIT
Begin DoDot:1
+12 ; if WHICH EXTRACT is NOT '2' for 'Appt', quit
+13 IF $$GET1^DIQ(365.1,IBTQDA_",",.1,"I")'=2
QUIT
+14 ; if GROUP NUMBER is populated, quit
+15 IF $$GET1^DIQ(365.1,IBTQDA_",",1.03)'=""
QUIT
+16 ; Get the Group Number from the Patient Record
+17 DO CHKPAT
+18 ; if CHKPAT returned an error (ie, Patient IEN or Group Number not found), quit
+19 IF IBERR
QUIT
+20 ;
+21 ;Add GROUP NUMBER to the entry in the TQ file
+22 DO ADDGRP
SET IBTCT=IBTCT+1
End DoDot:1
+23 ;
+24 DO BMES^XPDUTL("Number of IIV TRANSMISSION QUEUE file (#365.1) entries updated: "_IBTCT)
+25 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT_" Complete")
+26 DO MES^XPDUTL("---------------------")
+27 QUIT
+28 ;
UPDTQ(IBXPD) ; Update the entries in the TQ file #365.1 to include the GROUP NUMBER #1.03
+1 ; get the GROUP NUMBER from the corresponding Buffer #355.33 entry when possible
+2 ;
+3 ; ** This data converion is needed for the modernization of the Appointment Extract, which now uses the
+4 ; PATIENT/PAYER/SUBSCRIBER ID/GROUP NUMBER. Converting TQ entries to include the GROUP NUMBER **
+5 ;
+6 NEW IBBUFDA,IBCNDT,IBERR,IBGPIEN,IBGRPNUM,IBINSIEN,IBPAT,IBRESDA,IBTQDA
+7 SET IBXPD=$GET(IBXPD)
SET XPDIDTOT=$GET(XPDIDTOT)
+8 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+9 DO MES^XPDUTL("-------------")
+10 DO BMES^XPDUTL("Updating IIV TRANSMISSION QUEUE file (#365.1) entries with a GROUP NUMBER")
+11 DO MES^XPDUTL(" from the INSURANCE VERIFICATION PROCESSOR file (#355.33).")
+12 ;
+13 SET (IBCT,IBERR)=0
+14 SET IBCNDT=0
FOR
SET IBCNDT=$ORDER(^IBA(355.33,"AEST","E",IBCNDT))
if 'IBCNDT
QUIT
Begin DoDot:1
+15 SET IBBUFDA=0
FOR
SET IBBUFDA=$ORDER(^IBA(355.33,"AEST","E",IBCNDT,IBBUFDA))
if 'IBBUFDA
QUIT
Begin DoDot:2
+16 ;Buffer file (#355.33) checks
+17 IF $GET(^IBA(355.33,IBBUFDA,0))=""
Begin DoDot:3
+18 ;D BMES^XPDUTL("No 0 node for Buffer #"_IBBUFDA_", not updated.")
End DoDot:3
QUIT
+19 ; if the STATUS is not 'E' for 'ENTERED, quit
+20 ;STATUS
IF $$GET1^DIQ(355.33,IBBUFDA_",",.04,"I")'="E"
Begin DoDot:3
+21 ;D BMES^XPDUTL("The STATUS is NOT 'ENTERED' for Buffer #"_IBBUFDA_", not updated.")
End DoDot:3
QUIT
+22 ; if the SOI is not '5' for 'eIV', quit
+23 ;SOURCE OF INFORMATION
IF $$GET1^DIQ(355.33,IBBUFDA_",",.03,"I")'=5
Begin DoDot:3
+24 ;D BMES^XPDUTL("The SOI is NOT 'eIV' for Buffer #"_IBBUFDA_", not updated.")
End DoDot:3
QUIT
+25 ;GROUP NUMBER
SET IBGRPNUM=$$GET1^DIQ(355.33,IBBUFDA_",",90.02)
+26 ;
+27 ;Response file (#365) checks
+28 ; if the cross-reference 'AF' to the Buffer file doesn't exist, quity
+29 IF '$DATA(^IBCN(365,"AF",IBBUFDA))
Begin DoDot:3
+30 ;D BMES^XPDUTL("No 'AF' cross-ref for Buffer #"_IBBUFDA_", not updated.")
End DoDot:3
QUIT
+31 ; Get IIV RESPONSE file (#365) IEN
+32 SET IBRESDA=$ORDER(^IBCN(365,"AF",IBBUFDA,""))
+33 ; if Response IEN is null, do not continue
+34 IF IBRESDA=""
Begin DoDot:3
+35 ;D BMES^XPDUTL("There is no Response IEN associated with Buffer #"_IBBUFDA_", not updated.")
End DoDot:3
QUIT
+36 ; Get the TQ IEN from the IIV RESPONSE file
+37 SET IBTQDA=$$GET1^DIQ(365,IBRESDA_",",.05,"I")
+38 ; if the TQ IEN does not exist, quit
+39 IF IBTQDA=""
Begin DoDot:3
+40 ;D BMES^XPDUTL("There is no TQ IEN associated with Response #"_IBRESDA_", not updated.")
End DoDot:3
QUIT
+41 ;
+42 ;TQ file (#365.1) checks
+43 ; if WHICH EXTRACT is '4' for 'EICD', quit
+44 IF $$GET1^DIQ(365.1,IBTQDA_",",.1,"I")=4
Begin DoDot:3
+45 ;D BMES^XPDUTL("This entry was created by the EICD extract for TQ #"_IBTQDA_", not updated.")
End DoDot:3
QUIT
+46 ; if GROUP NUMBER is populated, quit
+47 IF $$GET1^DIQ(365.1,IBTQDA_",",1.03)'=""
Begin DoDot:3
+48 ;D BMES^XPDUTL("Group Number is already populated for TQ #"_IBTQDA_", not updated.")
End DoDot:3
QUIT
+49 ;
+50 ;Check Patient Record for a Group Number on file
+51 DO CHKPAT
+52 ; if CHKPAT returned an error (ie, Patient IEN or Group Number not found), quit
+53 IF IBERR
QUIT
+54 ;
+55 ;Add GROUP NUMBER to the entry in the TQ file
+56 DO ADDGRP
SET IBCT=IBCT+1
+57 ;D BMES^XPDUTL("Group Number "_IBGRPNUM_" was added to TQ #"_IBTQDA_", entry updated.")
+58 QUIT
End DoDot:2
End DoDot:1
+59 ;
+60 DO BMES^XPDUTL("Number of entries in the IIV TRANSMISSION QUEUE file (#365.1) updated: "_IBCT)
+61 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT_" Complete")
+62 DO MES^XPDUTL("---------------------")
+63 QUIT
+64 ;
CHKPAT ; Check the Patient Record for existence of a Group Number
+1 ;Get the Patient IEN
+2 SET IBPAT=$$GET1^DIQ(365.1,IBTQDA_",",.02,"I")
+3 ; if the Patient IEN does not exist, quit
+4 IF IBPAT=""
Begin DoDot:1
+5 ;D BMES^XPDUTL("The Patient IEN is NOT populated for TQ #"_IBTQDA_".")
End DoDot:1
SET IBERR=1
QUIT
+6 ;
+7 ;Get the Patient INSUR RECORD IEN
+8 SET IBINSIEN=$$GET1^DIQ(365.1,IBTQDA_",",.13)
+9 ; if the INSUR RECORD IEN does not exist, quit
+10 IF IBINSIEN=""
Begin DoDot:1
+11 ;D BMES^XPDUTL("The Insurance IEN is NOT populated for TQ #"_IBTQDA_".")
End DoDot:1
SET IBERR=1
QUIT
+12 ; if the Patient INSUR RECORD IEN isn't valid, quit
+13 IF '$DATA(^DPT(IBPAT,.312,IBINSIEN))
Begin DoDot:1
+14 ;D BMES^XPDUTL("The Insurance IEN "_IBINSIEN_" is NOT valid Patient #"_IBPAT_", TQ #"_IBTQDA_".")
End DoDot:1
SET IBERR=1
QUIT
+15 ;
+16 ;Get GROUP PLAN IEN from file #2.312
+17 SET IBGPIEN=$$GET1^DIQ(2.312,IBINSIEN_","_IBPAT_",",.18,"I")
+18 ; if the GROUP PLAN IEN does not exist, quit
+19 IF IBGPIEN=""
Begin DoDot:1
+20 ;D BMES^XPDUTL("The Group Plan IEN is NOT populated for "_IBPAT_"-"_IBINSIEN_", TQ #"_IBTQDA_".")
End DoDot:1
SET IBERR=1
QUIT
+21 ;
+22 ;Reset IBGRPNUM, if the GROUP NUMBER is populated in the Patient record (#355.3)
+23 IF $$GET1^DIQ(355.3,IBGPIEN_",",2.02,"E")'=""
SET IBGRPNUM=$$GET1^DIQ(355.3,IBGPIEN_",",2.02,"E")
+24 QUIT
+25 ;
ADDGRP ;Add GROUP NUMBER (#1.03) to the entry in the TQ file (#365.1)
+1 NEW DA,DIE,DR
+2 SET DR="1.03///"_IBGRPNUM
+3 SET DA=IBTQDA
SET DIE="^IBCN(365.1,"
DO ^DIE
+4 ;D BMES^XPDUTL("Group Number "_IBGRPNUM_" was added to TQ #"_IBTQDA_".") ;****for testing
+5 QUIT
