IB20P457 ;WOIFO/KJS/PO - POST-INIT FOR IB*2.0*457;11-1-2011
;;2.0;INTEGRATED BILLING;**457**;21-MAR-94;Build 30
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; This routine contains the post-initialization code for
; Integrated Billing package v2.0. Patch 457
;
Q
;
POST ;
;
D DOMSET
D PARMSET
D MAILGRP
Q
;
DOMSET ; set up the domain file
N IBDOMARR,DA,DDER,IBDOMAIN,DIC,X,Y,DDER
S IBDOMARR("Q-IBH.DOMAIN.EXT")=""
S IBDOMARR("Q-IBK.DOMAIN.EXT")=""
S IBDOMARR("Q-IBN.DOMAIN.EXT")=""
S IBDOMARR("Q-IBX.DOMAIN.EXT")=""
S IBDOMAIN=""
F S IBDOMAIN=$O(IBDOMARR(IBDOMAIN)) Q:IBDOMAIN="" D
. Q:$O(^DIC(4.2,"B",IBDOMAIN,0)) ;quit if domain already exist.
. D MES^XPDUTL("Creating "_IBDOMAIN_" domain... ")
. 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
Q
;
PARMSET ;
;setup 350.9
Q:$D(^IBE(350.9,1,13)) ;already setup
N SITE,EXTFILE,DMIQ,EXTTYP,PARMS,IENS1,IENS2,IBD0,IBD1,DIK,DA
S SITE=$P($$SITE^VASITE(),U,3)
S PARMS(350.9,"1,",13.01)="USER$:[HMS]"
S PARMS(350.9,"1,",13.02)=0
S PARMS(350.9,"1,",13.03)="VA"_SITE_".TXT"
S PARMS(350.9,"1,",13.04)=31
S PARMS(350.9,"1,",13.05)=2
S PARMS(350.9,"1,",13.06)=24
S PARMS(350.9,"1,",13.07)=100
D UPDATE^DIE("","PARMS","IENS1")
;
; delete the Extract File sub-file, if any, before creating the
S IBD0=1 ; this is hard coded is only one ien
S IBD1=0
F S IBD1=$O(^IBE(350.9,IBD0,13.08,IBD1)) Q:'IBD1 D
. S DA(1)=IBD0
. S DA=IBD1
. S DIK="^IBE(350.9,"_DA(1)_",13.08,"
. D ^DIK
;
F I=1:1:4 S IENS2(I)=I
S PARMS(350.9006,"+1,1,",.01)="NOINSUR"
S PARMS(350.9006,"+1,1,",.02)=1
S PARMS(350.9006,"+1,1,",.03)="VEHMN"_SITE_".TXT"
S PARMS(350.9006,"+1,1,",.04)="XXX@Q-IBN.DOMAIN.EXT"
S PARMS(350.9006,"+1,1,",.05)=1
S PARMS(350.9006,"+1,1,",.06)=2
S PARMS(350.9006,"+2,1,",.01)="ENHNOIN"
S PARMS(350.9006,"+2,1,",.02)=1
S PARMS(350.9006,"+2,1,",.03)="VEHMH"_SITE_".TXT"
S PARMS(350.9006,"+2,1,",.04)="XXX@Q-IBH.DOMAIN.EXT"
S PARMS(350.9006,"+2,1,",.05)=1
S PARMS(350.9006,"+2,1,",.06)=2
S PARMS(350.9006,"+3,1,",.01)="NORXINS"
S PARMS(350.9006,"+3,1,",.02)=1
S PARMS(350.9006,"+3,1,",.03)="VEHMX"_SITE_".TXT"
S PARMS(350.9006,"+3,1,",.04)="XXX@Q-IBX.DOMAIN.EXT"
S PARMS(350.9006,"+3,1,",.05)=1
S PARMS(350.9006,"+3,1,",.06)=2
S PARMS(350.9006,"+4,1,",.01)="NONVERINS"
S PARMS(350.9006,"+4,1,",.02)=1
S PARMS(350.9006,"+4,1,",.03)="VEHMK"_SITE_".TXT"
S PARMS(350.9006,"+4,1,",.04)="XXX@Q-IBK.DOMAIN.EXT"
S PARMS(350.9006,"+4,1,",.05)=0
S PARMS(350.9006,"+4,1,",.06)=2
D UPDATE^DIE("","PARMS","IENS2")
Q
;
MAILGRP ;
N EC,MG,MGDESC,MGNAM,X,MGTYP,MGORG,MGSE,MGSIL,XMTEXT,MGMEM,XMY
;Call the MailMan API to Create Mail Groups.
;Code for the mail groups MUST remain for later rounds.
S MG("IBH")=""
S MG("IBK")=""
S MG("IBN")=""
S MG("IBX")=""
S MGNAM="",MGORG=DUZ
S (MGTYP,MGSE)=0,MGSIL=1,MGMEM=""
;
;need to add the server option this way as it doesn't have a DUZ
S MGMEM="S.IBCNF EII GET SERVER"
D ADDMBRS^XMXAPIG(MGORG,.MG,MGMEM)
;
;setup IRM mail group
S MGNAM="IBCNF EII IRM"
S MGMEM(DUZ)="" ; put person running this patch in group initially
S X=$$MG^XMBGRP(MGNAM,MGTYP,MGORG,MGSE,.MGMEM,.MGDESC,MGSIL)
I X D
. D BMES^XPDUTL(">>> "_MGNAM_" mail group added successfully!")
. D BMES^XPDUTL(">>> You have been added as a member of this mail group.")
. D MES^XPDUTL(" Please add members or remove yourself as appropriate.")
;
;setup XML mail group
S MGNAM="IBCNF EII XML READY"
S MGMEM(DUZ)="" ; put person running this patch in group initially
S X=$$MG^XMBGRP(MGNAM,MGTYP,MGORG,MGSE,.MGMEM,.MGDESC,MGSIL)
I X D
. D BMES^XPDUTL(">>> "_MGNAM_" mail group added successfully!")
. D BMES^XPDUTL(">>> You have been added as a member of this mail group.")
. D MES^XPDUTL(" Please add members or remove yourself as appropriate.")
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P457 3989 printed Dec 13, 2024@02:03 Page 2
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
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; This routine contains the post-initialization code for
+5 ; Integrated Billing package v2.0. Patch 457
+6 ;
+7 QUIT
+8 ;
POST ;
+1 ;
+2 DO DOMSET
+3 DO PARMSET
+4 DO MAILGRP
+5 QUIT
+6 ;
DOMSET ; set up the domain file
+1 NEW IBDOMARR,DA,DDER,IBDOMAIN,DIC,X,Y,DDER
+2 SET IBDOMARR("Q-IBH.DOMAIN.EXT")=""
+3 SET IBDOMARR("Q-IBK.DOMAIN.EXT")=""
+4 SET IBDOMARR("Q-IBN.DOMAIN.EXT")=""
+5 SET IBDOMARR("Q-IBX.DOMAIN.EXT")=""
+6 SET IBDOMAIN=""
+7 FOR
SET IBDOMAIN=$ORDER(IBDOMARR(IBDOMAIN))
if IBDOMAIN=""
QUIT
Begin DoDot:1
+8 ;quit if domain already exist.
if $ORDER(^DIC(4.2,"B",IBDOMAIN,0))
QUIT
+9 DO MES^XPDUTL("Creating "_IBDOMAIN_" domain... ")
+10 SET DIC="^DIC(4.2,"
SET DIC(0)="L"
SET X=IBDOMAIN
SET DIC("DR")="1///S;2///FOC-AUSTIN.DOMAIN.EXT;1.7///YES"
DO FILE^DICN
KILL DIC,X
End DoDot:1
+11 QUIT
+12 ;
PARMSET ;
+1 ;setup 350.9
+2 ;already setup
if $DATA(^IBE(350.9,1,13))
QUIT
+3 NEW SITE,EXTFILE,DMIQ,EXTTYP,PARMS,IENS1,IENS2,IBD0,IBD1,DIK,DA
+4 SET SITE=$PIECE($$SITE^VASITE(),U,3)
+5 SET PARMS(350.9,"1,",13.01)="USER$:[HMS]"
+6 SET PARMS(350.9,"1,",13.02)=0
+7 SET PARMS(350.9,"1,",13.03)="VA"_SITE_".TXT"
+8 SET PARMS(350.9,"1,",13.04)=31
+9 SET PARMS(350.9,"1,",13.05)=2
+10 SET PARMS(350.9,"1,",13.06)=24
+11 SET PARMS(350.9,"1,",13.07)=100
+12 DO UPDATE^DIE("","PARMS","IENS1")
+13 ;
+14 ; delete the Extract File sub-file, if any, before creating the
+15 ; this is hard coded is only one ien
SET IBD0=1
+16 SET IBD1=0
+17 FOR
SET IBD1=$ORDER(^IBE(350.9,IBD0,13.08,IBD1))
if 'IBD1
QUIT
Begin DoDot:1
+18 SET DA(1)=IBD0
+19 SET DA=IBD1
+20 SET DIK="^IBE(350.9,"_DA(1)_",13.08,"
+21 DO ^DIK
End DoDot:1
+22 ;
+23 FOR I=1:1:4
SET IENS2(I)=I
+24 SET PARMS(350.9006,"+1,1,",.01)="NOINSUR"
+25 SET PARMS(350.9006,"+1,1,",.02)=1
+26 SET PARMS(350.9006,"+1,1,",.03)="VEHMN"_SITE_".TXT"
+27 SET PARMS(350.9006,"+1,1,",.04)="XXX@Q-IBN.DOMAIN.EXT"
+28 SET PARMS(350.9006,"+1,1,",.05)=1
+29 SET PARMS(350.9006,"+1,1,",.06)=2
+30 SET PARMS(350.9006,"+2,1,",.01)="ENHNOIN"
+31 SET PARMS(350.9006,"+2,1,",.02)=1
+32 SET PARMS(350.9006,"+2,1,",.03)="VEHMH"_SITE_".TXT"
+33 SET PARMS(350.9006,"+2,1,",.04)="XXX@Q-IBH.DOMAIN.EXT"
+34 SET PARMS(350.9006,"+2,1,",.05)=1
+35 SET PARMS(350.9006,"+2,1,",.06)=2
+36 SET PARMS(350.9006,"+3,1,",.01)="NORXINS"
+37 SET PARMS(350.9006,"+3,1,",.02)=1
+38 SET PARMS(350.9006,"+3,1,",.03)="VEHMX"_SITE_".TXT"
+39 SET PARMS(350.9006,"+3,1,",.04)="XXX@Q-IBX.DOMAIN.EXT"
+40 SET PARMS(350.9006,"+3,1,",.05)=1
+41 SET PARMS(350.9006,"+3,1,",.06)=2
+42 SET PARMS(350.9006,"+4,1,",.01)="NONVERINS"
+43 SET PARMS(350.9006,"+4,1,",.02)=1
+44 SET PARMS(350.9006,"+4,1,",.03)="VEHMK"_SITE_".TXT"
+45 SET PARMS(350.9006,"+4,1,",.04)="XXX@Q-IBK.DOMAIN.EXT"
+46 SET PARMS(350.9006,"+4,1,",.05)=0
+47 SET PARMS(350.9006,"+4,1,",.06)=2
+48 DO UPDATE^DIE("","PARMS","IENS2")
+49 QUIT
+50 ;
MAILGRP ;
+1 NEW EC,MG,MGDESC,MGNAM,X,MGTYP,MGORG,MGSE,MGSIL,XMTEXT,MGMEM,XMY
+2 ;Call the MailMan API to Create Mail Groups.
+3 ;Code for the mail groups MUST remain for later rounds.
+4 SET MG("IBH")=""
+5 SET MG("IBK")=""
+6 SET MG("IBN")=""
+7 SET MG("IBX")=""
+8 SET MGNAM=""
SET MGORG=DUZ
+9 SET (MGTYP,MGSE)=0
SET MGSIL=1
SET MGMEM=""
+10 ;
+11 ;need to add the server option this way as it doesn't have a DUZ
+12 SET MGMEM="S.IBCNF EII GET SERVER"
+13 DO ADDMBRS^XMXAPIG(MGORG,.MG,MGMEM)
+14 ;
+15 ;setup IRM mail group
+16 SET MGNAM="IBCNF EII IRM"
+17 ; put person running this patch in group initially
SET MGMEM(DUZ)=""
+18 SET X=$$MG^XMBGRP(MGNAM,MGTYP,MGORG,MGSE,.MGMEM,.MGDESC,MGSIL)
+19 IF X
Begin DoDot:1
+20 DO BMES^XPDUTL(">>> "_MGNAM_" mail group added successfully!")
+21 DO BMES^XPDUTL(">>> You have been added as a member of this mail group.")
+22 DO MES^XPDUTL(" Please add members or remove yourself as appropriate.")
End DoDot:1
+23 ;
+24 ;setup XML mail group
+25 SET MGNAM="IBCNF EII XML READY"
+26 ; put person running this patch in group initially
SET MGMEM(DUZ)=""
+27 SET X=$$MG^XMBGRP(MGNAM,MGTYP,MGORG,MGSE,.MGMEM,.MGDESC,MGSIL)
+28 IF X
Begin DoDot:1
+29 DO BMES^XPDUTL(">>> "_MGNAM_" mail group added successfully!")
+30 DO BMES^XPDUTL(">>> You have been added as a member of this mail group.")
+31 DO MES^XPDUTL(" Please add members or remove yourself as appropriate.")
End DoDot:1
+32 ;
+33 QUIT
