HLCSORAT.m

HLCSORAT ;ALB/MFK/jc - HEALTH LEVEL SEVEN ;07/13/99  15:20 [ 04/02/2003   8:38 AM ]

 ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003

 ;;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

HLCSORAT  ;ALB/MFK/jc - HEALTH LEVEL SEVEN ;07/13/99  15:20 [ 04/02/2003   8:38 AM ]

 +1       ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003

 +2       ;;1.6;HEALTH LEVEL SEVEN;**57**;Oct 13, 1995

 +3       ;Report low level communications errors for serial links (HLLP,

 +4       ;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