DIARR5.m

DIARR5 ;SFISC/DCM-ARCHIVING(READ ARCHIVED FG)-PRINT REQUEST ;4/8/93  8:00 AM

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

PRINT I $D(DIARQUED) G Q

 S IOP=DIARPDEV D ^%ZIS G Q:POP

DQ S DIARPG=0

 F DIARY=0:0 S DIARY=$O(DIARR(DIARY)) Q:DIARY'>0  D HD Q:$D(DTOUT)!($D(DIRUT))  D PRINT1:$D(^TMP("DIARO",$J,DIARY)) W:'$D(^TMP("DIARO",$J,DIARY)) !,?11,"MATCHES FOUND: ",DIARRF(DIARY)

 D ^%ZISC

 Q

 ;

PRINT1 F DIARZ=0:0 S DIARZ=$O(^TMP("DIARO",$J,DIARY,DIARZ)) Q:DIARZ'>0!$D(DTOUT)!$D(DIRUT)  W ! F DIARZ1=0:0 S DIARZ1=$O(^TMP("DIARO",$J,DIARY,DIARZ,DIARZ1)) Q:DIARZ1'>0  W ^(DIARZ1),! I $Y>(IOSL-2) D HD Q:$D(DTOUT)!$D(DIRUT)

 W !,?11,"MATCHES FOUND: ",DIARRF(DIARY)

 Q

 ;

HD U IO

 I "C"[$E(IOST) K DIR S DIR(0)="E" D ^DIR Q:$D(DTOUT)!($D(DIRUT))

 S Y=DT X ^DD("DD")

 W:$Y @IOF W "ARCHIVE RETRIEVAL LIST",?60,Y,?72,"PAGE: ",DIARPG+1

HD1 W !,"REQUEST: ",DIARY W:$D(DIARR(DIARY,.01)) !,?2,DIAR01," = ",DIARR(DIARY,.01) D HD2:$D(DIARR(DIARY,"ID"))

 S $P(DIARLINE,"-",IOM)="" W !,DIARLINE,! S DIARPG=DIARPG+1

 Q

 ;

HD2 F DIARX1=0:0 S DIARX1=$O(DIARR(DIARY,"ID",DIARX1)) Q:DIARX1'>0  W:DIARX1 !,?2,$P(DIARID(DIARX1),U)," = ",DIARR(DIARY,"ID",DIARX1)

 Q

 ;

Q S ZTRTN="DQ^DIARR5",ZTDTH=$H,ZTSAVE("DIARR(")="",ZTSAVE("^TMP(""DIARO"",$J,")="",ZTSAVE("DIARRF(")="",ZTDESC="RETRIEVAL OF ARCHIVED DATA",ZTIO=DIARPDEV,ZTSAVE("DIAR01")="",ZTSAVE("DIARID(")=""

 D ^%ZTLOAD,HOME^%ZIS

 U IO(0) W !! I '$D(DIARQUED) W:POP "UNABLE TO OPEN SELECTED PRINTER AT THIS TIME.  "

 W "OUTPUT QUEUED!"

 Q

DIARR5    ;SFISC/DCM-ARCHIVING(READ ARCHIVED FG)-PRINT REQUEST ;4/8/93  8:00 AM

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

PRINT      IF $DATA(DIARQUED)

               GOTO Q

 +1        SET IOP=DIARPDEV

           DO ^%ZIS

           IF POP

               GOTO Q

DQ         SET DIARPG=0

 +1        FOR DIARY=0:0

               SET DIARY=$ORDER(DIARR(DIARY))

               IF DIARY'>0

                   QUIT 

               DO HD

               IF $DATA(DTOUT)!($DATA(DIRUT))

                   QUIT 

               IF $DATA(^TMP("DIARO",$JOB,DIARY))

                   DO PRINT1

               IF '$DATA(^TMP("DIARO",$JOB,DIARY))

                   WRITE !,?11,"MATCHES FOUND: ",DIARRF(DIARY)

 +2        DO ^%ZISC

 +3        QUIT 

 +4       ;

PRINT1     FOR DIARZ=0:0

               SET DIARZ=$ORDER(^TMP("DIARO",$JOB,DIARY,DIARZ))

               IF DIARZ'>0!$DATA(DTOUT)!$DATA(DIRUT)

                   QUIT 

               WRITE !

               FOR DIARZ1=0:0

                   SET DIARZ1=$ORDER(^TMP("DIARO",$JOB,DIARY,DIARZ,DIARZ1))

                   IF DIARZ1'>0

                       QUIT 

                   WRITE ^(DIARZ1),!

                   IF $Y>(IOSL-2)

                       DO HD

                       IF $DATA(DTOUT)!$DATA(DIRUT)

                           QUIT 

 +1        WRITE !,?11,"MATCHES FOUND: ",DIARRF(DIARY)

 +2        QUIT 

 +3       ;

HD         USE IO

 +1        IF "C"[$EXTRACT(IOST)

               KILL DIR

               SET DIR(0)="E"

               DO ^DIR

               IF $DATA(DTOUT)!($DATA(DIRUT))

                   QUIT 

 +2        SET Y=DT

           XECUTE ^DD("DD")

 +3        IF $Y

               WRITE @IOF

           WRITE "ARCHIVE RETRIEVAL LIST",?60,Y,?72,"PAGE: ",DIARPG+1

HD1        WRITE !,"REQUEST: ",DIARY

           IF $DATA(DIARR(DIARY,.01))

               WRITE !,?2,DIAR01," = ",DIARR(DIARY,.01)

           IF $DATA(DIARR(DIARY,"ID"))

               DO HD2

 +1        SET $PIECE(DIARLINE,"-",IOM)=""

           WRITE !,DIARLINE,!

           SET DIARPG=DIARPG+1

 +2        QUIT 

 +3       ;

HD2        FOR DIARX1=0:0

               SET DIARX1=$ORDER(DIARR(DIARY,"ID",DIARX1))

               IF DIARX1'>0

                   QUIT 

               IF DIARX1

                   WRITE !,?2,$PIECE(DIARID(DIARX1),U)," = ",DIARR(DIARY,"ID",DIARX1)

 +1        QUIT 

 +2       ;

Q          SET ZTRTN="DQ^DIARR5"

           SET ZTDTH=$HOROLOG

           SET ZTSAVE("DIARR(")=""

           SET ZTSAVE("^TMP(""DIARO"",$J,")=""

           SET ZTSAVE("DIARRF(")=""

           SET ZTDESC="RETRIEVAL OF ARCHIVED DATA"

           SET ZTIO=DIARPDEV

           SET ZTSAVE("DIAR01")=""

           SET ZTSAVE("DIARID(")=""

 +1        DO ^%ZTLOAD

           DO HOME^%ZIS

 +2        USE IO(0)

           WRITE !!

           IF '$DATA(DIARQUED)

               IF POP

                   WRITE "UNABLE TO OPEN SELECTED PRINTER AT THIS TIME.  "

 +3        WRITE "OUTPUT QUEUED!"

 +4        QUIT