- DGPTRPP ;ALB/MTC - PRINT/PURGE SPECIAL TRANSACTION REQUEST LIST ; 19 FEB 91
- ;;5.3;Registration;;Aug 13, 1993
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTRPP 2851 printed Feb 19, 2025@00:19:36 Page 2
- DGPTRPP ;ALB/MTC - PRINT/PURGE SPECIAL TRANSACTION REQUEST LIST ; 19 FEB 91
- +1 ;;5.3;Registration;;Aug 13, 1993
- 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