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