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

IBY771PO.m

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