Routine: HLCSRPT

HLCSRPT ;ISC-SF/RAH-TRANS LOG CONTROL & MISC ;06/23/99  11:10 AM

 ;;1.6;HEALTH LEVEL SEVEN;**19,50,167**;Oct 13, 1995;Build 2

EN ; Entry Point

 I '$$TEST^DDBRT S IOP="HOME" D ^%ZIS I '$$TEST^DDBRT W !!," ===>> Screen Attributes NOT Defined. Use ^ZU or ^XUP before invoking.",!! D EXIT H 3 Q

 D SCREEN

 S HLCSNREC=BLDON_" ===>>>  NO MATCHING RECORDS  <<<=== "_BLDOFF

 S HLCSPTR=1,HLCSRNO=1

 S VERS22=""

 I 22'>+$$VERSION^XPDUTL("DI")!($$PATCH^XPDUTL("DI*21.0*32")) S VERS22="YES"

 I VERS22'="YES" S ^TMP("DDBPF1Z",$J)="D SHOWMSG^HLCSRPT Q"

 S ^TMP($J,"LIST","MESSAGE TEXT")="^TMP($J,""MESSAGE"",HLCSRNO)"

 S ^TMP($J,"LIST","IEN RECORD #   MESSAGE ID #         Log Link   Msg:Evn IO Sndg Apl Rcvr Apl HDR")="^TMP(""TLOG"",$J)"

REEN ; Internal Re-entry Point

 W @IOF,! S HLCSHDR="Search Transmission Log" D HLCSBAR

 K DIR,OUT,DIC,STOP,Y W !!

 S DIR("A")="Selection"

 S DIR(0)="SO^M:Message Search;P:Pending Transmissions;E:Error Listing;Q:Quit (also uparrow, or <RETURN>)"

 D ^DIR G:$D(DIRUT)!(X="") EXIT S ACTION=X,ACTION=$TR(ACTION,"mpeq","MPEQ")

 K DIR,X,Y

 S (HLCSAL,HLCSLS,HLCSES)=0

 I ACTION="Q" G EXIT

 I "MPE"'[ACTION G ENEND

 I ACTION="P" S HLCSPS=1 D EN^HLCSRPT1 G REEN

 I ACTION="E" S HLCSERR=1 D EN^HLCSRPT2 G REEN

 I ACTION="M" D ADVSRCH^HLCSRPT3 G REEN

ENEND ;

 K DIR,OUT,DIC,STOP,X,Y,ACTION

 G REEN

GETTIME ;

 W @IOF,! S HLCSHDR="Start/Stop Time Selection" D HLCSBAR

GETSTART ;

 W !!,"  Enter START Date and Time. Date is required.",!

 S DIR(0)="D^::AEPSTX",DIR("?")="^D HELP^%DTC",DIR("B")="T"

 D ^DIR S:$D(DIRUT)!(X="") STOP=1 I $D(STOP) K DIR,X,Y Q

 I Y'["." S Y=Y_".000001"

 S HLCSST=Y K DIR,X,Y

GETEND ;

 W !!,"  Enter END Date and Time. Date is required.",!

 S DIR(0)="D^::AESTX",DIR("?")="^D HELP^%DTC",DIR("B")="NOW"

 D ^DIR S:$D(DIRUT)!(X="") STOP=1 I $D(STOP) K DIR,X,Y Q

 I Y'["." S Y=Y_".235959"

 S HLCSET=Y K DIR,X,Y

DISPLAY ; common display method

 ; clean-up here

 S HLCSPTR=$P(^TMP("TLOG",$J,1)," "),HLCSK=$O(^HLMA("C",HLCSPTR,0))

 S HLCSPTR=+$P($G(^HLMA(+HLCSK,0)),U)

 I VERS22'="YES" D DOCLIST^DDBR("^TMP($J,""LIST"")","NR")

 E  D BROWSE^DDBR("^TMP(""TLOG"",$J)","NA",HLCSTITL)

FORMAT ; Format a report line

 S HLCSY=""

 S HLCSRNO=HLCSJ,SPACE20="                    "

 I VERS22'="YES" D

 . S HLCSRNO=HLCSRNO_SPACE20 S HLCSRNO=$E(HLCSRNO,1,14) S HLCSY=HLCSRNO_" "

 . S HLCSMID=$P(HLCSX,U,2),HLCSMX=HLCSMID,HLCSPTR=$P(HLCSX,U,1)

 . S HLCSMID=HLCSMID_SPACE20 S HLCSMID=$E(HLCSMID,1,20)

 . S HLCSY=HLCSY_HLCSMID_" "

 I VERS22="YES" D

 . S HLCSMID=$P(HLCSX,U,2),HLCSMX=HLCSMID,HLCSPTR=$P(HLCSX,U,1)

 . S HLCSMID="$.%$CREF$^TMP($J,""MESSAGE"","_HLCSRNO_")$CREF$^"_HLCSMX_"$.%"

 . S Y=$L(HLCSMX),X=$E(SPACE20,1,20-Y) S HLCSMID=HLCSMID_X K X,Y

 . S HLCSY=HLCSMID_" "

 . S HLCSDTE=$P(HLCSX,U,1)

 . S HLCSDTE=$P(^HL(772,HLCSDTE,0),U,1)

 . S YR=$E(HLCSDTE,2,3),MO=$E(HLCSDTE,4,5),DAY=$E(HLCSDTE,6,7)

 . S HLCSDTE=MO_DAY_YR_"."_$P(HLCSDTE,".",2)

 . S HLCSDTE=HLCSDTE_SPACE20,HLCSDTE=$E(HLCSDTE,1,14)

 . S HLCSY=HLCSY_HLCSDTE_" "

 S HLCSY=HLCSY_$E(HLCSLNK_SPACE20,1,10)_" "

 S HLCSY=HLCSY_HLCSEVN_" "

 S HLCSTYP=$P(HLCSX,U,3) S:HLCSTYP="O" HLCSTYP="OT" S:HLCSTYP="I" HLCSTYP="IN"

 S HLCSY=HLCSY_$E(HLCSTYP_SPACE20,1,2)_" "

 S HLCSSRVR=$P(HLCSX,U,11) I HLCSSRVR'="",($D(^HL(771,HLCSSRVR,0))) S HLCSSRVR=$P(^HL(771,HLCSSRVR,0),U,1)

 S HLCSY=HLCSY_$E(HLCSSRVR_SPACE20,1,8)_" "

 S HLCSCLNT=$P(HLCSX,U,12) I HLCSCLNT'="",($D(^HL(771,HLCSCLNT,0))) S HLCSCLNT=$P(^HL(771,HLCSCLNT,0),U,1)

 S HLCSY=HLCSY_$E(HLCSCLNT_SPACE20,1,8)

 S HLCSLN=HLCSLN+1

 I VERS22'="YES" S HLCSY=HLCSY_" " I $D(^HLMA(HLCSJ,"MSH",1,0)) S HLCSY=HLCSY_^HLMA(HLCSJ,"MSH",1,0)

 S ^TMP("TLOG",$J,HLCSLN)=HLCSY

 I VERS22="YES" S ^TMP($J,"MESSAGE",HLCSJ)="$XC$^D SHOWMSG^HLCSRPT1("_HLCSJ_","_HLCSPTR_")$XC$^MESSAGE"

HLCSBAR ; Center Title on Top Line of Screen

 W RVON,?(80-$L(HLCSHDR)\2),HLCSHDR,$E(SPACE,$X,77),RVOFF,!

EXIT ;

 K DIR,OUT,DIC,STOP,I,X,Y,ACTION,DIRUT,DTOUT,DUOUT

 K HLCSHDR,HLCSLN,HLCSI,HLCSJ,HLCSY,HLCSX,HLCSRNO

 K HLCSLINK,HLCSLNK,HLCSEVNT,HLCSEVN,HLCSMID,HLCSTYP,HLCSSRVR,HLCSCLNT

 K RVON,RVOFF,CEOP,BLDON,BLDOFF,SPACE,SPACE20

 K HLCSTEVN,HLCSTEV1,HLCSTEV2,HLCSEVN1,HLCSEVN2

 K HLCSTLNK,HLCSDTP,HLCSDTE,HLCSET,HLCSN,HLCSNREC,HLCSST

 K HLCSTITL,HLCSPTR,HLCSK,SPACE25,SPACE30,SPACE80

 K HLCSAL,HLCSLS,HLCSES,HLCSES1,HLCSES2,HLCSIO,HLCSPS

 K YR,MO,DAY,VERS22,XXY,XXZ,YY1,YY2,Y1Y2,HLCSMX

 K ^TMP($J,"LIST"),^TMP("DDBPF1Z",$J),^TMP("TLOG",$J)

 K ^TMP($J,"MESSAGE")

SHOWMSG ; Enable switching to specific message (used by PF1Z).

 ; If VERS22 installed, won't get here.

 W @IOF

 S DIR(0)="F:AE",DIR("A")="Enter Record Number: "

 D ^DIR Q:$D(DIRUT)

 I Y=-1!(X="") Q

 S HLCSRNO=X I '$D(^HLMA(HLCSRNO,0)) D  Q

 . W !!,BLDON,"  ==>  NO SUCH RECORD NUMBER <== ",BLDOFF H 3

 S HLCSPTR=$P(^HLMA(HLCSRNO,0),"^",1)

 S XXY=HLCSRNO,XXZ=HLCSPTR D SHOWMSG^HLCSRPT1(XXY,XXZ)

 D SWITCH

SWITCH ; per interim DBIA, until VA Fileman v22.0 released.

 N DDBLN,DDBZ,DIC,DIR,X,Y,DIRUT,DIROUT,DUOUT,DILN

 S DILN=DDBRSA(DDBRSA,"DDBSRL")-2

 S:$G(DDBLST)="" DDBLST="^TMP(""DDBLST"",$J)" S DDBLN=$S($D(@DDBLST@("A",DDBSA)):^(DDBSA),1:$O(@DDBLST@(" "),-1)+1)

 I $D(@DDBLST) D

 .I $O(@DDBLST@(" "),-1)=1,$G(@DDBLST@(1,"DDBSA"))=DDBSA Q

 .S DDBZ=$G(@DDBLST@("A",DDBSA),0)

 .S Y=2

 .D SAVEDDB^DDBR2(DDBLST,DDBLN),USAVEDDB^DDBR2(DDBLST,+Y)

 .S DIROUT=1

 N DDBLNA

 I $G(DDBLNA,-1)=-1 G PS

 I $G(DDBLNA(6))=DDBSA G PS  ;if current doc re-selected

 I $G(DDBLNA(6))]"",$D(@DDBLST@("APSA",DDBSA)) G PS  ;on list

 D:DDBLNA>0 SAVEDDB^DDBR2(DDBLST,DDBLN),WP^DDBR2(.DDBLNA)

PS D PSR^DDBR0(1)

HELP ;

 W !,"DATE AND TIME ARE BOTH REQUIRED"

SCREEN ;screen I/O parameteters

 S SPACE80=" "

 F I=1:1:80 S SPACE80=SPACE80_" "

 S SPACE=SPACE80

 S SPACE20=$E(SPACE,1,20),SPACE25=$E(SPACE,1,25),SPACE30=$E(SPACE,1,30)

 S X="IORVON;IORVOFF;IOINHI;IOINLOW" D ENDR^%ZISS

 S RVON=IORVON,RVOFF=IORVOFF,BLDON=IOINHI,BLDOFF=IOINLOW

 D KILL^%ZISS

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSRPT   5996     printed  Feb 18, 2025@23:23:21                                                                                                                                                                                                     Page 2

HLCSRPT   ;ISC-SF/RAH-TRANS LOG CONTROL & MISC ;06/23/99  11:10 AM

 +1       ;;1.6;HEALTH LEVEL SEVEN;**19,50,167**;Oct 13, 1995;Build 2

 +2       ;

 +3        QUIT

 +4       ;

EN        ; Entry Point

 +1        IF '$$TEST^DDBRT

               SET IOP="HOME"

               DO ^%ZIS

               IF '$$TEST^DDBRT

                   WRITE !!," ===>> Screen Attributes NOT Defined. Use ^ZU or ^XUP before invoking.",!!

                   DO EXIT

                   HANG 3

                   QUIT

 +2        DO SCREEN

 +3        SET HLCSNREC=BLDON_" ===>>>  NO MATCHING RECORDS  <<<=== "_BLDOFF

 +4        SET HLCSPTR=1

           SET HLCSRNO=1

 +5        SET VERS22=""

 +6        IF 22'>+$$VERSION^XPDUTL("DI")!($$PATCH^XPDUTL("DI*21.0*32"))

               SET VERS22="YES"

 +7        IF VERS22'="YES"

               SET ^TMP("DDBPF1Z",$JOB)="D SHOWMSG^HLCSRPT Q"

 +8        SET ^TMP($JOB,"LIST","MESSAGE TEXT")="^TMP($J,""MESSAGE"",HLCSRNO)"

 +9        SET ^TMP($JOB,"LIST","IEN RECORD #   MESSAGE ID #         Log Link   Msg:Evn IO Sndg Apl Rcvr Apl HDR")="^TMP(""TLOG"",$J)"

 +10      ;

REEN      ; Internal Re-entry Point

 +1        WRITE @IOF,!

           SET HLCSHDR="Search Transmission Log"

           DO HLCSBAR

 +2        KILL DIR,OUT,DIC,STOP,Y

           WRITE !!

 +3        SET DIR("A")="Selection"

 +4        SET DIR(0)="SO^M:Message Search;P:Pending Transmissions;E:Error Listing;Q:Quit (also uparrow, or <RETURN>)"

 +5        DO ^DIR

           if $DATA(DIRUT)!(X="")

               GOTO EXIT

           SET ACTION=X

           SET ACTION=$TRANSLATE(ACTION,"mpeq","MPEQ")

 +6        KILL DIR,X,Y

 +7        SET (HLCSAL,HLCSLS,HLCSES)=0

 +8        IF ACTION="Q"

               GOTO EXIT

 +9        IF "MPE"'[ACTION

               GOTO ENEND

 +10       IF ACTION="P"

               SET HLCSPS=1

               DO EN^HLCSRPT1

               GOTO REEN

 +11       IF ACTION="E"

               SET HLCSERR=1

               DO EN^HLCSRPT2

               GOTO REEN

 +12       IF ACTION="M"

               DO ADVSRCH^HLCSRPT3

               GOTO REEN

 +13      ;

ENEND     ;

 +1        KILL DIR,OUT,DIC,STOP,X,Y,ACTION

 +2        GOTO REEN

 +3       ;

GETTIME   ;

 +1        WRITE @IOF,!

           SET HLCSHDR="Start/Stop Time Selection"

           DO HLCSBAR

GETSTART  ;

 +1        WRITE !!,"  Enter START Date and Time. Date is required.",!

 +2        SET DIR(0)="D^::AEPSTX"

           SET DIR("?")="^D HELP^%DTC"

           SET DIR("B")="T"

 +3        DO ^DIR

           if $DATA(DIRUT)!(X="")

               SET STOP=1

           IF $DATA(STOP)

               KILL DIR,X,Y

               QUIT

 +4        IF Y'["."

               SET Y=Y_".000001"

 +5        SET HLCSST=Y

           KILL DIR,X,Y

GETEND    ;

 +1        WRITE !!,"  Enter END Date and Time. Date is required.",!

 +2        SET DIR(0)="D^::AESTX"

           SET DIR("?")="^D HELP^%DTC"

           SET DIR("B")="NOW"

 +3        DO ^DIR

           if $DATA(DIRUT)!(X="")

               SET STOP=1

           IF $DATA(STOP)

               KILL DIR,X,Y

               QUIT

 +4        IF Y'["."

               SET Y=Y_".235959"

 +5        SET HLCSET=Y

           KILL DIR,X,Y

 +6        QUIT

 +7       ;

DISPLAY   ; common display method

 +1       ; clean-up here

 +2        SET HLCSPTR=$PIECE(^TMP("TLOG",$JOB,1)," ")

           SET HLCSK=$ORDER(^HLMA("C",HLCSPTR,0))

 +3        SET HLCSPTR=+$PIECE($GET(^HLMA(+HLCSK,0)),U)

 +4        IF VERS22'="YES"

               DO DOCLIST^DDBR("^TMP($J,""LIST"")","NR")

 +5       IF '$TEST

               DO BROWSE^DDBR("^TMP(""TLOG"",$J)","NA",HLCSTITL)

 +6        QUIT

 +7       ;

FORMAT    ; Format a report line

 +1        SET HLCSY=""

 +2        SET HLCSRNO=HLCSJ

           SET SPACE20="                    "

 +3        IF VERS22'="YES"

               Begin DoDot:1

 +4                SET HLCSRNO=HLCSRNO_SPACE20

                   SET HLCSRNO=$EXTRACT(HLCSRNO,1,14)

                   SET HLCSY=HLCSRNO_" "

 +5                SET HLCSMID=$PIECE(HLCSX,U,2)

                   SET HLCSMX=HLCSMID

                   SET HLCSPTR=$PIECE(HLCSX,U,1)

 +6                SET HLCSMID=HLCSMID_SPACE20

                   SET HLCSMID=$EXTRACT(HLCSMID,1,20)

 +7                SET HLCSY=HLCSY_HLCSMID_" "

               End DoDot:1

 +8        IF VERS22="YES"

               Begin DoDot:1

 +9                SET HLCSMID=$PIECE(HLCSX,U,2)

                   SET HLCSMX=HLCSMID

                   SET HLCSPTR=$PIECE(HLCSX,U,1)

 +10               SET HLCSMID="$.%$CREF$^TMP($J,""MESSAGE"","_HLCSRNO_")$CREF$^"_HLCSMX_"$.%"

 +11               SET Y=$LENGTH(HLCSMX)

                   SET X=$EXTRACT(SPACE20,1,20-Y)

                   SET HLCSMID=HLCSMID_X

                   KILL X,Y

 +12               SET HLCSY=HLCSMID_" "

 +13               SET HLCSDTE=$PIECE(HLCSX,U,1)

 +14               SET HLCSDTE=$PIECE(^HL(772,HLCSDTE,0),U,1)

 +15               SET YR=$EXTRACT(HLCSDTE,2,3)

                   SET MO=$EXTRACT(HLCSDTE,4,5)

                   SET DAY=$EXTRACT(HLCSDTE,6,7)

 +16               SET HLCSDTE=MO_DAY_YR_"."_$PIECE(HLCSDTE,".",2)

 +17               SET HLCSDTE=HLCSDTE_SPACE20

                   SET HLCSDTE=$EXTRACT(HLCSDTE,1,14)

 +18               SET HLCSY=HLCSY_HLCSDTE_" "

               End DoDot:1

 +19       SET HLCSY=HLCSY_$EXTRACT(HLCSLNK_SPACE20,1,10)_" "

 +20       SET HLCSY=HLCSY_HLCSEVN_" "

 +21       SET HLCSTYP=$PIECE(HLCSX,U,3)

           if HLCSTYP="O"

               SET HLCSTYP="OT"

           if HLCSTYP="I"

               SET HLCSTYP="IN"

 +22       SET HLCSY=HLCSY_$EXTRACT(HLCSTYP_SPACE20,1,2)_" "

 +23       SET HLCSSRVR=$PIECE(HLCSX,U,11)

           IF HLCSSRVR'=""

               IF ($DATA(^HL(771,HLCSSRVR,0)))

                   SET HLCSSRVR=$PIECE(^HL(771,HLCSSRVR,0),U,1)

 +24       SET HLCSY=HLCSY_$EXTRACT(HLCSSRVR_SPACE20,1,8)_" "

 +25       SET HLCSCLNT=$PIECE(HLCSX,U,12)

           IF HLCSCLNT'=""

               IF ($DATA(^HL(771,HLCSCLNT,0)))

                   SET HLCSCLNT=$PIECE(^HL(771,HLCSCLNT,0),U,1)

 +26       SET HLCSY=HLCSY_$EXTRACT(HLCSCLNT_SPACE20,1,8)

 +27       SET HLCSLN=HLCSLN+1

 +28       IF VERS22'="YES"

               SET HLCSY=HLCSY_" "

               IF $DATA(^HLMA(HLCSJ,"MSH",1,0))

                   SET HLCSY=HLCSY_^HLMA(HLCSJ,"MSH",1,0)

 +29       SET ^TMP("TLOG",$JOB,HLCSLN)=HLCSY

 +30       IF VERS22="YES"

               SET ^TMP($JOB,"MESSAGE",HLCSJ)="$XC$^D SHOWMSG^HLCSRPT1("_HLCSJ_","_HLCSPTR_")$XC$^MESSAGE"

 +31       QUIT

 +32      ;

HLCSBAR   ; Center Title on Top Line of Screen

 +1        WRITE RVON,?(80-$LENGTH(HLCSHDR)\2),HLCSHDR,$EXTRACT(SPACE,$X,77),RVOFF,!

 +2        QUIT

 +3       ;

EXIT      ;

 +1        KILL DIR,OUT,DIC,STOP,I,X,Y,ACTION,DIRUT,DTOUT,DUOUT

 +2        KILL HLCSHDR,HLCSLN,HLCSI,HLCSJ,HLCSY,HLCSX,HLCSRNO

 +3        KILL HLCSLINK,HLCSLNK,HLCSEVNT,HLCSEVN,HLCSMID,HLCSTYP,HLCSSRVR,HLCSCLNT

 +4        KILL RVON,RVOFF,CEOP,BLDON,BLDOFF,SPACE,SPACE20

 +5        KILL HLCSTEVN,HLCSTEV1,HLCSTEV2,HLCSEVN1,HLCSEVN2

 +6        KILL HLCSTLNK,HLCSDTP,HLCSDTE,HLCSET,HLCSN,HLCSNREC,HLCSST

 +7        KILL HLCSTITL,HLCSPTR,HLCSK,SPACE25,SPACE30,SPACE80

 +8        KILL HLCSAL,HLCSLS,HLCSES,HLCSES1,HLCSES2,HLCSIO,HLCSPS

 +9        KILL YR,MO,DAY,VERS22,XXY,XXZ,YY1,YY2,Y1Y2,HLCSMX

 +10       KILL ^TMP($JOB,"LIST"),^TMP("DDBPF1Z",$JOB),^TMP("TLOG",$JOB)

 +11       KILL ^TMP($JOB,"MESSAGE")

 +12       QUIT

 +13      ;

SHOWMSG   ; Enable switching to specific message (used by PF1Z).

 +1       ; If VERS22 installed, won't get here.

 +2        WRITE @IOF

 +3        SET DIR(0)="F:AE"

           SET DIR("A")="Enter Record Number: "

 +4        DO ^DIR

           if $DATA(DIRUT)

               QUIT

 +5        IF Y=-1!(X="")

               QUIT

 +6        SET HLCSRNO=X

           IF '$DATA(^HLMA(HLCSRNO,0))

               Begin DoDot:1

 +7                WRITE !!,BLDON,"  ==>  NO SUCH RECORD NUMBER <== ",BLDOFF

                   HANG 3

               End DoDot:1

               QUIT

 +8        SET HLCSPTR=$PIECE(^HLMA(HLCSRNO,0),"^",1)

 +9        SET XXY=HLCSRNO

           SET XXZ=HLCSPTR

           DO SHOWMSG^HLCSRPT1(XXY,XXZ)

 +10       DO SWITCH

 +11       QUIT

SWITCH    ; per interim DBIA, until VA Fileman v22.0 released.

 +1        NEW DDBLN,DDBZ,DIC,DIR,X,Y,DIRUT,DIROUT,DUOUT,DILN

 +2        SET DILN=DDBRSA(DDBRSA,"DDBSRL")-2

 +3        if $GET(DDBLST)=""

               SET DDBLST="^TMP(""DDBLST"",$J)"

           SET DDBLN=$SELECT($DATA(@DDBLST@("A",DDBSA)):^(DDBSA),1:$ORDER(@DDBLST@(" "),-1)+1)

 +4        IF $DATA(@DDBLST)

               Begin DoDot:1

 +5                IF $ORDER(@DDBLST@(" "),-1)=1

                       IF $GET(@DDBLST@(1,"DDBSA"))=DDBSA

                           QUIT

 +6                SET DDBZ=$GET(@DDBLST@("A",DDBSA),0)

 +7                SET Y=2

 +8                DO SAVEDDB^DDBR2(DDBLST,DDBLN)

                   DO USAVEDDB^DDBR2(DDBLST,+Y)

 +9                SET DIROUT=1

               End DoDot:1

 +10       NEW DDBLNA

 +11       IF $GET(DDBLNA,-1)=-1

               GOTO PS

 +12      ;if current doc re-selected

           IF $GET(DDBLNA(6))=DDBSA

               GOTO PS

 +13      ;on list

           IF $GET(DDBLNA(6))]""

               IF $DATA(@DDBLST@("APSA",DDBSA))

                   GOTO PS

 +14       if DDBLNA>0

               DO SAVEDDB^DDBR2(DDBLST,DDBLN)

               DO WP^DDBR2(.DDBLNA)

PS         DO PSR^DDBR0(1)

 +1        QUIT

 +2       ;

HELP      ;

 +1        WRITE !,"DATE AND TIME ARE BOTH REQUIRED"

 +2        QUIT

 +3       ;

SCREEN    ;screen I/O parameteters

 +1        SET SPACE80=" "

 +2        FOR I=1:1:80

               SET SPACE80=SPACE80_" "

 +3        SET SPACE=SPACE80

 +4        SET SPACE20=$EXTRACT(SPACE,1,20)

           SET SPACE25=$EXTRACT(SPACE,1,25)

           SET SPACE30=$EXTRACT(SPACE,1,30)

 +5        SET X="IORVON;IORVOFF;IOINHI;IOINLOW"

           DO ENDR^%ZISS

 +6        SET RVON=IORVON

           SET RVOFF=IORVOFF

           SET BLDON=IOINHI

           SET BLDOFF=IOINLOW

 +7        DO KILL^%ZISS

 +8        QUIT

HLCSRPT.m