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

IBY752PO.m

Go to the documentation of this file.
  1. IBY752PO ;AITC/DTG - Post-Installation for IB patch 752; JAN 18, 2023
  1. ;;2.0;INTEGRATED BILLING;**752**;MAR 21,1994;Build 20
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Reference to $$INSTALDT^XPDUTL in ICR #10141
  1. ; Reference to $$DELETE^XPDMENU in ICR #1157
  1. ;
  1. Q
  1. ;
  1. POST ; POST-INSTALL
  1. N ARRAY,IBINSTLD,IBMES,IBSITE,IBSITENAM,IBXPD,SITE,SITENAME,SITENUM,XPDIDTOT
  1. ; total number of work items
  1. S XPDIDTOT=5
  1. ;
  1. S SITE=$$SITE^VASITE,SITENAME=$P(SITE,U,2),SITENUM=$P(SITE,U,3)
  1. S IBSITE=SITE,IBSITENAM=SITENAME
  1. S IBINSTLD=$$INSTALDT^XPDUTL("IB*2.0*752","")
  1. D MES^XPDUTL("")
  1. ;
  1. D FLDINIT(1) ; Initialize new field to 0 (zero)
  1. ;
  1. D TASK(2) ; Report X12 entries that are not controlled by FSC
  1. ;
  1. D STATUPD(3)
  1. ;
  1. D OPTR(4) ; remove menu options
  1. ;
  1. D SITEREG(5,SITENUM) ; Send site registration message to FSC
  1. ;
  1. D MES^XPDUTL("") ; Displays the 'Done' message and finishes the progress bar
  1. D MES^XPDUTL("POST-Install for IB*2.0*752 Completed.")
  1. Q
  1. ;============================
  1. ;
  1. OPTR(IBXPD) ; Remove options IB OUTPATIENT VET REPORT and IB INPATIENT VET REPORT from IBCN INS RPTS
  1. ;
  1. S IBXPD=$G(IBXPD)
  1. D BMES^XPDUTL(" STEP "_IBXPD_" of "_$G(XPDIDTOT))
  1. D MES^XPDUTL("-------------")
  1. D MES^XPDUTL("Remove options: Veterans w/Insurance and Opt. Visits")
  1. D MES^XPDUTL(" AND Veterans w/Insurance and Inpatient Admissions")
  1. D MES^XPDUTL("From Menu: Insurance Reports ... [IBCN INS RPTS]")
  1. D BMES^XPDUTL(" ")
  1. ;
  1. ; ICR #1157 for the usage of $$DELETE^XPDMENU
  1. ; ICR #10141 for the usage of $$INSTALDT^XPDUTL
  1. ;
  1. N IBMENU,IBNAM,IBRET,IBCHK
  1. S (IBOER,IBCHK)=""
  1. ;
  1. ; [IB OUTPATIENT VET REPORT] (to be removed)
  1. ; [IB INPATIENT VET REPORT] (to be removed)
  1. ; IBCN INS RPTS (menu to be removed from)
  1. ;
  1. ;
  1. F IBNAM="IB OUTPATIENT VET REPORT","IB INPATIENT VET REPORT" S IBMENU="IBCN INS RPTS" D
  1. . ;
  1. . S IBRET=$$DELETE^XPDMENU(IBMENU,IBNAM)
  1. . ;
  1. . I IBRET D BMES^XPDUTL("Option: "_IBNAM_" removed from menu: "_IBMENU) Q
  1. . D BMES^XPDUTL("Option: "_IBNAM_" NOT on menu: "_IBMENU)
  1. ;
  1. OPTRQ ; option remove end point
  1. ;
  1. D BMES^XPDUTL("Options removal from menu process done")
  1. Q
  1. ;
  1. FLDINIT(IBXPD) ; Initialize new FSC CONTROLLED (#file,.05) field to 0 (zero)
  1. D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1. D MES^XPDUTL("-------------")
  1. I ($$PROD^XUPROD(1))&(IBINSTLD) D MES^XPDUTL("Fields have already initialized ... ") G FLDINITQ
  1. D MES^XPDUTL("Initialing new fields ... ")
  1. ;
  1. N ARR,B,DATA,DIERR,FIELD1,FIELD2,FILE,FILENUM,I,IENS
  1. K DATA
  1. F I=11:1:18,21:1:29,31:1:39,41:1:46 S FILE("365.0"_I)=""
  1. S FIELD1=".05",DATA(FIELD1)=0
  1. S FIELD2=".04",DATA(FIELD2)=$$NOW^XLFDT()
  1. S FILENUM=0 F S FILENUM=$O(FILE(FILENUM)) Q:'FILENUM D
  1. . S B=0 F S B=$O(^IBE(FILENUM,B)) Q:'B D
  1. . . S IENS=$$IENS^DILF(B) K ARR
  1. . . I $$GET1^DIQ(FILENUM,IENS,.05,"I")=1 Q ; quit if under FSC control
  1. . . S ARR(FILENUM,IENS,FIELD1)=$G(DATA(FIELD1))
  1. . . S ARR(FILENUM,IENS,FIELD2)=$G(DATA(FIELD2))
  1. . . D FILE^DIE("K","ARR")
  1. . . I +$G(DIERR) D BMES^XPDUTL("Log SNOW Ticket - File #"_FILENUM_"-"_B_" encountered an issue with fields #.04,#.05")
  1. . . ;
  1. D MES^XPDUTL("Finished initializing new fields ... ")
  1. FLDINITQ ;
  1. Q
  1. ;
  1. TASK(IBXPD) ; Report X12 entries that are not controlled by FSC
  1. ;
  1. D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1. D MES^XPDUTL("-------------")
  1. N GTASKS,IBA,IBDATE,IBDIR,IBEMSG,IBER,IBI,IBPROD,IBRET,IBTASK,IO,RMSG,TSK
  1. N ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTIO,ZTQUEUED,ZTREQ,ZTSK
  1. ;
  1. S IBPROD=$$PROD^XUPROD(1),IBDATE=$$FMTE^XLFDT(DT,5),IBER=0
  1. S IBA=$G(IBSITE) N IBSITE S IBSITE=SITENUM
  1. I ($$PROD^XUPROD(1))&(IBINSTLD) D MES^XPDUTL("Report of X12 entries has already been generated ... ") G TASKQ
  1. S IBDIR="IB*752 - report X12 entries not controlled by FSC"
  1. ; Check to see if the task is already running.
  1. K GTASKS
  1. D DESC^%ZTLOAD(IBDIR,"GTASKS")
  1. S (IBTASK,TSK)="",RMSG(0)=0
  1. S TSK=$O(GTASKS(TSK))
  1. I TSK D Q
  1. . D BMES^XPDUTL(" "_IBDIR_" Task "_TSK_" has Already Been Submitted to TASKMAN.")
  1. ; build task out array and task off
  1. S ZTRTN="X12ENTRIES^IBY752PO",ZTDESC=IBDIR,ZTIO=""
  1. ; ZTDTH = 2 days from Today at 8:00 PM
  1. S ZTDTH=($P($$NOW^XLFDT(),".")+2),ZTDTH=$$FMADD^XLFDT(ZTDTH,,20)
  1. F IBI="IBDATE","IBPROD","IBDIR" S ZTSAVE(IBI)=""
  1. K IO("Q"),ZTSK
  1. D ^%ZTLOAD
  1. S IBRET="" S:$D(ZTSK) IBRET=ZTSK
  1. D HOME^%ZIS
  1. ;
  1. I +IBRET S IBMES=IBDIR_" has been submitted to TASKMAN. Task number: "_(+IBRET)
  1. I 'IBRET D
  1. . S IBER=1
  1. . S IBMES=IBDIR_" was NOT successfully submitted to TASKMAN."
  1. D BMES^XPDUTL(" "_IBMES) ;update post install with info
  1. S IBTASK=1 D MESSAGE ;Send email message indicating task submission status.
  1. TASKQ ;
  1. Q
  1. ;
  1. X12ENTRIES ; Build a delimited list of entries where the FSC CONTROLLED
  1. ; field is equal to 0 (zero). Send email to eBiz eInsurance with the info.
  1. N ARRAY,CT,D,FILE,IBBCK,IBSITE,IBSITENAM,IEN,XX
  1. S IBSITE=$$SITE^VASITE ; Get the site name & #
  1. S IBSITENAM=$P(IBSITE,U,2),IBSITE=$P(IBSITE,U,3) ; piece 3 is the site #
  1. ;
  1. K ARRAY S CT=0
  1. F D=11:1:18,21:1:29,31:1:39,41:1:46 S XX("365.0"_D)=""
  1. S FILE=0 F S FILE=$O(XX(FILE)) Q:'FILE S IEN=0 F S IEN=$O(^IBE(FILE,IEN)) Q:'IEN D
  1. . ;Only include entries where field FSC CONTROLLED (#A,.05) is equal to 0 (zero)
  1. . I $$GET1^DIQ(FILE,IEN_",",.05,"I")=0 S CT=CT+1,ARRAY(CT)=FILE_U_^IBE(FILE,IEN,0)
  1. I '$O(ARRAY(0)) S ARRAY(1)="No entries found with 'FSC CONTROLLED' (#.05) equal to zero"
  1. D MESSAGE
  1. Q
  1. ;
  1. MESSAGE ; build and send message to eInsurance
  1. N IBAL,IBC,IBD,IBMSG,IBSUB,IBT,IBXMY,MCT,MSG,SITE
  1. S IBSITENAM=$G(IBSITENAM),IBSITE=$G(IBSITE),IBPROD=$G(IBPROD)
  1. S SITE=IBSITENAM_" (#"_IBSITE_")"
  1. S IBC=$L(SITE)+41 I IBC>64 S IBD=IBC-64,IBT=$E(IBSITENAM,1,($L(IBSITENAM)-IBD)),SITE=IBT_" (#"_IBSITE_")"
  1. S IBSUB=SITE_" IB*752 X12 entries not controlled by FSC"
  1. ;Send mailman message at completion.
  1. S MSG(1)=IBDIR_" at "_IBSITE_" in the "_$S('IBPROD:"NON-",1:"")_"Production Account"
  1. S MSG(2)=" "
  1. S MSG(3)=" "_($S(+$G(IBTASK):"Task"_($S($G(IBER)=1:" Not",1:""))_" Submitted",1:"Run"))_" On: "_IBDATE
  1. S MSG(4)=" --------------------------------------------------------------------------"
  1. S MSG(5)=" "
  1. S IBMSG=5
  1. I $G(IBMES)'="" D
  1. . I '$G(IBER) D
  1. .. F IBAL=1,60 D
  1. ... S IBMSG=IBMSG+1
  1. ... S MSG(IBMSG)=($S(IBAL=60:" ",1:""))_$E(IBMES,IBAL,($S(IBAL=1:59,1:999)))
  1. ... I IBAL=60 S IBMSG=IBMSG+1,MSG(IBMSG)=" "
  1. . I $G(IBER) D
  1. .. F IBAL=1,59 D
  1. ... S IBMSG=IBMSG+1
  1. ... S MSG(IBMSG)=($S(IBAL=59:" ",1:""))_$E(IBMES,IBAL,($S(IBAL=1:58,1:999)))
  1. ... I IBAL=59 S IBMSG=IBMSG+1,MSG(IBMSG)=" "
  1. ;
  1. S MCT=0 F S MCT=$O(ARRAY(MCT)) Q:MCT="" S IBMSG=IBMSG+1,MSG(IBMSG)=ARRAY(MCT)
  1. S IBMSG=IBMSG+1,MSG(IBMSG)=" "
  1. ;
  1. ; Only send to eInsurance Rapid Response if in Production
  1. ; 1=Production Environment, 0=Test Environment
  1. S IBXMY="" I IBPROD&($G(IBTASK)'=1) S IBXMY("VHAeInsuranceRapidResponse@domain.ext")=""
  1. ;
  1. ; send message
  1. D MSG^IBCNEUT5(,IBSUB,"MSG(",,.IBXMY)
  1. ;
  1. ; Tell TaskManager to delete the task's record
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. Q
  1. ;
  1. ;
  1. STATUPD(IBXPD) ; Update the CORRECTIVE ACTION field for 2 entries in the IIV STATUS TABLE FILE (#365.15)
  1. ;
  1. N FIELD,FILE,IENS,TEXT
  1. D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1. D MES^XPDUTL("-------------")
  1. D BMES^XPDUTL("Updating 'Corrective Action' in the IIV STATUS TABLE file (#365.15) for entries B3 & B4")
  1. ;
  1. S FILE=365.15
  1. ;
  1. ;Update DESCRIPTION for status B3
  1. S FIELD=1
  1. S IENS=$$FIND1^DIC(365.15,,,"B3")_","
  1. S TEXT(1)="eIV could not create an inquiry for this entry. eIV matched the insurance"
  1. S TEXT(2)="company name in the Insurance Buffer file (#355.33) to more than one insurance"
  1. S TEXT(3)="company entry with the same name in the Insurance Company file (#36). At"
  1. S TEXT(4)="least one of these matching entries are linked to a different payer."
  1. D WP^DIE(FILE,IENS,FIELD,,"TEXT","ERROR")
  1. ;
  1. ;Update CORRECTIVE ACTION for status B3
  1. S FIELD=2
  1. S IENS=$$FIND1^DIC(365.15,,,"B3")_","
  1. S TEXT(1)="Action to take: Run the ""Ins Company Link Report"" option for all linked"
  1. S TEXT(2)="insurance companies, using the keyword feature to narrow down the search."
  1. S TEXT(3)="This will provide a report showing which payer the different insurance company"
  1. S TEXT(4)="records are linked to. Next, use the ""Insurance Company Entry/Edit"" option"
  1. S TEXT(5)="to correct those insurance companies who are linked to the wrong payer."
  1. D WP^DIE(FILE,IENS,FIELD,,"TEXT","ERROR")
  1. ;
  1. ;Update CORRECTIVE ACTION for status B4
  1. S IENS=$$FIND1^DIC(365.15,,,"B4")_","
  1. S TEXT(1)="Action to take: Either contact the insurance company to manually verify"
  1. S TEXT(2)="this insurance information or link the insurance company to a payer. Steps"
  1. S TEXT(3)="to link an insurance company to a payer are as follows: run the"
  1. S TEXT(4)="""Ins Company Link Report"" option for all unlinked insurance companies. Use"
  1. S TEXT(5)="the keyword feature or select the specific company when running the report"
  1. S TEXT(6)="to narrow down the search. This will provide a report showing which insurance"
  1. S TEXT(7)="companies are not linked to a payer. Next, use the ""Insurance Company"
  1. S TEXT(8)="Entry/Edit"" option to link those insurance companies to the correct payer."
  1. D WP^DIE(FILE,IENS,FIELD,,"TEXT","ERROR")
  1. ;
  1. D BMES^XPDUTL("Status Description successfully updated.")
  1. Q
  1. ;
  1. ;
  1. SITEREG(IBXPD,SITENUM) ; send site registration message to FSC
  1. D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1. D MES^XPDUTL("-------------")
  1. D MES^XPDUTL("Send eIV site registration message to FSC ... ")
  1. ;
  1. I '$$PROD^XUPROD(1) D MES^XPDUTL("N/A - Not a production account - No site registration message sent") G SITEREGQ
  1. I SITENUM=358 D MES^XPDUTL("Current Site is MANILA - NO eIV site registration message sent") G SITEREGQ
  1. D ^IBCNEHLM
  1. D MES^XPDUTL("eIV site registration message was successfully sent")
  1. ;
  1. SITEREGQ ;
  1. Q