HLCSORAT ;ALB/MFK/jc - HEALTH LEVEL SEVEN ;07/13/99 15:20
;;1.6;HEALTH LEVEL SEVEN;**57**;Oct 13, 1995
;Report low level communications errors for serial links (HLLP,
;X3.28) in file 870.
START ; Main Entry point
N DIR,DIC,X,Y,HLZ,LINE,HLERR,HLSORT,HLAAA,HLSTAT,HLLL,HLQUEUE,POP
N %ZIS,DTOUT,DUOUT,HLDONE,HLTMP,SET,FOO,CODES
S (HLERR,HLSTAT,LINE)=""
D PROMPT I (Y=-1)!($D(DUOUT))!($D(DTOUT)) Q
D OPEN G END:POP
I $D(IO("Q")) D QUEUED,HOME^%ZIS G END
U IO
REPORT ; Output data after gathering
S HLZ=0
; GATHER AND SORT DATA
D ^HLCSORA1
I 'HLZ G NEXT
I HLDONE G END
F HLAAA=$Y:1:(IOSL-3) W !
I ($E(IOST,1,2)="C-") S DIR(0)="E" D ^DIR K DIR I Y=0!(Y="")!($D(DIRUT)) G END
NEXT ; PRINT THE DATA
D ^HLCSORA2
I 'HLZ W !,"No data found for this request"
END ;
; Clean up. Kill the ^TMP and other assorted variables.
K ^TMP("HLCSORAT",$J)
I $D(ZTQUEUED) S ZTREQ="@" Q
K DIRUT,HLZ
D ^%ZISC
Q
PROMPT ; Find out how user wants report done
S HLLL=""
S DIR(0)="FAOU"
S DIR("A")="Select HL7 Logical Link: "
S DIR("B")="All Links"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))
I Y="All Links" S Y=0
I Y'=0 D
.S X=Y,DIC="^HLCS(870,",DIC(0)="EMQZ" D ^DIC K DIC
Q:$D(DTOUT)!($D(DUOUT))
S HLLL=$P(Y,"^",1)
I Y=-1 Q
S DIR(0)="S^I:IN QUEUE;O:OUT QUEUE;B:BOTH"
S DIR("A")="Select queue for report",DIR("B")="B" D ^DIR K DIR
S HLQUEUE=Y
I '("IOB"[Y) Q
S HLQUEUE=$S(HLQUEUE="B":"12",HLQUEUE="I":1,HLQUEUE="O":2)
S SET="",CODES=$$GET1^DID(870.019,2,"","POINTER")
F HLTMP=1:1 S FOO=$P(CODES,";",HLTMP) Q:(FOO="") D
.S SET=SET_$E(FOO,1,1)
ERR S DIR(0)="SOM^"_CODES_"ALL:ALL ERRORS;F:FINISH SELECTING ERRORS"
S DIR("A")="Select an error code to sort by"_$S(HLERR'="":" ("_HLERR_")",1:"")
S DIR("B")=$S((HLERR=""):"ALL",1:"F")
S DIR("?",1)="Select the list of errors that you would like to sort by. There are also"
S DIR("?",2)="two special selections. ALL means that you would like to sort on all the"
S DIR("?")="error codes. F means that you have finished selecting error codes."
D ^DIR K DIR
I ((HLERR'[Y)&(Y'="F")) S HLERR=HLERR_Y
I Y="ALL" S HLERR=SET
I (HLERR="")!($D(DUOUT))!($D(DTOUT)) S Y=-1 Q
I (Y'="ALL")&(Y'="F") G ERR
S SET="",CODES=$$GET1^DID(870.019,1,"","POINTER")
F HLTMP=1:1 S FOO=$P(CODES,";",HLTMP) Q:(FOO="") D
.S SET=SET_$E(FOO,1,1)
STAT S DIR(0)="SOM^"_CODES_"ALL:ALL STATUS;F:FINISH SELECTING STATUS CODES"
S DIR("A")="Select a status code to sort by"_$S(HLSTAT'="":" ("_HLSTAT_")",1:"")
S DIR("B")=$S((HLSTAT=""):"ALL",1:"F")
S DIR("?",1)="Select a status code to sort the report by. There are two special"
S DIR("?",2)="selections. ALL indicates you would like a report on all the statuses. The"
S DIR("?")="F means you are finished selecting statuses."
D ^DIR K DIR
I ((HLSTAT'[Y)&(Y'="F")) S HLSTAT=HLSTAT_Y
I Y="ALL" S HLSTAT=SET
I (HLSTAT="")!($D(DTOUT))!($D(DUOUT)) S Y=-1 Q
I (Y'="ALL")&(Y'="F") G STAT
S HLSORT=HLERR_"^"_HLSTAT
Q
QUEUED ; If queued, set up and kick in TASKMAN
S ZTRTN="REPORT^HLCSORAT",ZTDESC="HL7 LOGICAL LINK REPORT",ZTSAVE("HLLL")="",ZTSAVE("HLQUEUE")="",ZTSAVE("HLSORT")="" D ^%ZTLOAD
W !!,$S($D(ZTSK):"Request Queued",1:"Request Cancelled")
K ZTSK
Q
OPEN ; Open a device
S %ZIS="QM" D ^%ZIS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSORAT 3284 printed Nov 22, 2024@17:06:56 Page 2
HLCSORAT ;ALB/MFK/jc - HEALTH LEVEL SEVEN ;07/13/99 15:20
+1 ;;1.6;HEALTH LEVEL SEVEN;**57**;Oct 13, 1995
+2 ;Report low level communications errors for serial links (HLLP,
+3 ;X3.28) in file 870.
START ; Main Entry point
+1 NEW DIR,DIC,X,Y,HLZ,LINE,HLERR,HLSORT,HLAAA,HLSTAT,HLLL,HLQUEUE,POP
+2 NEW %ZIS,DTOUT,DUOUT,HLDONE,HLTMP,SET,FOO,CODES
+3 SET (HLERR,HLSTAT,LINE)=""
+4 DO PROMPT
IF (Y=-1)!($DATA(DUOUT))!($DATA(DTOUT))
QUIT
+5 DO OPEN
if POP
GOTO END
+6 IF $DATA(IO("Q"))
DO QUEUED
DO HOME^%ZIS
GOTO END
+7 USE IO
REPORT ; Output data after gathering
+1 SET HLZ=0
+2 ; GATHER AND SORT DATA
+3 DO ^HLCSORA1
+4 IF 'HLZ
GOTO NEXT
+5 IF HLDONE
GOTO END
+6 FOR HLAAA=$Y:1:(IOSL-3)
WRITE !
+7 IF ($EXTRACT(IOST,1,2)="C-")
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF Y=0!(Y="")!($DATA(DIRUT))
GOTO END
NEXT ; PRINT THE DATA
+1 DO ^HLCSORA2
+2 IF 'HLZ
WRITE !,"No data found for this request"
END ;
+1 ; Clean up. Kill the ^TMP and other assorted variables.
+2 KILL ^TMP("HLCSORAT",$JOB)
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+4 KILL DIRUT,HLZ
+5 DO ^%ZISC
+6 QUIT
PROMPT ; Find out how user wants report done
+1 SET HLLL=""
+2 SET DIR(0)="FAOU"
+3 SET DIR("A")="Select HL7 Logical Link: "
+4 SET DIR("B")="All Links"
+5 DO ^DIR
+6 if $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+7 IF Y="All Links"
SET Y=0
+8 IF Y'=0
Begin DoDot:1
+9 SET X=Y
SET DIC="^HLCS(870,"
SET DIC(0)="EMQZ"
DO ^DIC
KILL DIC
End DoDot:1
+10 if $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+11 SET HLLL=$PIECE(Y,"^",1)
+12 IF Y=-1
QUIT
+13 SET DIR(0)="S^I:IN QUEUE;O:OUT QUEUE;B:BOTH"
+14 SET DIR("A")="Select queue for report"
SET DIR("B")="B"
DO ^DIR
KILL DIR
+15 SET HLQUEUE=Y
+16 IF '("IOB"[Y)
QUIT
+17 SET HLQUEUE=$SELECT(HLQUEUE="B":"12",HLQUEUE="I":1,HLQUEUE="O":2)
+18 SET SET=""
SET CODES=$$GET1^DID(870.019,2,"","POINTER")
+19 FOR HLTMP=1:1
SET FOO=$PIECE(CODES,";",HLTMP)
if (FOO="")
QUIT
Begin DoDot:1
+20 SET SET=SET_$EXTRACT(FOO,1,1)
End DoDot:1
ERR SET DIR(0)="SOM^"_CODES_"ALL:ALL ERRORS;F:FINISH SELECTING ERRORS"
+1 SET DIR("A")="Select an error code to sort by"_$SELECT(HLERR'="":" ("_HLERR_")",1:"")
+2 SET DIR("B")=$SELECT((HLERR=""):"ALL",1:"F")
+3 SET DIR("?",1)="Select the list of errors that you would like to sort by. There are also"
+4 SET DIR("?",2)="two special selections. ALL means that you would like to sort on all the"
+5 SET DIR("?")="error codes. F means that you have finished selecting error codes."
+6 DO ^DIR
KILL DIR
+7 IF ((HLERR'[Y)&(Y'="F"))
SET HLERR=HLERR_Y
+8 IF Y="ALL"
SET HLERR=SET
+9 IF (HLERR="")!($DATA(DUOUT))!($DATA(DTOUT))
SET Y=-1
QUIT
+10 IF (Y'="ALL")&(Y'="F")
GOTO ERR
+11 SET SET=""
SET CODES=$$GET1^DID(870.019,1,"","POINTER")
+12 FOR HLTMP=1:1
SET FOO=$PIECE(CODES,";",HLTMP)
if (FOO="")
QUIT
Begin DoDot:1
+13 SET SET=SET_$EXTRACT(FOO,1,1)
End DoDot:1
STAT SET DIR(0)="SOM^"_CODES_"ALL:ALL STATUS;F:FINISH SELECTING STATUS CODES"
+1 SET DIR("A")="Select a status code to sort by"_$SELECT(HLSTAT'="":" ("_HLSTAT_")",1:"")
+2 SET DIR("B")=$SELECT((HLSTAT=""):"ALL",1:"F")
+3 SET DIR("?",1)="Select a status code to sort the report by. There are two special"
+4 SET DIR("?",2)="selections. ALL indicates you would like a report on all the statuses. The"
+5 SET DIR("?")="F means you are finished selecting statuses."
+6 DO ^DIR
KILL DIR
+7 IF ((HLSTAT'[Y)&(Y'="F"))
SET HLSTAT=HLSTAT_Y
+8 IF Y="ALL"
SET HLSTAT=SET
+9 IF (HLSTAT="")!($DATA(DTOUT))!($DATA(DUOUT))
SET Y=-1
QUIT
+10 IF (Y'="ALL")&(Y'="F")
GOTO STAT
+11 SET HLSORT=HLERR_"^"_HLSTAT
+12 QUIT
QUEUED ; If queued, set up and kick in TASKMAN
+1 SET ZTRTN="REPORT^HLCSORAT"
SET ZTDESC="HL7 LOGICAL LINK REPORT"
SET ZTSAVE("HLLL")=""
SET ZTSAVE("HLQUEUE")=""
SET ZTSAVE("HLSORT")=""
DO ^%ZTLOAD
+2 WRITE !!,$SELECT($DATA(ZTSK):"Request Queued",1:"Request Cancelled")
+3 KILL ZTSK
+4 QUIT
OPEN ; Open a device
+1 SET %ZIS="QM"
DO ^%ZIS
+2 QUIT
