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

IB20P457.m

Go to the documentation of this file. 
  1. IB20P457 ;WOIFO/KJS/PO - POST-INIT FOR IB*2.0*457;11-1-2011
  1.  ;;2.0;INTEGRATED BILLING;**457**;21-MAR-94;Build 30
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; This routine contains the post-initialization code for
  1.  ; Integrated Billing package v2.0. Patch 457
  1.  ;
  1.  Q
  1.  ;
  1. POST ;
  1.  ;
  1.  D DOMSET
  1.  D PARMSET
  1.  D MAILGRP
  1.  Q
  1.  ;
  1. DOMSET ; set up the domain file
  1.  N IBDOMARR,DA,DDER,IBDOMAIN,DIC,X,Y,DDER
  1.  S IBDOMARR("Q-IBH.DOMAIN.EXT")=""
  1.  S IBDOMARR("Q-IBK.DOMAIN.EXT")=""
  1.  S IBDOMARR("Q-IBN.DOMAIN.EXT")=""
  1.  S IBDOMARR("Q-IBX.DOMAIN.EXT")=""
  1.  S IBDOMAIN=""
  1.  F  S IBDOMAIN=$O(IBDOMARR(IBDOMAIN)) Q:IBDOMAIN=""  D
  1.  . Q:$O(^DIC(4.2,"B",IBDOMAIN,0))         ;quit if domain already exist.
  1.  . D MES^XPDUTL("Creating "_IBDOMAIN_" domain... ")
  1.  . S DIC="^DIC(4.2,",DIC(0)="L",X=IBDOMAIN,DIC("DR")="1///S;2///FOC-AUSTIN.DOMAIN.EXT;1.7///YES" D FILE^DICN K DIC,X
  1.  Q
  1.  ;
  1. PARMSET ;
  1.  ;setup 350.9
  1.  Q:$D(^IBE(350.9,1,13))  ;already setup
  1.  N SITE,EXTFILE,DMIQ,EXTTYP,PARMS,IENS1,IENS2,IBD0,IBD1,DIK,DA
  1.  S SITE=$P($$SITE^VASITE(),U,3)
  1.  S PARMS(350.9,"1,",13.01)="USER$:[HMS]"
  1.  S PARMS(350.9,"1,",13.02)=0
  1.  S PARMS(350.9,"1,",13.03)="VA"_SITE_".TXT"
  1.  S PARMS(350.9,"1,",13.04)=31
  1.  S PARMS(350.9,"1,",13.05)=2
  1.  S PARMS(350.9,"1,",13.06)=24
  1.  S PARMS(350.9,"1,",13.07)=100
  1.  D UPDATE^DIE("","PARMS","IENS1")
  1.  ;
  1.  ; delete the Extract File sub-file, if any, before creating the 
  1.  S IBD0=1    ; this is hard coded is only one ien
  1.  S IBD1=0
  1.  F  S IBD1=$O(^IBE(350.9,IBD0,13.08,IBD1)) Q:'IBD1  D
  1.  . S DA(1)=IBD0
  1.  . S DA=IBD1
  1.  . S DIK="^IBE(350.9,"_DA(1)_",13.08,"
  1.  . D ^DIK
  1.  ;
  1.  F I=1:1:4 S IENS2(I)=I
  1.  S PARMS(350.9006,"+1,1,",.01)="NOINSUR"
  1.  S PARMS(350.9006,"+1,1,",.02)=1
  1.  S PARMS(350.9006,"+1,1,",.03)="VEHMN"_SITE_".TXT"
  1.  S PARMS(350.9006,"+1,1,",.04)="XXX@Q-IBN.DOMAIN.EXT"
  1.  S PARMS(350.9006,"+1,1,",.05)=1
  1.  S PARMS(350.9006,"+1,1,",.06)=2
  1.  S PARMS(350.9006,"+2,1,",.01)="ENHNOIN"
  1.  S PARMS(350.9006,"+2,1,",.02)=1
  1.  S PARMS(350.9006,"+2,1,",.03)="VEHMH"_SITE_".TXT"
  1.  S PARMS(350.9006,"+2,1,",.04)="XXX@Q-IBH.DOMAIN.EXT"
  1.  S PARMS(350.9006,"+2,1,",.05)=1
  1.  S PARMS(350.9006,"+2,1,",.06)=2
  1.  S PARMS(350.9006,"+3,1,",.01)="NORXINS"
  1.  S PARMS(350.9006,"+3,1,",.02)=1
  1.  S PARMS(350.9006,"+3,1,",.03)="VEHMX"_SITE_".TXT"
  1.  S PARMS(350.9006,"+3,1,",.04)="XXX@Q-IBX.DOMAIN.EXT"
  1.  S PARMS(350.9006,"+3,1,",.05)=1
  1.  S PARMS(350.9006,"+3,1,",.06)=2
  1.  S PARMS(350.9006,"+4,1,",.01)="NONVERINS"
  1.  S PARMS(350.9006,"+4,1,",.02)=1
  1.  S PARMS(350.9006,"+4,1,",.03)="VEHMK"_SITE_".TXT"
  1.  S PARMS(350.9006,"+4,1,",.04)="XXX@Q-IBK.DOMAIN.EXT"
  1.  S PARMS(350.9006,"+4,1,",.05)=0
  1.  S PARMS(350.9006,"+4,1,",.06)=2
  1.  D UPDATE^DIE("","PARMS","IENS2")
  1.  Q
  1.  ;
  1. MAILGRP ;
  1.  N EC,MG,MGDESC,MGNAM,X,MGTYP,MGORG,MGSE,MGSIL,XMTEXT,MGMEM,XMY
  1.  ;Call the MailMan API to Create Mail Groups.
  1.  ;Code for the mail groups MUST remain for later rounds.
  1.  S MG("IBH")=""
  1.  S MG("IBK")=""
  1.  S MG("IBN")=""
  1.  S MG("IBX")=""
  1.  S MGNAM="",MGORG=DUZ
  1.  S (MGTYP,MGSE)=0,MGSIL=1,MGMEM=""
  1.  ;
  1.  ;need to add the server option this way as it doesn't have a DUZ
  1.  S MGMEM="S.IBCNF EII GET SERVER"
  1.  D ADDMBRS^XMXAPIG(MGORG,.MG,MGMEM)
  1.  ;
  1.  ;setup IRM mail group
  1.  S MGNAM="IBCNF EII IRM"
  1.  S MGMEM(DUZ)="" ; put person running this patch in group initially
  1.  S X=$$MG^XMBGRP(MGNAM,MGTYP,MGORG,MGSE,.MGMEM,.MGDESC,MGSIL)
  1.  I X D
  1.  . D BMES^XPDUTL(">>> "_MGNAM_" mail group added successfully!")
  1.  . D BMES^XPDUTL(">>> You have been added as a member of this mail group.")
  1.  . D MES^XPDUTL("    Please add members or remove yourself as appropriate.")
  1.  ;
  1.  ;setup XML mail group
  1.  S MGNAM="IBCNF EII XML READY"
  1.  S MGMEM(DUZ)="" ; put person running this patch in group initially
  1.  S X=$$MG^XMBGRP(MGNAM,MGTYP,MGORG,MGSE,.MGMEM,.MGDESC,MGSIL)
  1.  I X D
  1.  . D BMES^XPDUTL(">>> "_MGNAM_" mail group added successfully!")
  1.  . D BMES^XPDUTL(">>> You have been added as a member of this mail group.")
  1.  . D MES^XPDUTL("    Please add members or remove yourself as appropriate.")
  1.  ;
  1.  Q