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 ---[H[J[2J[HDGPTOPCE 598 printed Nov 22, 2024@18:03:18 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
