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

BHLRXPST.m

Go to the documentation of this file. 
  1. BHLRXPST ; IHS/TUCSON/DCP - HL7 - POST-INIT FOR COTS PHARMACY INSTALLATION ;
  1.  ;;1.0;IHS SUPPORT FOR HL7 INTERFACES;;JUL 7, 1997
  1.  ;
  1.  ; This routine performs all necessary post-init actions. It is called
  1.  ; from the MUMPS prompt: ">" This routine does not require any pre-
  1.  ; defined external variables.
  1.  ;
  1. START ; ENTRY POINT from MUMPS prompt ">"
  1.  S BHLPKG=$O(^DIC(9.4,"C","BHL",""))
  1.  D ^XBKVAR
  1.  ;
  1. LOC ;
  1.  S BHLLOC=""
  1.  S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Enter Facility:  ",DIC("B")=$P(^DIC(4,DUZ(2),0),U) D ^DIC K DIC,DA
  1.  G:Y=-1 LOC
  1.  S BHLLOC=+Y
  1.  ;
  1.  D   ;                 find/create PHARM MGR mail grp
  1.  . S BHLMGRP=$O(^XMB(3.8,"B","PHARM MGR",0))
  1.  . I BHLMGRP W !,"PHARM MGR Mail Group already exists.  Nothing added.",!! Q
  1.  . K DD,DO
  1.  . S DIC="^XMB(3.8,",DIC(0)="L",DLAYGO=3.8
  1.  . S DIC("DR")="4////PU;5////"_DUZ_";5.1////"_DUZ_";10////0;3///This is the PHARM MGR Mail Group."
  1.  . S X="PHARM MGR"
  1.  . D FILE^DICN K DIC
  1.  . I Y<0 W !,"Entry was unsuccessful:  ",X K X Q
  1.  . W:+Y !!?5,"I created a PHARM MGR Mail Group entry.  Please add appropriate",!?5,"members to this group.",!
  1.  . S BHLMGRP=+Y
  1.  . K X,Y,DLAYGO
  1.  . Q
  1.  ;
  1.  D   ;                add PHARM MGR mail grp to bulletins
  1.  . S BHLBULL1="BHLBPS RX-PCC MESSAGE ERROR"
  1.  . S BHLBULL2="BHLBPS RX-PCC LINK DATA ERROR"
  1.  . F BHLBULL=BHLBULL1,BHLBULL2 D
  1.  . . S BHLBIEN=$O(^XMB(3.6,"B",BHLBULL,0))
  1.  . . I 'BHLBIEN W !,BHLBULL," bulletin not found.....I was unable to add this bulletin to the PHARM MGR mail group." Q
  1.  . . Q:$D(^XMB(3.6,BHLBIEN,2,"B",BHLMGRP))  ;quit if already there
  1.  . . S DIC="^XMB(3.6,"_BHLBIEN_",2,"
  1.  . . S DIC(0)="L"
  1.  . . S DIC("P")=$P(^DD(3.6,4,0),U,2)
  1.  . . S DA(1)=BHLBIEN
  1.  . . S X=BHLMGRP
  1.  . . K DD,DO D FILE^DICN K DIC
  1.  . . I +Y<0 W !?5,"Multiple entry was unsuccessful:  ",X K X Q
  1.  . . W !?5,"PHARM MGR Mail Group added to the "_BHLBULL_" Bulletin."
  1.  . . K X,Y,DA
  1.  . . Q
  1.  . K BHLBIEN,BHLBULL,BHLBULL1,BHLBULL2
  1.  . W !!
  1.  ;
  1. ADDEN ; ENTRY POINT - Add entries to the HL7 APPLICATION PARAMETER and PROTOCOL files
  1.  ; This entry point is only used if it is necessary to restart the post-
  1.  ; init process after installing the DHCP HL7 package.
  1.  ;
  1.  S BHLHL7=$O(^DIC(9.4,"B","HEALTH LEVEL SEVEN",0))
  1.  I 'BHLHL7 D  G XIT
  1.  . W !?5,"Cannot find the HEALTH LEVEL SEVEN package entry.  Unable to install"
  1.  . W !?5,"the required entries to the following files:"
  1.  . W !!?30,"HL7 APPLICATION PARAMETER",!?30,"PROTOCOL"
  1.  . W !!!!?5,"Once the HL7 Package has been installed, this process can"
  1.  . W !?5,"be restarted with the following command:  D ADDEN^BHLRXPST",!!
  1.  . K BHLHL7
  1.  . Q
  1.  K BHLHL7
  1.  ;
  1.  W !,"Adding required entries to the HL7 APPLICATION PARAMETER file."
  1.  D START^BHLRXPS1
  1.  ;
  1.  W !!,"Adding required entries to the PROTOCOL file."
  1.  D START^BHLRXPS2
  1.  ;
  1. HLLOG ; add entry to HL7 LOWER LEVEL PROTOCOL file
  1.  I $D(^HLCS(869.2,"B","BPSLNK")) W !!,"HL7 Lower Level Protocol Parameter exists" G HLLOG1
  1.  K DD,DO
  1.  S DIC(0)="L",DIC="^HLCS(869.2,",DLAYGO=869.2,DIADD=1,X="BPSLNK",DIC("DR")=".02///HLLP;200.02////3;200.04////10;200.05////10;200.06////11;200.07////28;200.08////22" D FILE^DICN
  1.  W:Y=-1 !!,"Entry of HL7 Lower Level Protocol Entry FAILED!"
  1.  W:Y'=-1 !!,"Adding HL7 Lower Level Protocol Entry."
  1.  ;
  1. HLLOG1 ; add entry to HL LOGICAL LINK
  1.  I $D(^HLCS(870,"B","BPSLNK")) W !!,"HL Logical Link already exists." G XIT
  1.  K DD,DO
  1.  S DIC(0)="L",DIC="^HLCS(870,",X="BPSLNK",DLAYGO=870,DIADD=1,DIC("DR")="1////H;2///BPSLNK;21////2000" D FILE^DICN
  1.  W:Y=-1 !!,"Entry of HL7 Logical Link FAILED!",!!
  1.  W:Y'=-1 !!,"Adding HL7 Logical Link Entry."
  1.  ;
  1.  ; update subscriber protocol with logical link
  1.  S DIE="^ORD(101,",DR="770.7////"_$O(^HLCS(870,"B","BPSLNK","")),DA=$O(^ORD(101,"B","BHLBPS","")) D:DA'="" ^DIE
  1.  ;
  1. XIT ;
  1.  K DA,DIC,DR,Y,X,D0,DD,DI,DIE,DIX,DIY,DIZ,DO,DQ,DZ
  1.  K BHLPKG,BHLLOC,BHLMGRP,BHLFAC,BHLCODE
  1.  K BHLACACK,BHLAPACK,BHLDIC,BHLDR,BHLEVNT,BHLFLG,BHLIEN,BHLISEQC,BHLITEM
  1.  K BHLMTG,BHLMTR,BHLNAME,BHLPTR,BHLTEXT,BHLVID,BHLTYPE
  1.  W !,"ALL DONE WITH POST-INIT",!!
  1.  Q