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