BHL3MS.m

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       ;