[613] | 1 | DGPTRPP ;ALB/MTC - PRINT/PURGE SPECIAL TRANSACTION REQUEST LIST ; 19 FEB 91
|
---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
---|
| 3 | PRN ;--entry for list
|
---|
| 4 | D INIT G ENQ:DGOUT
|
---|
| 5 | W @IOF,?12,"SPECIAL TRANSACTION REQUEST LISTING",!
|
---|
| 6 | D GETDATE G ENQ:DGOUT
|
---|
| 7 | D GETFMT G ENQ:DGOUT
|
---|
| 8 | S L=0,DIC="^DGP(45.87,",FLDS="[DGPT PRINT]",FR=SP1,TO=SP2,BY="@-.01"
|
---|
| 9 | S DIS(0)="I $E($P(^DGP(45.87,D0,0),U,4),2,4)=DGFMT!(DGFMT=""ALL"")"
|
---|
| 10 | D EN1^DIP
|
---|
| 11 | ENQ K X,Y,DGD1,DGD2,SP1,SP2,DGOUT,L,DIC,BY,FR,TO,FLDS,DIS,DGFMT,ZTDESC,ZTIO,ZTDTH,ZTRTN,ZTSAVE Q
|
---|
| 12 | ;
|
---|
| 13 | GETDATE ;THIS ROUTINE WILL GET THE DATE RANGE FROM THE USER
|
---|
| 14 | S DGOUT=0,Y=$O(^DGP(45.87,"B",0))
|
---|
| 15 | I 'Y W !,"No records in PTF TRANSACTION LOG FILE" S DGOUT=1 G GETQ
|
---|
| 16 | D DD^%DT S %DT("B")=Y
|
---|
| 17 | S %DT("A")="Start with DATE OF REQUEST : ",%DT="AETS"
|
---|
| 18 | D ^%DT I (Y=-1)!$D(DTOUT) S DGOUT=1 G GETQ
|
---|
| 19 | S (SP1,%DT(0))=Y,%DT("B")="NOW",%DT("A")="Go to DATE OF REQUEST : "
|
---|
| 20 | D ^%DT I (Y=-1)!$D(DTOUT) S DGOUT=1 G GETQ
|
---|
| 21 | S SP2=Y
|
---|
| 22 | GETQ K %,%DT,X,Y,DIR,DIRUT,DTOUT Q
|
---|
| 23 | ;
|
---|
| 24 | GETFMT ;-- will get from the user which records to process
|
---|
| 25 | S DGOUT=0
|
---|
| 26 | 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"
|
---|
| 27 | D ^DIR I $D(DIRUT) S DGOUT=1 G GETFMTQ
|
---|
| 28 | S DGFMT=X
|
---|
| 29 | GETFMTQ ;
|
---|
| 30 | K DIR,X,Y,DIRUT
|
---|
| 31 | Q
|
---|
| 32 | ;
|
---|
| 33 | PUR ;--entry for purge RPO
|
---|
| 34 | D INIT G ENQ:DGOUT
|
---|
| 35 | W @IOF,?12,"PURGE SPECIAL TRANSACTION REQUEST.",!
|
---|
| 36 | D GETDATE G ENQ:DGOUT
|
---|
| 37 | D GETFMT G ENQ:DGOUT
|
---|
| 38 | D CONT I DGOUT G ENQ
|
---|
| 39 | D NOW^%DTC S ZTIO="",ZTDESC="Purge Special Transactions",ZTDTH=%,ZTRTN="PURGE^DGPTRPP",ZTSAVE("SP1")="",ZTSAVE("SP2")="",ZTSAVE("DGFMT")="" D ^%ZTLOAD
|
---|
| 40 | W !!,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!")
|
---|
| 41 | D HOME^%ZIS K ZTSAVE,ZTSK
|
---|
| 42 | D ENQ
|
---|
| 43 | Q
|
---|
| 44 | ;
|
---|
| 45 | CONT ;--verify before delete
|
---|
| 46 | S DGOUT=0
|
---|
| 47 | S Y=SP1 D DD^%DT S DGD1=Y,Y=SP2 D DD^%DT S DGD2=Y
|
---|
| 48 | S DIR(0)="Y",DIR("A")="Purge "_DGFMT_" Requests from "_DGD1_" to "_DGD2,DIR("B")="NO"
|
---|
| 49 | D ^DIR
|
---|
| 50 | I (Y=0)!$D(DIRUT) S DGOUT=1
|
---|
| 51 | CONTQ K X,Y,DIR,DIRUT
|
---|
| 52 | Q
|
---|
| 53 | PURGE ;purge rpo record for the given date range
|
---|
| 54 | S DGTPUR=0
|
---|
| 55 | 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
|
---|
| 56 | PURGEQ ;
|
---|
| 57 | D COM
|
---|
| 58 | K DGTPUR,DGFMT,DGI,DGDATE,DGDA
|
---|
| 59 | Q
|
---|
| 60 | ;
|
---|
| 61 | GOGO ;-- count total items purged call delete routine
|
---|
| 62 | S DGTPUR=DGTPUR+1
|
---|
| 63 | D DEL^DGPTRPO
|
---|
| 64 | Q
|
---|
| 65 | COM ;--send mailman message when purge is done
|
---|
| 66 | S DGPURMSG(1,0)="PTF PURGE SPECIAL TRANSACTION LOG COMPLETE.",DGPURMSG(2,0)="Record format :"_DGFMT,DGPURMSG(3,0)="Total # of records deleted = "_DGTPUR
|
---|
| 67 | S XMTEXT="DGPURMSG(",XMDUZ=.5,XMY(DUZ)="",XMSUB="PURGE PTF SPECIAL TRANSACTION LOG" D ^XMD
|
---|
| 68 | K XMTEXT,XMY,XMZ,DGPURMSG,XMSUB,XMDUZ
|
---|
| 69 | Q
|
---|
| 70 | ;
|
---|
| 71 | INIT ;
|
---|
| 72 | D LO^DGUTL,HOME^%ZIS S DGOUT=0
|
---|
| 73 | Q
|
---|