Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPTRPP

DGPTRPP.m

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