- 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 Feb 19, 2025@00:01:57 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