DGPTOPCE.m

DGPTOPCE ;ALB/DWS - PRINT 801 NOT SENT TO PCE REPORT ;5/24/05 1:04pm

 ;;5.3;Registration;**635**;Aug 13, 1993

 N DIR,DIC,BY,FR,TO,L,DIS,Y,DGST,DGEND

 S DIR(0)="D^:DT",DIR("A")="Select Start Date",DIR("B")="T-30" D ^DIR

 K DIR

 I '$D(DIRUT),Y D

 .S DGST=Y,DIR(0)="D^:DT",DIR("A")="Select End Date",DIR("B")="T"

 .W " (",Y(0),")" D ^DIR K DIR

 .I '$D(DIRUT),Y D

 ..W " (",Y(0),")" S DGEND=Y,DIC="^DGPT(",FLDS="[801notsenttopce]"

 ..S BY="[801FIND]",FR(0,1)=DGST,TO(0,1)=DGEND+1 D NOW^%DTC

 ..S Y=DGST D DD^%DT S DGST=Y,Y=DGEND D DD^%DT S DGEND=Y

 ..S DHD="[801HEADER]"

 ..D EN1^DIP

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGPTOPCE   598     printed  Apr 09, 2024@22:03:33                                                                                                                                                                                                     Page 2

DGPTOPCE  ;ALB/DWS - PRINT 801 NOT SENT TO PCE REPORT ;5/24/05 1:04pm

 +1       ;;5.3;Registration;**635**;Aug 13, 1993

 +2        NEW DIR,DIC,BY,FR,TO,L,DIS,Y,DGST,DGEND

 +3        SET DIR(0)="D^:DT"

           SET DIR("A")="Select Start Date"

           SET DIR("B")="T-30"

           DO ^DIR

 +4        KILL DIR

 +5        IF '$DATA(DIRUT)

               IF Y

                   Begin DoDot:1

 +6                    SET DGST=Y

                       SET DIR(0)="D^:DT"

                       SET DIR("A")="Select End Date"

                       SET DIR("B")="T"

 +7                    WRITE " (",Y(0),")"

                       DO ^DIR

                       KILL DIR

 +8                    IF '$DATA(DIRUT)

                           IF Y

                               Begin DoDot:2

 +9                                WRITE " (",Y(0),")"

                                   SET DGEND=Y

                                   SET DIC="^DGPT("

                                   SET FLDS="[801notsenttopce]"

 +10                               SET BY="[801FIND]"

                                   SET FR(0,1)=DGST

                                   SET TO(0,1)=DGEND+1

                                   DO NOW^%DTC

 +11                               SET Y=DGST

                                   DO DD^%DT

                                   SET DGST=Y

                                   SET Y=DGEND

                                   DO DD^%DT

                                   SET DGEND=Y

 +12                               SET DHD="[801HEADER]"

 +13                               DO EN1^DIP

                               End DoDot:2

                   End DoDot:1

 +14       QUIT