DGPTRPP ;ALB/MTC - PRINT/PURGE SPECIAL TRANSACTION REQUEST LIST ; 19 FEB 91
;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
PRN ;--entry for list
D INIT G ENQ:DGOUT
W @IOF,?12,"SPECIAL TRANSACTION REQUEST LISTING",!
D GETDATE G ENQ:DGOUT
D GETFMT G ENQ:DGOUT
S L=0,DIC="^DGP(45.87,",FLDS="[DGPT PRINT]",FR=SP1,TO=SP2,BY="@-.01"
S DIS(0)="I $E($P(^DGP(45.87,D0,0),U,4),2,4)=DGFMT!(DGFMT=""ALL"")"
D EN1^DIP
ENQ K X,Y,DGD1,DGD2,SP1,SP2,DGOUT,L,DIC,BY,FR,TO,FLDS,DIS,DGFMT,ZTDESC,ZTIO,ZTDTH,ZTRTN,ZTSAVE Q
;
GETDATE ;THIS ROUTINE WILL GET THE DATE RANGE FROM THE USER
S DGOUT=0,Y=$O(^DGP(45.87,"B",0))
I 'Y W !,"No records in PTF TRANSACTION LOG FILE" S DGOUT=1 G GETQ
D DD^%DT S %DT("B")=Y
S %DT("A")="Start with DATE OF REQUEST : ",%DT="AETS"
D ^%DT I (Y=-1)!$D(DTOUT) S DGOUT=1 G GETQ
S (SP1,%DT(0))=Y,%DT("B")="NOW",%DT("A")="Go to DATE OF REQUEST : "
D ^%DT I (Y=-1)!$D(DTOUT) S DGOUT=1 G GETQ
S SP2=Y
GETQ K %,%DT,X,Y,DIR,DIRUT,DTOUT Q
;
GETFMT ;-- will get from the user which records to process
S DGOUT=0
S DIR(0)="S^099:099 Transactions;150:150 Specific Record Printout (RPO);151:151 Generic Record Printout (RPO);ALL:ALL Records in Special Transaction File",DIR("A")="Process which records",DIR("B")="ALL"
D ^DIR I $D(DIRUT) S DGOUT=1 G GETFMTQ
S DGFMT=X
GETFMTQ ;
K DIR,X,Y,DIRUT
Q
;
PUR ;--entry for purge RPO
D INIT G ENQ:DGOUT
W @IOF,?12,"PURGE SPECIAL TRANSACTION REQUEST.",!
D GETDATE G ENQ:DGOUT
D GETFMT G ENQ:DGOUT
D CONT I DGOUT G ENQ
D NOW^%DTC S ZTIO="",ZTDESC="Purge Special Transactions",ZTDTH=%,ZTRTN="PURGE^DGPTRPP",ZTSAVE("SP1")="",ZTSAVE("SP2")="",ZTSAVE("DGFMT")="" D ^%ZTLOAD
W !!,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!")
D HOME^%ZIS K ZTSAVE,ZTSK
D ENQ
Q
;
CONT ;--verify before delete
S DGOUT=0
S Y=SP1 D DD^%DT S DGD1=Y,Y=SP2 D DD^%DT S DGD2=Y
S DIR(0)="Y",DIR("A")="Purge "_DGFMT_" Requests from "_DGD1_" to "_DGD2,DIR("B")="NO"
D ^DIR
I (Y=0)!$D(DIRUT) S DGOUT=1
CONTQ K X,Y,DIR,DIRUT
Q
PURGE ;purge rpo record for the given date range
S DGTPUR=0
F DGDATE=SP1-.000001:0 S DGDATE=$O(^DGP(45.87,"B",DGDATE)) Q:'DGDATE!(DGDATE>SP2) F DGDA=0:0 S DGDA=$O(^DGP(45.87,"B",DGDATE,DGDA)) Q:'DGDA I $D(^DGP(45.87,DGDA,0)) I $E($P(^DGP(45.87,DGDA,0),U,4),2,4)=DGFMT!(DGFMT="ALL") D GOGO
PURGEQ ;
D COM
K DGTPUR,DGFMT,DGI,DGDATE,DGDA
Q
;
GOGO ;-- count total items purged call delete routine
S DGTPUR=DGTPUR+1
D DEL^DGPTRPO
Q
COM ;--send mailman message when purge is done
S DGPURMSG(1,0)="PTF PURGE SPECIAL TRANSACTION LOG COMPLETE.",DGPURMSG(2,0)="Record format :"_DGFMT,DGPURMSG(3,0)="Total # of records deleted = "_DGTPUR
S XMTEXT="DGPURMSG(",XMDUZ=.5,XMY(DUZ)="",XMSUB="PURGE PTF SPECIAL TRANSACTION LOG" D ^XMD
K XMTEXT,XMY,XMZ,DGPURMSG,XMSUB,XMDUZ
Q
;
INIT ;
D LO^DGUTL,HOME^%ZIS S DGOUT=0
Q
DGPTRPP ;ALB/MTC - PRINT/PURGE SPECIAL TRANSACTION REQUEST LIST ; 19 FEB 91
+1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
PRN ;--entry for list
+1 DO INIT
IF DGOUT
GOTO ENQ
+2 WRITE @IOF,?12,"SPECIAL TRANSACTION REQUEST LISTING",!
+3 DO GETDATE
IF DGOUT
GOTO ENQ
+4 DO GETFMT
IF DGOUT
GOTO ENQ
+5 SET L=0
SET DIC="^DGP(45.87,"
SET FLDS="[DGPT PRINT]"
SET FR=SP1
SET TO=SP2
SET BY="@-.01"
+6 SET DIS(0)="I $E($P(^DGP(45.87,D0,0),U,4),2,4)=DGFMT!(DGFMT=""ALL"")"
+7 DO EN1^DIP
ENQ KILL X,Y,DGD1,DGD2,SP1,SP2,DGOUT,L,DIC,BY,FR,TO,FLDS,DIS,DGFMT,ZTDESC,ZTIO,ZTDTH,ZTRTN,ZTSAVE
QUIT
+1 ;
GETDATE ;THIS ROUTINE WILL GET THE DATE RANGE FROM THE USER
+1 SET DGOUT=0
SET Y=$ORDER(^DGP(45.87,"B",0))
+2 IF 'Y
WRITE !,"No records in PTF TRANSACTION LOG FILE"
SET DGOUT=1
GOTO GETQ
+3 DO DD^%DT
SET %DT("B")=Y
+4 SET %DT("A")="Start with DATE OF REQUEST : "
SET %DT="AETS"
+5 DO ^%DT
IF (Y=-1)!$DATA(DTOUT)
SET DGOUT=1
GOTO GETQ
+6 SET (SP1,%DT(0))=Y
SET %DT("B")="NOW"
SET %DT("A")="Go to DATE OF REQUEST : "
+7 DO ^%DT
IF (Y=-1)!$DATA(DTOUT)
SET DGOUT=1
GOTO GETQ
+8 SET SP2=Y
GETQ KILL %,%DT,X,Y,DIR,DIRUT,DTOUT
QUIT
+1 ;
GETFMT ;-- will get from the user which records to process
+1 SET DGOUT=0
+2 SET DIR(0)="S^099:099 Transactions;150:150 Specific Record Printout (RPO);151:151 Generic Record Printout (RPO);ALL:ALL Records in Special Transaction File"
SET DIR("A")="Process which records"
SET DIR("B")="ALL"
+3 DO ^DIR
IF $DATA(DIRUT)
SET DGOUT=1
GOTO GETFMTQ
+4 SET DGFMT=X
GETFMTQ ;
+1 KILL DIR,X,Y,DIRUT
+2 QUIT
+3 ;
PUR ;--entry for purge RPO
+1 DO INIT
IF DGOUT
GOTO ENQ
+2 WRITE @IOF,?12,"PURGE SPECIAL TRANSACTION REQUEST.",!
+3 DO GETDATE
IF DGOUT
GOTO ENQ
+4 DO GETFMT
IF DGOUT
GOTO ENQ
+5 DO CONT
IF DGOUT
GOTO ENQ
+6 DO NOW^%DTC
SET ZTIO=""
SET ZTDESC="Purge Special Transactions"
SET ZTDTH=%
SET ZTRTN="PURGE^DGPTRPP"
SET ZTSAVE("SP1")=""
SET ZTSAVE("SP2")=""
SET ZTSAVE("DGFMT")=""
DO ^%ZTLOAD
+7 WRITE !!,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Cancelled!")
+8 DO HOME^%ZIS
KILL ZTSAVE,ZTSK
+9 DO ENQ
+10 QUIT
+11 ;
CONT ;--verify before delete
+1 SET DGOUT=0
+2 SET Y=SP1
DO DD^%DT
SET DGD1=Y
SET Y=SP2
DO DD^%DT
SET DGD2=Y
+3 SET DIR(0)="Y"
SET DIR("A")="Purge "_DGFMT_" Requests from "_DGD1_" to "_DGD2
SET DIR("B")="NO"
+4 DO ^DIR
+5 IF (Y=0)!$DATA(DIRUT)
SET DGOUT=1
CONTQ KILL X,Y,DIR,DIRUT
+1 QUIT
PURGE ;purge rpo record for the given date range
+1 SET DGTPUR=0
+2 FOR DGDATE=SP1-.000001:0
SET DGDATE=$ORDER(^DGP(45.87,"B",DGDATE))
IF 'DGDATE!(DGDATE>SP2)
QUIT
FOR DGDA=0:0
SET DGDA=$ORDER(^DGP(45.87,"B",DGDATE,DGDA))
IF 'DGDA
QUIT
IF $DATA(^DGP(45.87,DGDA,0))
IF $EXTRACT($PIECE(^DGP(45.87,DGDA,0),U,4),2,4)=DGFMT!(DGFMT="ALL")
DO GOGO
PURGEQ ;
+1 DO COM
+2 KILL DGTPUR,DGFMT,DGI,DGDATE,DGDA
+3 QUIT
+4 ;
GOGO ;-- count total items purged call delete routine
+1 SET DGTPUR=DGTPUR+1
+2 DO DEL^DGPTRPO
+3 QUIT
COM ;--send mailman message when purge is done
+1 SET DGPURMSG(1,0)="PTF PURGE SPECIAL TRANSACTION LOG COMPLETE."
SET DGPURMSG(2,0)="Record format :"_DGFMT
SET DGPURMSG(3,0)="Total # of records deleted = "_DGTPUR
+2 SET XMTEXT="DGPURMSG("
SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMSUB="PURGE PTF SPECIAL TRANSACTION LOG"
DO ^XMD
+3 KILL XMTEXT,XMY,XMZ,DGPURMSG,XMSUB,XMDUZ
+4 QUIT
+5 ;
INIT ;
+1 DO LO^DGUTL
DO HOME^%ZIS
SET DGOUT=0
+2 QUIT
