Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBY778PR

IBY778PR.m

Go to the documentation of this file.
  1. IBY778PR ;AITC/CKB PRE-Installation for IB patch 778; MAR 18, 2024
  1. ;;2.0;INTEGRATED BILLING;**778**;MAR 21,1994;Build 28
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Reference to ^XPDUTL in ICR #10141
  1. Q
  1. ;
  1. PRE ; pre-install
  1. ;
  1. N IBCT,IBTCT,IBXPD,SITE,SITENAME,SITENUM,XPDIDTOT
  1. ; total number of work items
  1. S XPDIDTOT=2
  1. ;
  1. S SITE=$$SITE^VASITE,SITENAME=$P(SITE,U,2),SITENUM=$P(SITE,U,3)
  1. ;
  1. D MES^XPDUTL("")
  1. ;
  1. D BMES^XPDUTL("PRE-INSTALL for IB*2.0*778 at "_$G(SITENAME)_":"_$G(SITENUM)_" - Starting.")
  1. ;
  1. ; Update IIV TRANSMISSION QUEUE file #365.1 where the TRANSMISSION STATUS is (2)'Transmitted'
  1. ; with the GROUP NUMBER from the Patient record (#2.312)
  1. D TQTIMING(1)
  1. ;
  1. ; Update IIV TRANSMISSION QUEUE file #365.1 entries to add GROUP NUMBER from the Buffer (#355.33)
  1. D UPDTQ(2)
  1. ;
  1. D BMES^XPDUTL("PRE-INSTALL for IB*2.0*778 at "_$G(SITENAME)_":"_$G(SITENUM)_" - Finished.")
  1. D MES^XPDUTL("")
  1. ;
  1. PREX ;
  1. Q
  1. ;============================
  1. ;
  1. 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)
  1. ;
  1. N IBERR,IBGPIEN,IBGRPNUM,IBINSIEN,IBPAT,IBTCT,IBTQDA
  1. S IBXPD=$G(IBXPD),XPDIDTOT=$G(XPDIDTOT)
  1. D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1. D MES^XPDUTL("-------------")
  1. D BMES^XPDUTL("Updating IIV TRANSMISSION QUEUE file (#365.1) entries where the TRANSMSSION")
  1. D MES^XPDUTL(" STATUS is 'Transmitted', with a GROUP NUMBER from the Patient record #2.312.")
  1. ;
  1. S (IBERR,IBTCT)=0
  1. S IBTQDA="" F S IBTQDA=$O(^IBCN(365.1,"AC",2,IBTQDA)) Q:IBTQDA="" D
  1. . ; if WHICH EXTRACT is NOT '2' for 'Appt', quit
  1. . I $$GET1^DIQ(365.1,IBTQDA_",",.1,"I")'=2 Q
  1. . ; if GROUP NUMBER is populated, quit
  1. . I $$GET1^DIQ(365.1,IBTQDA_",",1.03)'="" Q
  1. . ; Get the Group Number from the Patient Record
  1. . D CHKPAT
  1. . ; if CHKPAT returned an error (ie, Patient IEN or Group Number not found), quit
  1. . I IBERR Q
  1. . ;
  1. . ;Add GROUP NUMBER to the entry in the TQ file
  1. . D ADDGRP S IBTCT=IBTCT+1
  1. ;
  1. D BMES^XPDUTL("Number of IIV TRANSMISSION QUEUE file (#365.1) entries updated: "_IBTCT)
  1. D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT_" Complete")
  1. D MES^XPDUTL("---------------------")
  1. Q
  1. ;
  1. 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
  1. ;
  1. ; ** This data converion is needed for the modernization of the Appointment Extract, which now uses the
  1. ; PATIENT/PAYER/SUBSCRIBER ID/GROUP NUMBER. Converting TQ entries to include the GROUP NUMBER **
  1. ;
  1. N IBBUFDA,IBCNDT,IBERR,IBGPIEN,IBGRPNUM,IBINSIEN,IBPAT,IBRESDA,IBTQDA
  1. S IBXPD=$G(IBXPD),XPDIDTOT=$G(XPDIDTOT)
  1. D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1. D MES^XPDUTL("-------------")
  1. D BMES^XPDUTL("Updating IIV TRANSMISSION QUEUE file (#365.1) entries with a GROUP NUMBER")
  1. D MES^XPDUTL(" from the INSURANCE VERIFICATION PROCESSOR file (#355.33).")
  1. ;
  1. S (IBCT,IBERR)=0
  1. S IBCNDT=0 F S IBCNDT=$O(^IBA(355.33,"AEST","E",IBCNDT)) Q:'IBCNDT D
  1. . S IBBUFDA=0 F S IBBUFDA=$O(^IBA(355.33,"AEST","E",IBCNDT,IBBUFDA)) Q:'IBBUFDA D
  1. . . ;Buffer file (#355.33) checks
  1. . . I $G(^IBA(355.33,IBBUFDA,0))="" D Q
  1. . . . ;D BMES^XPDUTL("No 0 node for Buffer #"_IBBUFDA_", not updated.")
  1. . . ; if the STATUS is not 'E' for 'ENTERED, quit
  1. . . I $$GET1^DIQ(355.33,IBBUFDA_",",.04,"I")'="E" D Q ;STATUS
  1. . . . ;D BMES^XPDUTL("The STATUS is NOT 'ENTERED' for Buffer #"_IBBUFDA_", not updated.")
  1. . . ; if the SOI is not '5' for 'eIV', quit
  1. . . I $$GET1^DIQ(355.33,IBBUFDA_",",.03,"I")'=5 D Q ;SOURCE OF INFORMATION
  1. . . . ;D BMES^XPDUTL("The SOI is NOT 'eIV' for Buffer #"_IBBUFDA_", not updated.")
  1. . . S IBGRPNUM=$$GET1^DIQ(355.33,IBBUFDA_",",90.02) ;GROUP NUMBER
  1. . . ;
  1. . . ;Response file (#365) checks
  1. . . ; if the cross-reference 'AF' to the Buffer file doesn't exist, quity
  1. . . I '$D(^IBCN(365,"AF",IBBUFDA)) D Q
  1. . . . ;D BMES^XPDUTL("No 'AF' cross-ref for Buffer #"_IBBUFDA_", not updated.")
  1. . . ; Get IIV RESPONSE file (#365) IEN
  1. . . S IBRESDA=$O(^IBCN(365,"AF",IBBUFDA,""))
  1. . . ; if Response IEN is null, do not continue
  1. . . I IBRESDA="" D Q
  1. . . . ;D BMES^XPDUTL("There is no Response IEN associated with Buffer #"_IBBUFDA_", not updated.")
  1. . . ; Get the TQ IEN from the IIV RESPONSE file
  1. . . S IBTQDA=$$GET1^DIQ(365,IBRESDA_",",.05,"I")
  1. . . ; if the TQ IEN does not exist, quit
  1. . . I IBTQDA="" D Q
  1. . . . ;D BMES^XPDUTL("There is no TQ IEN associated with Response #"_IBRESDA_", not updated.")
  1. . . ;
  1. . . ;TQ file (#365.1) checks
  1. . . ; if WHICH EXTRACT is '4' for 'EICD', quit
  1. . . I $$GET1^DIQ(365.1,IBTQDA_",",.1,"I")=4 D Q
  1. . . . ;D BMES^XPDUTL("This entry was created by the EICD extract for TQ #"_IBTQDA_", not updated.")
  1. . . ; if GROUP NUMBER is populated, quit
  1. . . I $$GET1^DIQ(365.1,IBTQDA_",",1.03)'="" D Q
  1. . . . ;D BMES^XPDUTL("Group Number is already populated for TQ #"_IBTQDA_", not updated.")
  1. . . ;
  1. . . ;Check Patient Record for a Group Number on file
  1. . . D CHKPAT
  1. . . ; if CHKPAT returned an error (ie, Patient IEN or Group Number not found), quit
  1. . . I IBERR Q
  1. . . ;
  1. . . ;Add GROUP NUMBER to the entry in the TQ file
  1. . . D ADDGRP S IBCT=IBCT+1
  1. . . ;D BMES^XPDUTL("Group Number "_IBGRPNUM_" was added to TQ #"_IBTQDA_", entry updated.")
  1. . . Q
  1. ;
  1. D BMES^XPDUTL("Number of entries in the IIV TRANSMISSION QUEUE file (#365.1) updated: "_IBCT)
  1. D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT_" Complete")
  1. D MES^XPDUTL("---------------------")
  1. Q
  1. ;
  1. CHKPAT ; Check the Patient Record for existence of a Group Number
  1. ;Get the Patient IEN
  1. S IBPAT=$$GET1^DIQ(365.1,IBTQDA_",",.02,"I")
  1. ; if the Patient IEN does not exist, quit
  1. I IBPAT="" D S IBERR=1 Q
  1. . ;D BMES^XPDUTL("The Patient IEN is NOT populated for TQ #"_IBTQDA_".")
  1. ;
  1. ;Get the Patient INSUR RECORD IEN
  1. S IBINSIEN=$$GET1^DIQ(365.1,IBTQDA_",",.13)
  1. ; if the INSUR RECORD IEN does not exist, quit
  1. I IBINSIEN="" D S IBERR=1 Q
  1. . ;D BMES^XPDUTL("The Insurance IEN is NOT populated for TQ #"_IBTQDA_".")
  1. ; if the Patient INSUR RECORD IEN isn't valid, quit
  1. I '$D(^DPT(IBPAT,.312,IBINSIEN)) D S IBERR=1 Q
  1. . ;D BMES^XPDUTL("The Insurance IEN "_IBINSIEN_" is NOT valid Patient #"_IBPAT_", TQ #"_IBTQDA_".")
  1. ;
  1. ;Get GROUP PLAN IEN from file #2.312
  1. S IBGPIEN=$$GET1^DIQ(2.312,IBINSIEN_","_IBPAT_",",.18,"I")
  1. ; if the GROUP PLAN IEN does not exist, quit
  1. I IBGPIEN="" D S IBERR=1 Q
  1. . ;D BMES^XPDUTL("The Group Plan IEN is NOT populated for "_IBPAT_"-"_IBINSIEN_", TQ #"_IBTQDA_".")
  1. ;
  1. ;Reset IBGRPNUM, if the GROUP NUMBER is populated in the Patient record (#355.3)
  1. I $$GET1^DIQ(355.3,IBGPIEN_",",2.02,"E")'="" S IBGRPNUM=$$GET1^DIQ(355.3,IBGPIEN_",",2.02,"E")
  1. Q
  1. ;
  1. ADDGRP ;Add GROUP NUMBER (#1.03) to the entry in the TQ file (#365.1)
  1. N DA,DIE,DR
  1. S DR="1.03///"_IBGRPNUM
  1. S DA=IBTQDA,DIE="^IBCN(365.1," D ^DIE
  1. ;D BMES^XPDUTL("Group Number "_IBGRPNUM_" was added to TQ #"_IBTQDA_".") ;****for testing
  1. Q