BHL3MS ;cmi/flag/maw - BHL Setup 3m Workstations [ 07/05/2002 2:22 PM ]
;;3.01;BHL IHS Interfaces with GIS;**1**;JUN 01, 2002
;
;
;
;this routine will allow the medical records staff to setup
;3M workstations. It will add the IP address to the background
;process file, set up the destination properly, and then activate
;the transaction type and add it to the message multiple
;
MAIN ;EP - this is the main routine driver
S BHLCONT=$$READY
I '$G(BHLCONT) D Q
. W !,"Get IP address and 3m Port, run option again"
. D EOJ
SET S BHLWS=$$ASK
I '$G(BHLWS) W !,"Invalid Workstation Entered" D EOJ Q
S BHLMN=$$MN("3M")
D ACT(BHLWS)
S BHLAN=$$AGAIN
I $G(BHLAN) G SET
D EOJ
Q
;
READY() ;-- write message and ask for confirmation
W !!,"You must know the IP address and 3M port number"
S DIR(0)="Y",DIR("A")="Continue "
S DIR("B")="N"
D ^DIR
K DIR
Q $G(Y)
;
ASK() ;-- ask the workstation id
S DIR(0)="N^2:14"
S DIR("A")="What workstation number should I activate"
D ^DIR
Q:Y<0
K DIR
Q $G(Y)
;
AGAIN() ;-- ask the workstation id
S DIR(0)="Y"
S DIR("A")="Do you wish to activate another"
D ^DIR
Q:Y<0
K DIR
Q $G(Y)
;
ACT(WS) ;-- activate the workstation and interface
S BHLBP=$O(^INTHPC("B","HL IHS 3M SENDER "_WS,0))
S BHLDS="HL IHS 3M CODER "_WS
S BHLTT="HL IHS A08 OUT 3M "_WS
S BHLTTI=$O(^INRHT("B",BHLTT,0))
S BHLTTP="HL IHS A08 OUT 3M P "_WS
S BHLTTPI=$O(^INRHT("B",BHLTTP,0))
S BHLMI=$O(^INTHL7M("B","HL IHS A08 OUT 3M",0))
S BHLMII=$O(^INTHL7M("B","HL IHS A08 IN 3M",0))
S BHLBP0=$G(^INTHPC(BHLBP,6,0))
K ^INTHPC(BHLBP,6)
S ^INTHPC(BHLBP,6,0)=$G(BHLBP0)
S $P(^INTHPC(BHLBP,6,0),U,3)=""
S $P(^INTHPC(BHLBP,6,0),U,4)=""
W !!,"Now setting up the IP address of workstation ID "_WS
K DIE,DR,DA,Y
S DIE="^INTHPC("_BHLBP,DA=BHLBP,DR=".02///1;.07///"_BHLDS
D ^DIE
S DIC=DIE_",6,",DIC(0)="AELMQZ"
S DIC("P")=$P(^DD(4004,6,0),U,2)
S DA(1)=BHLBP
D ^DIC
Q:Y<0
S BHLIPI=+Y
K DA
S DIC=DIC_BHLIPI_",1,"
S DA(2)=BHLBP,DA(1)=BHLIPI
S DIC("P")=$P(^DD(4004.03,.02,0),U,2)
D ^DIC
Q:Y<0
K DIC,DIE,DR,DA
W !!,"IP Address now set up, continuing with transaction setup..."
S DIE="^INRHT(",DA=BHLTTI
S DR=".02///"_BHLDS_";.05///ACTIVE"
D ^DIE
S DA=BHLTTPI,DR=".05///ACTIVE"
D ^DIE
K DIE
K DD,DO,DA
S DIC="^INTHL7M("_BHLMI_",2,",DIC(0)="L"
S DA(1)=BHLMI
S DIC("P")=$P(^DD(4011,2,0),U,2)
S X=BHLTTI
D FILE^DICN
W !!,"Now compiling the message"
F BHLY=BHLMI,BHLMII D COMPILE^BHLU(BHLY)
W !!,"3M Workstation ID "_WS_" is now ready for use"
Q
;
MN(MN) ;-- activate the mnemonic
S BHLMNI=$O(^APCDTKW("B",MN,0))
I 'BHLMNI Q ""
S DIE="^APCDTKW(",DA=BHLMNI,DR=".07///A"
D ^DIE
K DIE,DR,DA
Q +Y
;
EOJ ;-- kill variables and quit
D ^XBFMK
D EN^XBVK("BHL")
Q
;
BHL3MS ;cmi/flag/maw - BHL Setup 3m Workstations [ 07/05/2002 2:22 PM ]
+1 ;;3.01;BHL IHS Interfaces with GIS;**1**;JUN 01, 2002
+2 ;
+3 ;
+4 ;
+5 ;this routine will allow the medical records staff to setup
+6 ;3M workstations. It will add the IP address to the background
+7 ;process file, set up the destination properly, and then activate
+8 ;the transaction type and add it to the message multiple
+9 ;
MAIN ;EP - this is the main routine driver
+1 SET BHLCONT=$$READY
+2 IF '$GET(BHLCONT)
Begin DoDot:1
+3 WRITE !,"Get IP address and 3m Port, run option again"
+4 DO EOJ
End DoDot:1
QUIT
SET SET BHLWS=$$ASK
+1 IF '$GET(BHLWS)
WRITE !,"Invalid Workstation Entered"
DO EOJ
QUIT
+2 SET BHLMN=$$MN("3M")
+3 DO ACT(BHLWS)
+4 SET BHLAN=$$AGAIN
+5 IF $GET(BHLAN)
GOTO SET
+6 DO EOJ
+7 QUIT
+8 ;
READY() ;-- write message and ask for confirmation
+1 WRITE !!,"You must know the IP address and 3M port number"
+2 SET DIR(0)="Y"
SET DIR("A")="Continue "
+3 SET DIR("B")="N"
+4 DO ^DIR
+5 KILL DIR
+6 QUIT $GET(Y)
+7 ;
ASK() ;-- ask the workstation id
+1 SET DIR(0)="N^2:14"
+2 SET DIR("A")="What workstation number should I activate"
+3 DO ^DIR
+4 IF Y<0
QUIT
+5 KILL DIR
+6 QUIT $GET(Y)
+7 ;
AGAIN() ;-- ask the workstation id
+1 SET DIR(0)="Y"
+2 SET DIR("A")="Do you wish to activate another"
+3 DO ^DIR
+4 IF Y<0
QUIT
+5 KILL DIR
+6 QUIT $GET(Y)
+7 ;
ACT(WS) ;-- activate the workstation and interface
+1 SET BHLBP=$ORDER(^INTHPC("B","HL IHS 3M SENDER "_WS,0))
+2 SET BHLDS="HL IHS 3M CODER "_WS
+3 SET BHLTT="HL IHS A08 OUT 3M "_WS
+4 SET BHLTTI=$ORDER(^INRHT("B",BHLTT,0))
+5 SET BHLTTP="HL IHS A08 OUT 3M P "_WS
+6 SET BHLTTPI=$ORDER(^INRHT("B",BHLTTP,0))
+7 SET BHLMI=$ORDER(^INTHL7M("B","HL IHS A08 OUT 3M",0))
+8 SET BHLMII=$ORDER(^INTHL7M("B","HL IHS A08 IN 3M",0))
+9 SET BHLBP0=$GET(^INTHPC(BHLBP,6,0))
+10 KILL ^INTHPC(BHLBP,6)
+11 SET ^INTHPC(BHLBP,6,0)=$GET(BHLBP0)
+12 SET $PIECE(^INTHPC(BHLBP,6,0),U,3)=""
+13 SET $PIECE(^INTHPC(BHLBP,6,0),U,4)=""
+14 WRITE !!,"Now setting up the IP address of workstation ID "_WS
+15 KILL DIE,DR,DA,Y
+16 SET DIE="^INTHPC("_BHLBP
SET DA=BHLBP
SET DR=".02///1;.07///"_BHLDS
+17 DO ^DIE
+18 SET DIC=DIE_",6,"
SET DIC(0)="AELMQZ"
+19 SET DIC("P")=$PIECE(^DD(4004,6,0),U,2)
+20 SET DA(1)=BHLBP
+21 DO ^DIC
+22 IF Y<0
QUIT
+23 SET BHLIPI=+Y
+24 KILL DA
+25 SET DIC=DIC_BHLIPI_",1,"
+26 SET DA(2)=BHLBP
SET DA(1)=BHLIPI
+27 SET DIC("P")=$PIECE(^DD(4004.03,.02,0),U,2)
+28 DO ^DIC
+29 IF Y<0
QUIT
+30 KILL DIC,DIE,DR,DA
+31 WRITE !!,"IP Address now set up, continuing with transaction setup..."
+32 SET DIE="^INRHT("
SET DA=BHLTTI
+33 SET DR=".02///"_BHLDS_";.05///ACTIVE"
+34 DO ^DIE
+35 SET DA=BHLTTPI
SET DR=".05///ACTIVE"
+36 DO ^DIE
+37 KILL DIE
+38 KILL DD,DO,DA
+39 SET DIC="^INTHL7M("_BHLMI_",2,"
SET DIC(0)="L"
+40 SET DA(1)=BHLMI
+41 SET DIC("P")=$PIECE(^DD(4011,2,0),U,2)
+42 SET X=BHLTTI
+43 DO FILE^DICN
+44 WRITE !!,"Now compiling the message"
+45 FOR BHLY=BHLMI,BHLMII
DO COMPILE^BHLU(BHLY)
+46 WRITE !!,"3M Workstation ID "_WS_" is now ready for use"
+47 QUIT
+48 ;
MN(MN) ;-- activate the mnemonic
+1 SET BHLMNI=$ORDER(^APCDTKW("B",MN,0))
+2 IF 'BHLMNI
QUIT ""
+3 SET DIE="^APCDTKW("
SET DA=BHLMNI
SET DR=".07///A"
+4 DO ^DIE
+5 KILL DIE,DR,DA
+6 QUIT +Y
+7 ;
EOJ ;-- kill variables and quit
+1 DO ^XBFMK
+2 DO EN^XBVK("BHL")
+3 QUIT
+4 ;
