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

IBY732PO.m

Go to the documentation of this file. 
  1. IBY732PO ;AITC/DTG - Post-Installation for IB patch 732; MAR 30, 2022
  1.  ;;2.0;INTEGRATED BILLING;**732**;MAR 21,1994;Build 13
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Reference to $$INSTALDT^XPDUTL in ICR #10141
  1.  ; Reference to %ZTLOAD in ICR #10063
  1.  ; Reference to $$FMADD^XLFDT in ICR #10103
  1.  Q
  1.  ;
  1. POST ; POST-INSTALL
  1.  N IBINSTLD,IBXPD,SITE,SITENAME,SITENUM,XPDIDTOT
  1.  S IBPOSITION="!?((IOM/2)-($L(A)/2))"  ;IB718
  1.  ; total number of work items
  1.  S XPDIDTOT=3
  1.  ;
  1.  S SITE=$$SITE^VASITE,SITENAME=$P(SITE,U,2),SITENUM=$P(SITE,U,3)
  1.  ;
  1.  S IBINSTLD=$$INSTALDT^XPDUTL("IB*2.0*732","")
  1.  D MES^XPDUTL("")
  1.  ;
  1.  D PLAN(1)  ; added VISION to PLAN LIMITATION CATEGORY file (#355.31)
  1.  ;
  1.  D WRK(2)  ; fix from 718
  1.  ;
  1.  D SITEREG(3,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*732 Completed.")
  1.  Q
  1.  ;============================
  1.  ;
  1.  ;
  1. PLAN(IBXPD) ; add Vision to Plan Coverage Limitations
  1.  S IBXPD=$G(IBXPD),XPDIDTOT=$G(XPDIDTOT)
  1.  D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  ;
  1.  N DA,DD,DIC,DIE,DLAYGO,DO,DR,X,Y
  1.  N IBA,IBDA,IBFILE,IBFND,IBNAME
  1.  ;
  1.  S IBNAME="VISION",IBFILE="PLAN LIMITATION CATEGORY (#355.31)"
  1.  D MES^XPDUTL("Adding "_IBNAME_" to the "_IBFILE)
  1.  ;
  1.  S IBFND=0
  1.  I $O(^IBE(355.31,"B",IBNAME,0)) S IBFND=1
  1.  I $G(IBFND)=1 D MES^XPDUTL("*** "_IBNAME_" not added to "_IBFILE_"  ALREADY EXISTS ***") G PLANQ
  1.  ;
  1.  S DLAYGO=355.31,DIC="^IBE(355.31,",DIC(0)="L",X=IBNAME
  1.  D FILE^DICN K DIC
  1.  S IBDA=+Y I Y<1 K X,Y D  G PLANQ
  1.  . D MES^XPDUTL("*** "_IBNAME_" not added to "_IBFILE_" NOT able to create entry ***")
  1.  ;
  1.  S DIE="^IBE(355.31,",DA=+IBDA,DR=".02///Vision coverage"
  1.  D ^DIE
  1.  ;
  1.  D MES^XPDUTL("Vision Plan was added.....")
  1.  ;
  1. PLANQ ; plan add exit
  1.  ;
  1.  K DIE,DA,DR,X,Y
  1.  Q
  1.  ;
  1. WRK(IBXPD) ; FROM 718
  1.  ;
  1.  S IBXPD=$G(IBXPD),XPDIDTOT=$G(XPDIDTOT)
  1.  D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  ;
  1.  N IBIEN,IBGLBROOT,IBFILENUM,IBFDA,LOCALIEN,LOCALIENS
  1.  N IBFLAGS,IBFIELD,IBWPROOT,IBWPERROR,IBNAME01,IBCODE
  1.  ;
  1.  ;XPDGREF = ^XTMP("XPDI",INSTALL_IEN,"TEMP")
  1.  ;XPDNM   = "ZZ*1.0*732"
  1.  ;
  1.  S IBFILENUM=$QS($Q(@XPDGREF),5)
  1.  S IBIEN=0
  1.  F  S IBIEN=$O(@XPDGREF@(XPDNM,IBFILENUM,IBIEN)) Q:'IBIEN  D
  1.  .S IBNAME01=$P($G(@XPDGREF@(XPDNM,IBFILENUM,IBIEN,0)),U)  ;NAME
  1.  .S IBCODE=$P($G(@XPDGREF@(XPDNM,IBFILENUM,IBIEN,0)),U,2)  ;CODE
  1.  .;
  1.  .S LOCALIEN=$$FINDLOCALIEN(IBNAME01,IBFILENUM,IBCODE)  ;FIND THE LOCAL ENTRY IEN WE NEED TO MODIFY
  1.  .Q:'LOCALIEN  ;IF NO DISTINCT IEN FOUND DO NOT TRY AND MODIFY
  1.  .;
  1.  .S LOCALIENS=LOCALIEN_","
  1.  .;JUST UPDATING THE HELP PROMPT
  1.  .;WORD PROCESSING FIELD MUST BE DONE BY WP^DIE
  1.  .S IBFIELD=1
  1.  .S IBFLAGS=""
  1.  .K IBWPROOT
  1.  .M IBWPROOT=@XPDGREF@(XPDNM,IBFILENUM,IBIEN,1)
  1.  .K IBWPROOT(0)
  1.  .S IBWPROOT="IBWPROOT"
  1.  .;
  1.  .D WP^DIE(IBFILENUM,LOCALIENS,IBFIELD,IBFLAGS,"IBWPROOT","IBWPERROR")        ;^DGCR(399.1,D0,1,D1,0)= (#.01) VALUE CODE HELP TEXT [1W]
  1.  .;
  1.  .I $D(IBWPERROR) D
  1.  ..D BMES^XPDUTL("Problem modifying Word Processing routine for "_NAME01_" in file "_IBFILENUM)
  1.  .;
  1.  ;
  1.  D BMES^XPDUTL("Finished modifying Entries to "_$G(IBFILENUM)_" File")
  1.  ;
  1. FINDLOCALIEN(NAME01,FILENUM,IBCODE)  ;FIND THE LOCAL IEN  WE NEED TO MODIFY
  1.  N RETURN,ERROR,INDEX,LOCALIEN,MATCHIEN
  1.  S INDEX="M"
  1.  D FIND^DIC(FILENUM,"","","",NAME01,INDEX,,,,"RETURN","ERROR")
  1.  ;
  1.  I $D(ERROR) D  Q 0
  1.  .D BMES^XPDUTL("*** Error when searching for  "_NAME01_" in file "_FILENUM_"***")
  1.  ;
  1.  I '$D(RETURN) D  Q 0
  1.  .D BMES^XPDUTL("*** Entry  "_NAME01_" in file "_FILENUM_"not found ***")
  1.  ;
  1.  I $P($G(RETURN("DILIST",0)),U)>1 D
  1.  .D BMES^XPDUTL("*** Duplicate entries found for  "_NAME01_" in file "_FILENUM_"***")
  1.  .D BMES^XPDUTL("*** Using CODE '"_$G(IBCODE)_"' to determine correct record to update.***")
  1.  .;CHECK FIELD #.18 VALUE CODE 0^NODE P^11
  1.  .S MATCHIEN=$$MATCHCODE(.RETURN,IBCODE)
  1.  .S LOCALIEN=$P($G(RETURN("DILIST",2,MATCHIEN)),U)
  1.  ;
  1.  ;AT THIS POINT WE HAVE FOUND ONE ENTRY AND WE CAN MODIFY IT
  1.  S:$G(LOCALIEN)="" LOCALIEN=$P($G(RETURN("DILIST",2,1)),U)
  1.  Q LOCALIEN
  1.  ;
  1. MATCHCODE(RETURN,IBCODE) ;EP - RETURN LOCAL IEN MATCHING NAME AND CODE OF INCOMING VALUE CODE ENTRY
  1.  N IEN,MATCH
  1.  S MATCH=0
  1.  S IEN=0
  1.  F  S IEN=$O(RETURN("DILIST","ID",IEN)) Q:'IEN  D  Q:$G(MATCH)
  1.  .I IBCODE=RETURN("DILIST","ID",IEN,.02) S MATCH=IEN
  1.  ;
  1.  I 'MATCH D
  1.  .D BMES^XPDUTL("No distinct match for Value Code "_$G(IBCODE)_" when duplicate records found!")
  1.  Q MATCH
  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
  1.  ;