- HLUOPT ;AISC/SAW-Main Menu for HL7 Module ;07/26/99 08:47
- ;;1.6;HEALTH LEVEL SEVEN;**57,161,162**;Oct 13, 1995;Build 3
- AP ;Enter/Edit DHCP Application Parameters
- F D Q:Y<0
- . N DA,DIC,DDSFILE,DR
- . S DIC="^HL(771,",DIC(0)="AEMQLZ"
- . W @IOF,! D ^DIC Q:Y<0
- . S DA=+Y,DDSFILE=DIC,DR="[HL7 APP]"
- . D ^DDS S Y=0
- Q
- ;
- SP ;Enter/Edit Non-DHCP Application Parameters
- S DIC="^HL(770,",DIC(0)="AEMQL",DLAYGO=770 W ! D ^DIC K DLAYGO G EXIT:Y<0
- I $P(Y,"^",3) N HLX,HLX1 S HLX=+Y
- S DA=+Y,DIE=DIC,DR=".01;3;2;4//245;5//3;6;7//2.1;8;9//30;10;14;100" D ^DIE
- I $D(HLX) D
- .S HLX1=$G(^HL(770,HLX,0)) K DA,DD,DIE,DO,DR S DIC="^HL(771,",X=$P(HLX1,"^"),DIC(0)="" D FILE^DICN S DA=+Y
- .I DA S DIE="^HL(771,",DR="2///a;3///"_$P(HLX1,"^",3) D ^DIE K DIE,DR
- .S DIE="^HL(770,",DR="12///"_DA,DA=HLX D ^DIE
- G SP
- APP ;Print/Display Application Parameters
- S DIC="^HL(771,",L=0,FLDS="[CAPTIONED]",BY="@.01",FR="?",TO="?",DHD="HL7 DHCP Application Parameters" D EN1^DIP D:$E(IOST,1,2)="C-" HOLD G EXIT
- SPP ;Print/Display Site Parameters
- S DIC="^HL(770,",L=0,FLDS="[CAPTIONED]",BY="@.01",FR="?",TO="?",DHD="HL7 Non-DHCP Application Parameters" D EN1^DIP D:$E(IOST,1,2)="C-" HOLD G EXIT
- MT ;Print/Display Message Type
- S DIC="^HL(771.2,",L=0,FLDS="[CAPTIONED]",BY="@.01",FR="",TO="",DHD="HL7 Message Types" D EN1^DIP D:$E(IOST,1,2)="C-" HOLD G EXIT
- SN ;Print/Display Segment Name
- S DIC="^HL(771.3,",L=0,FLDS="[CAPTIONED]",BY="@.01",FR="",TO="",DHD="HL7 Segment Names" D EN1^DIP D:$E(IOST,1,2)="C-" HOLD G EXIT
- DT ;Print/Display Data Type
- S DIC="^HL(771.4,",L=0,FLDS="[CAPTIONED]",BY="@.01",FR="",TO="",DHD="HL7 Data Types" D EN1^DIP D:$E(IOST,1,2)="C-" HOLD G EXIT
- VERS ;Print/Display Version Number
- S DIC="^HL(771.5,",L=0,FLDS="[CAPTIONED]",BY="@.01",FR="",TO="",DHD="HL7 Version Numbers" D EN1^DIP D:$E(IOST,1,2)="C-" HOLD G EXIT
- FIELD ;Print/Display Fields
- S DIC="^HL(771.1,",L=0,FLDS="[CAPTIONED]",BY="@.01",FR="?",TO="?",DHD="HL7 Fields" D EN1^DIP D:$E(IOST,1,2)="C-" HOLD G EXIT
- PLPT ;Print/Display Log of Awaiting or Pending Tramsmissions
- S DIC="^HL(772,",L=0,FLDS="[CAPTIONED]",BY="@20,@.01",DIS(0)="S HLX=+$G(^HL(772,D0,""P"")) I HLX<3!(HLX>7)",FR="A,?",TO="Z,?",DHD="Log of HL7 Transmissions in Awaiting or Pending Status" D EN1^DIP D:$E(IOST,1,2)="C-" HOLD K HLX G EXIT
- PLFT ;Print/Display Log of Failed Transmissions
- S DIC="^HL(772,",L=0,FLDS="[CAPTIONED]",BY="@20,@.01",FR="E,?",TO="EZ,?",DHD="Log of Failed HL7 Transmissions" D EN1^DIP D:$E(IOST,1,2)="C-" HOLD G EXIT
- LOG ;Start/Stop HL7 Log of Transmissions
- W !!,"Select the Non-DHCP Application for which you wish to start/stop the HL7 log",!,"of transmissions."
- W ! S DIC="^HL(770,",DIC(0)="AEMQ" D ^DIC G EXIT:Y<0 S DA=+Y,HLDEV=$P(^HL(770,DA,0),"^",6) I HLDEV']"" W !!,*7,"You must define an HL7 Device for this Non-DHCP Application before you can",!,"start the log.",!
- I HLDEV]"" W !!,"The HL7 log is currently turned ",$S($D(^HL(770,"ALOG",HLDEV,DA)):"on.",1:"off."),!
- S DIE=DIC,DR=$S(HLDEV']"":"6R;",1:"")_50,DIE("NO^")="OUTOK" D ^DIE
- W ! S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Do you want to purge existing log entries" D ^DIR I Y=1,HLDEV]"" K ^TMP("HL",HLDEV)
- EXIT K BY,DA,DHD,DIC,DIE,DIR,DR,FLDS,FR,L,HLDEV,TO,X,Y Q
- ;
- LLED ;Logical Link Edit, file 870
- ;HL*161 add code to make sure the Logical Link is shutdown RRA ticket 217900
- F D Q:Y<0
- . N DA,DIC,DDSFILE,DR,HLIEN,HLNAME,HLLL0
- . S DIC="^HLCS(870,",DIC(0)="AEMQLZ"
- . W @IOF,! D ^DIC Q:Y<0
- . S DA=+Y,DR="[HL7 LOGICAL LINK]",DDSFILE=DIC
- . S HLIEN=+Y,HLNAME=$P(Y,"^",2),HLLL0=$G(Y(0))
- . I '$P(HLLL0,"^",15)&($L($P(HLLL0,"^",3)))&($P($G(^HLCS(870,HLIEN,400)),"^",3)'="M") W !!,HLNAME_" must be shutdown before it can be edited" H 2 Q
- . D ^DDS S Y=0
- . W !!!,"If you shut down this link to edit, please remember to restart if appropriate" H 2
- Q
- ;
- INTED ;Interface edit, file 101
- F D Q:Y<0
- . N DA,DIC,DDSFILE,DR
- . S DIC="^ORD(101,",DIC(0)="AEMQLZ",DIC("S")="N Z S Z=$P(^(0),U,4) I Z=""E""!(Z=""S"")"
- . W @IOF,! D ^DIC Q:Y<0
- . S DA=+Y,DR="[HL7 INTERFACE]",DDSFILE=DIC
- . D ^DDS S Y=0
- Q
- ;
- HOLD ;Hold Screen at End of Display
- N DIR
- S DIR(0)="E" D ^DIR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLUOPT 4163 printed Jan 18, 2025@03:01:33 Page 2
- HLUOPT ;AISC/SAW-Main Menu for HL7 Module ;07/26/99 08:47
- +1 ;;1.6;HEALTH LEVEL SEVEN;**57,161,162**;Oct 13, 1995;Build 3
- AP ;Enter/Edit DHCP Application Parameters
- +1 FOR
- Begin DoDot:1
- +2 NEW DA,DIC,DDSFILE,DR
- +3 SET DIC="^HL(771,"
- SET DIC(0)="AEMQLZ"
- +4 WRITE @IOF,!
- DO ^DIC
- if Y<0
- QUIT
- +5 SET DA=+Y
- SET DDSFILE=DIC
- SET DR="[HL7 APP]"
- +6 DO ^DDS
- SET Y=0
- End DoDot:1
- if Y<0
- QUIT
- +7 QUIT
- +8 ;
- SP ;Enter/Edit Non-DHCP Application Parameters
- +1 SET DIC="^HL(770,"
- SET DIC(0)="AEMQL"
- SET DLAYGO=770
- WRITE !
- DO ^DIC
- KILL DLAYGO
- if Y<0
- GOTO EXIT
- +2 IF $PIECE(Y,"^",3)
- NEW HLX,HLX1
- SET HLX=+Y
- +3 SET DA=+Y
- SET DIE=DIC
- SET DR=".01;3;2;4//245;5//3;6;7//2.1;8;9//30;10;14;100"
- DO ^DIE
- +4 IF $DATA(HLX)
- Begin DoDot:1
- +5 SET HLX1=$GET(^HL(770,HLX,0))
- KILL DA,DD,DIE,DO,DR
- SET DIC="^HL(771,"
- SET X=$PIECE(HLX1,"^")
- SET DIC(0)=""
- DO FILE^DICN
- SET DA=+Y
- +6 IF DA
- SET DIE="^HL(771,"
- SET DR="2///a;3///"_$PIECE(HLX1,"^",3)
- DO ^DIE
- KILL DIE,DR
- +7 SET DIE="^HL(770,"
- SET DR="12///"_DA
- SET DA=HLX
- DO ^DIE
- End DoDot:1
- +8 GOTO SP
- APP ;Print/Display Application Parameters
- +1 SET DIC="^HL(771,"
- SET L=0
- SET FLDS="[CAPTIONED]"
- SET BY="@.01"
- SET FR="?"
- SET TO="?"
- SET DHD="HL7 DHCP Application Parameters"
- DO EN1^DIP
- if $EXTRACT(IOST,1,2)="C-"
- DO HOLD
- GOTO EXIT
- SPP ;Print/Display Site Parameters
- +1 SET DIC="^HL(770,"
- SET L=0
- SET FLDS="[CAPTIONED]"
- SET BY="@.01"
- SET FR="?"
- SET TO="?"
- SET DHD="HL7 Non-DHCP Application Parameters"
- DO EN1^DIP
- if $EXTRACT(IOST,1,2)="C-"
- DO HOLD
- GOTO EXIT
- MT ;Print/Display Message Type
- +1 SET DIC="^HL(771.2,"
- SET L=0
- SET FLDS="[CAPTIONED]"
- SET BY="@.01"
- SET FR=""
- SET TO=""
- SET DHD="HL7 Message Types"
- DO EN1^DIP
- if $EXTRACT(IOST,1,2)="C-"
- DO HOLD
- GOTO EXIT
- SN ;Print/Display Segment Name
- +1 SET DIC="^HL(771.3,"
- SET L=0
- SET FLDS="[CAPTIONED]"
- SET BY="@.01"
- SET FR=""
- SET TO=""
- SET DHD="HL7 Segment Names"
- DO EN1^DIP
- if $EXTRACT(IOST,1,2)="C-"
- DO HOLD
- GOTO EXIT
- DT ;Print/Display Data Type
- +1 SET DIC="^HL(771.4,"
- SET L=0
- SET FLDS="[CAPTIONED]"
- SET BY="@.01"
- SET FR=""
- SET TO=""
- SET DHD="HL7 Data Types"
- DO EN1^DIP
- if $EXTRACT(IOST,1,2)="C-"
- DO HOLD
- GOTO EXIT
- VERS ;Print/Display Version Number
- +1 SET DIC="^HL(771.5,"
- SET L=0
- SET FLDS="[CAPTIONED]"
- SET BY="@.01"
- SET FR=""
- SET TO=""
- SET DHD="HL7 Version Numbers"
- DO EN1^DIP
- if $EXTRACT(IOST,1,2)="C-"
- DO HOLD
- GOTO EXIT
- FIELD ;Print/Display Fields
- +1 SET DIC="^HL(771.1,"
- SET L=0
- SET FLDS="[CAPTIONED]"
- SET BY="@.01"
- SET FR="?"
- SET TO="?"
- SET DHD="HL7 Fields"
- DO EN1^DIP
- if $EXTRACT(IOST,1,2)="C-"
- DO HOLD
- GOTO EXIT
- PLPT ;Print/Display Log of Awaiting or Pending Tramsmissions
- +1 SET DIC="^HL(772,"
- SET L=0
- SET FLDS="[CAPTIONED]"
- SET BY="@20,@.01"
- SET DIS(0)="S HLX=+$G(^HL(772,D0,""P"")) I HLX<3!(HLX>7)"
- SET FR="A,?"
- SET TO="Z,?"
- SET DHD="Log of HL7 Transmissions in Awaiting or Pending Status"
- DO EN1^DIP
- if $EXTRACT(IOST,1,2)="C-"
- DO HOLD
- KILL HLX
- GOTO EXIT
- PLFT ;Print/Display Log of Failed Transmissions
- +1 SET DIC="^HL(772,"
- SET L=0
- SET FLDS="[CAPTIONED]"
- SET BY="@20,@.01"
- SET FR="E,?"
- SET TO="EZ,?"
- SET DHD="Log of Failed HL7 Transmissions"
- DO EN1^DIP
- if $EXTRACT(IOST,1,2)="C-"
- DO HOLD
- GOTO EXIT
- LOG ;Start/Stop HL7 Log of Transmissions
- +1 WRITE !!,"Select the Non-DHCP Application for which you wish to start/stop the HL7 log",!,"of transmissions."
- +2 WRITE !
- SET DIC="^HL(770,"
- SET DIC(0)="AEMQ"
- DO ^DIC
- if Y<0
- GOTO EXIT
- SET DA=+Y
- SET HLDEV=$PIECE(^HL(770,DA,0),"^",6)
- IF HLDEV']""
- WRITE !!,*7,"You must define an HL7 Device for this Non-DHCP Application before you can",!,"start the log.",!
- +3 IF HLDEV]""
- WRITE !!,"The HL7 log is currently turned ",$SELECT($DATA(^HL(770,"ALOG",HLDEV,DA)):"on.",1:"off."),!
- +4 SET DIE=DIC
- SET DR=$SELECT(HLDEV']"":"6R;",1:"")_50
- SET DIE("NO^")="OUTOK"
- DO ^DIE
- +5 WRITE !
- SET DIR(0)="Y"
- SET DIR("B")="Yes"
- SET DIR("A")="Do you want to purge existing log entries"
- DO ^DIR
- IF Y=1
- IF HLDEV]""
- KILL ^TMP("HL",HLDEV)
- EXIT KILL BY,DA,DHD,DIC,DIE,DIR,DR,FLDS,FR,L,HLDEV,TO,X,Y
- QUIT
- +1 ;
- LLED ;Logical Link Edit, file 870
- +1 ;HL*161 add code to make sure the Logical Link is shutdown RRA ticket 217900
- +2 FOR
- Begin DoDot:1
- +3 NEW DA,DIC,DDSFILE,DR,HLIEN,HLNAME,HLLL0
- +4 SET DIC="^HLCS(870,"
- SET DIC(0)="AEMQLZ"
- +5 WRITE @IOF,!
- DO ^DIC
- if Y<0
- QUIT
- +6 SET DA=+Y
- SET DR="[HL7 LOGICAL LINK]"
- SET DDSFILE=DIC
- +7 SET HLIEN=+Y
- SET HLNAME=$PIECE(Y,"^",2)
- SET HLLL0=$GET(Y(0))
- +8 IF '$PIECE(HLLL0,"^",15)&($LENGTH($PIECE(HLLL0,"^",3)))&($PIECE($GET(^HLCS(870,HLIEN,400)),"^",3)'="M")
- WRITE !!,HLNAME_" must be shutdown before it can be edited"
- HANG 2
- QUIT
- +9 DO ^DDS
- SET Y=0
- +10 WRITE !!!,"If you shut down this link to edit, please remember to restart if appropriate"
- HANG 2
- End DoDot:1
- if Y<0
- QUIT
- +11 QUIT
- +12 ;
- INTED ;Interface edit, file 101
- +1 FOR
- Begin DoDot:1
- +2 NEW DA,DIC,DDSFILE,DR
- +3 SET DIC="^ORD(101,"
- SET DIC(0)="AEMQLZ"
- SET DIC("S")="N Z S Z=$P(^(0),U,4) I Z=""E""!(Z=""S"")"
- +4 WRITE @IOF,!
- DO ^DIC
- if Y<0
- QUIT
- +5 SET DA=+Y
- SET DR="[HL7 INTERFACE]"
- SET DDSFILE=DIC
- +6 DO ^DDS
- SET Y=0
- End DoDot:1
- if Y<0
- QUIT
- +7 QUIT
- +8 ;
- HOLD ;Hold Screen at End of Display
- +1 NEW DIR
- +2 SET DIR(0)="E"
- DO ^DIR
- +3 QUIT