IBY771PO ;AITC/CKB - Post-Installation for IB patch 771; AUG 3, 2023
;;2.0;INTEGRATED BILLING;**771**;MAR 21,1994;Build 26
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to ^XPDUTL in ICR #10141
Q
;
POST ; POST-INSTALL
N IBINSTLD,IBXPD,SITE,SITENAME,SITENUM,XPDIDTOT
; total number of work items
S XPDIDTOT=4
S SITE=$$SITE^VASITE,SITENAME=$P(SITE,U,2),SITENUM=$P(SITE,U,3)
;
D MES^XPDUTL("")
;
; add new report IBCN PT MISSING COVERAGE RPT to IBCN INS RPTS menu
D OPAR(1)
;
; add new report IBCN DAILY BUFFER REPORT to IBCN INS RPTS menu
D OPAR1(2)
;
; Task job to populate new index 'LAST' to PLAN COVERAGE LIMITATIONS file (#355.32) field 1.04
D TASK1(3)
;
; Report X12 entries that are not controlled by FSC
D TASK(4)
;
D MES^XPDUTL("") ; Displays the 'Done' message and finishes the progress bar
D BMES^XPDUTL("POST-Install for IB*2.0*771 Completed.")
Q
;============================
;
;
OPAR(IBXPD) ; add inactive and imbiguous reports to menus
;
S IBXPD=$G(IBXPD)
D BMES^XPDUTL(" STEP "_IBXPD_" of "_$G(XPDIDTOT))
D MES^XPDUTL("-------------")
D BMES^XPDUTL("Add report option: IBCN PT MISSING COVERAGE RPT")
D MES^XPDUTL(" To Menu: IBCN INS RPTS")
D BMES^XPDUTL(" ")
;
; ICR #1157 for the usage of $$ADD^XPDMENU
; ICR #10141 for the usage of $$INSTALDT^XPDUTL
;
N IBMENU,IBNAM,IBOER,IBRET,IBSYN,IBCHK
S IBOER="",IBCHK=""
;
;
S IBOER=0 S IBMENU="IBCN INS RPTS" D
. S IBNAM="IBCN PT MISSING COVERAGE REPT",IBSYN="PC"
. ;
. S IBRET=$$ADD^XPDMENU(IBMENU,IBNAM,IBSYN)
. ;
. I IBRET D MES^XPDUTL("Option: "_IBNAM_" added to menu: "_IBMENU) Q
. S IBOER=1 D MES^XPDUTL("Not able to add Option: "_IBNAM_" to menu: "_IBMENU)
;
OPARQ ; option remove end point
I IBOER'=2 D BMES^XPDUTL("Add report options to menus was"_($S('IBOER:"",1:" not"))_" successful")
Q
;
OPAR1(IBXPD) ; Add Daily Buffer Report to Insurance Reports menu
;
S IBXPD=$G(IBXPD)
D BMES^XPDUTL(" STEP "_IBXPD_" of "_$G(XPDIDTOT))
D MES^XPDUTL("-------------")
D BMES^XPDUTL("Add report option: IBCN DAILY BUFFER REPORT")
D MES^XPDUTL(" To Menu: IBCN INS RPTS")
D BMES^XPDUTL(" ")
;
; ICR #1157 for the usage of $$ADD^XPDMENU
; ICR #10141 for the usage of $$INSTALDT^XPDUTL
;
N IBMENU,IBNAM,IBOER,IBRET,IBSYN,IBCHK
S IBOER="",IBCHK=""
;
;
S IBOER=0 S IBMENU="IBCN INS RPTS" D
. S IBNAM="IBCN DAILY BUFFER REPORT",IBSYN="DB"
. ;
. S IBRET=$$ADD^XPDMENU(IBMENU,IBNAM,IBSYN)
. ;
. I IBRET D MES^XPDUTL("Option: "_IBNAM_" added to menu: "_IBMENU) Q
. S IBOER=1 D MES^XPDUTL("Not able to add Option: "_IBNAM_" to menu: "_IBMENU)
;
OPAR1Q ; option remove end point
D BMES^XPDUTL("Add report options to menus was"_($S('IBOER:"",1:" not"))_" successful")
Q
;
TASK1(IBXPD) ; Task population of index 'LAST' to PLAN COVERAGE LIMITATIONS file (#355.32,1.04)
;
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
N GTASKS,IBDIR,IBRET,IBTASK,IO,RMSG,TSK
N ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTIO,ZTQUEUED,ZTREQ,ZTSK
;
S IBDIR="Populate 'LAST' Index on PLAN COVERAGE LIMITATIONS file (#355.32,1.04)."
; Check to see if the task is already running.
K GTASKS
D DESC^%ZTLOAD(IBDIR,"GTASKS")
S (IBTASK,TSK)=""
S TSK=$O(GTASKS(TSK))
I TSK D G TASK1Q
. D BMES^XPDUTL(" "_IBDIR)
. D BMES^XPDUTL(" Task "_TSK_" has Already Been Submitted to TASKMAN.")
; build task out array and task off
S ZTRTN="NEWINDX^IBY771PO",ZTDESC=IBDIR,ZTIO=""
; ZTDTH = 7 p.m. Local
S ZTDTH=$P($$NOW^XLFDT(),"."),ZTDTH=$$FMADD^XLFDT(ZTDTH,,19)
K IO("Q"),ZTSK
D ^%ZTLOAD
S IBRET="" S:$D(ZTSK) IBRET=ZTSK
D HOME^%ZIS
;
I +IBRET S IBMES=" has been submitted to TASKMAN. Task number: "_(+IBRET)
I 'IBRET D
. S IBMES=" was NOT successfully submitted to TASKMAN."
D BMES^XPDUTL(" "_IBDIR)
D BMES^XPDUTL(" "_IBMES) ;update post install with info
TASK1Q ;
Q
;
NEWINDX ; populate 1.04 field new LAST index in file #355.32
;
N IBMES,IENS,NODE,NOGO
;
S IEN=0
F S IEN=$O(^IBA(355.32,IEN)) Q:'IEN D
. K ARRAY
. S IENS=IEN_",",NOGO=0
. D GETS^DIQ(355.32,IENS,".01;1.03;1.04","I","ARRAY")
. F NODE=.01,1.03,1.04 I $G(ARRAY(355.32,IENS,NODE,"I"))="" S NOGO=1 Q ;Quit this entry if any field is null.
. I NOGO Q
. N DA,DIK
. S DIK(1)="1.04^LAST",DIK="^IBA(355.32,",DA=IEN
. D EN1^DIK
K ARRAY
;
; Tell TaskManager to delete the task's record
I $D(ZTQUEUED) S ZTREQ="@"
;
NEWEXIT ;
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
S IBDIR="IB*771 - 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)
. D BMES^XPDUTL(" Task "_TSK_" has Already Been Submitted to TASKMAN.")
; build task out array and task off
S ZTRTN="X12ENTRIES^IBY771PO",ZTDESC=IBDIR,ZTIO=""
; ZTDTH = Now
S ZTDTH=$$NOW^XLFDT()
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=" has been submitted to TASKMAN. Task number: "_(+IBRET)
I 'IBRET D
. S IBER=1
. S IBMES=" was NOT successfully submitted to TASKMAN."
D BMES^XPDUTL(" "_IBDIR)
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 D
. S FILE="365.0"_D,IEN=0
. F S IEN=$O(^IBE(FILE,IEN)) Q:'IEN D
.. N DATA,IENS
.. S IENS=IEN_","
.. ;Only include entries where field FSC CONTROLLED (#.05) is equal to 0 (zero) AND DESCRIPTION (#.02)="OTHER"
.. D GETS^DIQ(FILE,IENS,".02;.05","I","DATA")
.. I DATA(FILE,IENS,.02,"I")="OTHER",DATA(FILE,IENS,.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*771 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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY771PO 8345 printed Dec 13, 2024@02:35:27 Page 2
IBY771PO ;AITC/CKB - Post-Installation for IB patch 771; AUG 3, 2023
+1 ;;2.0;INTEGRATED BILLING;**771**;MAR 21,1994;Build 26
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to ^XPDUTL in ICR #10141
+5 QUIT
+6 ;
POST ; POST-INSTALL
+1 NEW IBINSTLD,IBXPD,SITE,SITENAME,SITENUM,XPDIDTOT
+2 ; total number of work items
+3 SET XPDIDTOT=4
+4 SET SITE=$$SITE^VASITE
SET SITENAME=$PIECE(SITE,U,2)
SET SITENUM=$PIECE(SITE,U,3)
+5 ;
+6 DO MES^XPDUTL("")
+7 ;
+8 ; add new report IBCN PT MISSING COVERAGE RPT to IBCN INS RPTS menu
+9 DO OPAR(1)
+10 ;
+11 ; add new report IBCN DAILY BUFFER REPORT to IBCN INS RPTS menu
+12 DO OPAR1(2)
+13 ;
+14 ; Task job to populate new index 'LAST' to PLAN COVERAGE LIMITATIONS file (#355.32) field 1.04
+15 DO TASK1(3)
+16 ;
+17 ; Report X12 entries that are not controlled by FSC
+18 DO TASK(4)
+19 ;
+20 ; Displays the 'Done' message and finishes the progress bar
DO MES^XPDUTL("")
+21 DO BMES^XPDUTL("POST-Install for IB*2.0*771 Completed.")
+22 QUIT
+23 ;============================
+24 ;
+25 ;
OPAR(IBXPD) ; add inactive and imbiguous reports to menus
+1 ;
+2 SET IBXPD=$GET(IBXPD)
+3 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_$GET(XPDIDTOT))
+4 DO MES^XPDUTL("-------------")
+5 DO BMES^XPDUTL("Add report option: IBCN PT MISSING COVERAGE RPT")
+6 DO MES^XPDUTL(" To Menu: IBCN INS RPTS")
+7 DO BMES^XPDUTL(" ")
+8 ;
+9 ; ICR #1157 for the usage of $$ADD^XPDMENU
+10 ; ICR #10141 for the usage of $$INSTALDT^XPDUTL
+11 ;
+12 NEW IBMENU,IBNAM,IBOER,IBRET,IBSYN,IBCHK
+13 SET IBOER=""
SET IBCHK=""
+14 ;
+15 ;
+16 SET IBOER=0
SET IBMENU="IBCN INS RPTS"
Begin DoDot:1
+17 SET IBNAM="IBCN PT MISSING COVERAGE REPT"
SET IBSYN="PC"
+18 ;
+19 SET IBRET=$$ADD^XPDMENU(IBMENU,IBNAM,IBSYN)
+20 ;
+21 IF IBRET
DO MES^XPDUTL("Option: "_IBNAM_" added to menu: "_IBMENU)
QUIT
+22 SET IBOER=1
DO MES^XPDUTL("Not able to add Option: "_IBNAM_" to menu: "_IBMENU)
End DoDot:1
+23 ;
OPARQ ; option remove end point
+1 IF IBOER'=2
DO BMES^XPDUTL("Add report options to menus was"_($SELECT('IBOER:"",1:" not"))_" successful")
+2 QUIT
+3 ;
OPAR1(IBXPD) ; Add Daily Buffer Report to Insurance Reports menu
+1 ;
+2 SET IBXPD=$GET(IBXPD)
+3 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_$GET(XPDIDTOT))
+4 DO MES^XPDUTL("-------------")
+5 DO BMES^XPDUTL("Add report option: IBCN DAILY BUFFER REPORT")
+6 DO MES^XPDUTL(" To Menu: IBCN INS RPTS")
+7 DO BMES^XPDUTL(" ")
+8 ;
+9 ; ICR #1157 for the usage of $$ADD^XPDMENU
+10 ; ICR #10141 for the usage of $$INSTALDT^XPDUTL
+11 ;
+12 NEW IBMENU,IBNAM,IBOER,IBRET,IBSYN,IBCHK
+13 SET IBOER=""
SET IBCHK=""
+14 ;
+15 ;
+16 SET IBOER=0
SET IBMENU="IBCN INS RPTS"
Begin DoDot:1
+17 SET IBNAM="IBCN DAILY BUFFER REPORT"
SET IBSYN="DB"
+18 ;
+19 SET IBRET=$$ADD^XPDMENU(IBMENU,IBNAM,IBSYN)
+20 ;
+21 IF IBRET
DO MES^XPDUTL("Option: "_IBNAM_" added to menu: "_IBMENU)
QUIT
+22 SET IBOER=1
DO MES^XPDUTL("Not able to add Option: "_IBNAM_" to menu: "_IBMENU)
End DoDot:1
+23 ;
OPAR1Q ; option remove end point
+1 DO BMES^XPDUTL("Add report options to menus was"_($SELECT('IBOER:"",1:" not"))_" successful")
+2 QUIT
+3 ;
TASK1(IBXPD) ; Task population of index 'LAST' to PLAN COVERAGE LIMITATIONS file (#355.32,1.04)
+1 ;
+2 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 NEW GTASKS,IBDIR,IBRET,IBTASK,IO,RMSG,TSK
+5 NEW ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTIO,ZTQUEUED,ZTREQ,ZTSK
+6 ;
+7 SET IBDIR="Populate 'LAST' Index on PLAN COVERAGE LIMITATIONS file (#355.32,1.04)."
+8 ; Check to see if the task is already running.
+9 KILL GTASKS
+10 DO DESC^%ZTLOAD(IBDIR,"GTASKS")
+11 SET (IBTASK,TSK)=""
+12 SET TSK=$ORDER(GTASKS(TSK))
+13 IF TSK
Begin DoDot:1
+14 DO BMES^XPDUTL(" "_IBDIR)
+15 DO BMES^XPDUTL(" Task "_TSK_" has Already Been Submitted to TASKMAN.")
End DoDot:1
GOTO TASK1Q
+16 ; build task out array and task off
+17 SET ZTRTN="NEWINDX^IBY771PO"
SET ZTDESC=IBDIR
SET ZTIO=""
+18 ; ZTDTH = 7 p.m. Local
+19 SET ZTDTH=$PIECE($$NOW^XLFDT(),".")
SET ZTDTH=$$FMADD^XLFDT(ZTDTH,,19)
+20 KILL IO("Q"),ZTSK
+21 DO ^%ZTLOAD
+22 SET IBRET=""
if $DATA(ZTSK)
SET IBRET=ZTSK
+23 DO HOME^%ZIS
+24 ;
+25 IF +IBRET
SET IBMES=" has been submitted to TASKMAN. Task number: "_(+IBRET)
+26 IF 'IBRET
Begin DoDot:1
+27 SET IBMES=" was NOT successfully submitted to TASKMAN."
End DoDot:1
+28 DO BMES^XPDUTL(" "_IBDIR)
+29 ;update post install with info
DO BMES^XPDUTL(" "_IBMES)
TASK1Q ;
+1 QUIT
+2 ;
NEWINDX ; populate 1.04 field new LAST index in file #355.32
+1 ;
+2 NEW IBMES,IENS,NODE,NOGO
+3 ;
+4 SET IEN=0
+5 FOR
SET IEN=$ORDER(^IBA(355.32,IEN))
if 'IEN
QUIT
Begin DoDot:1
+6 KILL ARRAY
+7 SET IENS=IEN_","
SET NOGO=0
+8 DO GETS^DIQ(355.32,IENS,".01;1.03;1.04","I","ARRAY")
+9 ;Quit this entry if any field is null.
FOR NODE=.01,1.03,1.04
IF $GET(ARRAY(355.32,IENS,NODE,"I"))=""
SET NOGO=1
QUIT
+10 IF NOGO
QUIT
+11 NEW DA,DIK
+12 SET DIK(1)="1.04^LAST"
SET DIK="^IBA(355.32,"
SET DA=IEN
+13 DO EN1^DIK
End DoDot:1
+14 KILL ARRAY
+15 ;
+16 ; Tell TaskManager to delete the task's record
+17 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+18 ;
NEWEXIT ;
+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 SET IBDIR="IB*771 - report X12 entries not controlled by FSC"
+10 ; Check to see if the task is already running.
+11 KILL GTASKS
+12 DO DESC^%ZTLOAD(IBDIR,"GTASKS")
+13 SET (IBTASK,TSK)=""
SET RMSG(0)=0
+14 SET TSK=$ORDER(GTASKS(TSK))
+15 IF TSK
Begin DoDot:1
+16 DO BMES^XPDUTL(" "_IBDIR)
+17 DO BMES^XPDUTL(" Task "_TSK_" has Already Been Submitted to TASKMAN.")
End DoDot:1
QUIT
+18 ; build task out array and task off
+19 SET ZTRTN="X12ENTRIES^IBY771PO"
SET ZTDESC=IBDIR
SET ZTIO=""
+20 ; ZTDTH = Now
+21 SET ZTDTH=$$NOW^XLFDT()
+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=" has been submitted to TASKMAN. Task number: "_(+IBRET)
+29 IF 'IBRET
Begin DoDot:1
+30 SET IBER=1
+31 SET IBMES=" was NOT successfully submitted to TASKMAN."
End DoDot:1
+32 DO BMES^XPDUTL(" "_IBDIR)
+33 ;update post install with info
DO BMES^XPDUTL(" "_IBMES)
+34 ;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
Begin DoDot:1
+8 SET FILE="365.0"_D
SET IEN=0
+9 FOR
SET IEN=$ORDER(^IBE(FILE,IEN))
if 'IEN
QUIT
Begin DoDot:2
+10 NEW DATA,IENS
+11 SET IENS=IEN_","
+12 ;Only include entries where field FSC CONTROLLED (#.05) is equal to 0 (zero) AND DESCRIPTION (#.02)="OTHER"
+13 DO GETS^DIQ(FILE,IENS,".02;.05","I","DATA")
+14 IF DATA(FILE,IENS,.02,"I")="OTHER"
IF DATA(FILE,IENS,.05,"I")=0
SET CT=CT+1
SET ARRAY(CT)=FILE_U_^IBE(FILE,IEN,0)
End DoDot:2
End DoDot:1
+15 IF '$ORDER(ARRAY(0))
SET ARRAY(1)="No entries found with 'FSC CONTROLLED' (#.05) equal to zero"
+16 DO MESSAGE
+17 QUIT
+18 ;
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*771 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 ;
