Routine: SDWLAHRP

SDWLAHRP ;;IOFO BAY PINES/TEH - EWL REPORT - PRINT;06/12/2002 ; 20 Aug 2002 2:10 PM

 ;;5.3;scheduling;**419,1015**;AUG 13 1993;Build 21

 ;==================================================================================

 ;                                      NOTES

 ;==================================================================================

EN ;

 S PG=0 D HD

 S SDWLA=0

 F  S SDWLA=$O(^XTMP("SDWLAHR",SDWLJ,"LIST",SDWLA)) Q:SDWLA<1  D

 .S DIC="^SDWL(409.3,",DA=SDWLA,DR=":" D EN^DIQ

 .I $Y>(IOSL-5) D HD

 G END

HD W:$D(IOF) @IOF

 W !!,?80-$L("EWL CUSTOM AD HOC REPORT")\2,"EWL CUSTOM AD HOC REPORT",?65 S PG=PG+1 W "PAGE: ",PG,!

 X ^DD("DD") W ?80-$L(Y)\2,Y,!!

END ;

 K DIR,DIC,DR,DIE,SDWLERR,SDWLF,SDWLX,SDLFD,SDWLCTX,SDWLDAT,SDWLPROM,SDWLINST,SDWLI,SDWLTAG,SDWLY

 K PG,DA,SDWLA,SDWLJ,Y

SDWLAHRP  ;;IOFO BAY PINES/TEH - EWL REPORT - PRINT;06/12/2002 ; 20 Aug 2002 2:10 PM

 +1       ;;5.3;scheduling;**419,1015**;AUG 13 1993;Build 21

 +2       ;

 +3       ;

 +4       ;

 +5       ;

 +6       ;

 +7       ;

 +8       ;==================================================================================

 +9       ;                                      NOTES

 +10      ;==================================================================================

 +11      ;

 +12      ;

EN        ;

 +1        SET PG=0

           DO HD

 +2        SET SDWLA=0

 +3        FOR

               SET SDWLA=$ORDER(^XTMP("SDWLAHR",SDWLJ,"LIST",SDWLA))

               IF SDWLA<1

                   QUIT

               Begin DoDot:1

 +4                SET DIC="^SDWL(409.3,"

                   SET DA=SDWLA

                   SET DR=":"

                   DO EN^DIQ

 +5                IF $Y>(IOSL-5)

                       DO HD

               End DoDot:1

 +6        GOTO END

HD         IF $DATA(IOF)

               WRITE @IOF

 +1        WRITE !!,?80-$LENGTH("EWL CUSTOM AD HOC REPORT")\2,"EWL CUSTOM AD HOC REPORT",?65

           SET PG=PG+1

           WRITE "PAGE: ",PG,!

 +2        XECUTE ^DD("DD")

           WRITE ?80-$LENGTH(Y)\2,Y,!!

 +3        QUIT

END       ;

 +1        KILL DIR,DIC,DR,DIE,SDWLERR,SDWLF,SDWLX,SDLFD,SDWLCTX,SDWLDAT,SDWLPROM,SDWLINST,SDWLI,SDWLTAG,SDWLY

 +2        KILL PG,DA,SDWLA,SDWLJ,Y

 +3        QUIT

SDWLAHRP.m