source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOHLSG4.m@ 1005

Last change on this file since 1005 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1PSOHLSG4 ;BIR/LC-Purge entries from file 52.51 ;03/20/96
2 ;;7.0;OUTPATIENT PHARMACY;**26**;DEC 1997
3PURGE ;Purge data from the External Interface file
4 I $D(ZTQUEUED) G DQ
5 S X1=DT,X2=-7 D C^%DTC S Y=X X ^DD("DD") S DIR("B")=Y
6 S DIR(0)="D^:"_X_":EX",DIR("A")="Enter cutoff date for purge",DIR("?")="The cutoff date must be at least seven days before today"
7 D ^DIR G Q:$D(DIRUT) S PDT=Y_.999999
8 S DIR(0)="YA",DIR("B")="NO",DIR("A")="Purge entries that were not successfully processed? ",DIR("?",1)="Enter 'Yes' to purge entries whose status is 'process failed'."
9 S DIR("?",2)="If you have reviewed/resolved the cause of the problem of those entries",DIR("?")="with an 'error' status answer 'Yes'. Otherwise answer 'No'."
10 W ! D ^DIR G Q:$D(DIRUT) K DIR S PERR=Y
11 S ZTRTN="DQ^PSOHLSG4",ZTSAVE("PERR")="",ZTSAVE("PDT")="",ZTIO="",ZTSAVE("DA1")="",ZTSAVE("DA")=""
12 S ZTDESC="Purge External Interface file entries on or before "_$E(PDT,4,5)_"/"_$E(PDT,6,7)_"/"_$E(PDT,2,3) D ^%ZTLOAD
13 ;W !!,"Purge queued to run in background." G Q
14 G Q
15DQ ;Taskman entry point for running purge of External Interface file
16 S:'$D(PERR) PERR=0 I '$D(PDT) S X1=DT,X2=-7 D C^%DTC S PDT=X_.999999
17 F PDATE=0:0 S PDATE=$O(^PS(52.51,"AC1",PDATE)) Q:'PDATE!(PDATE>PDT) D
18 .F PSOIN=0:0 S PSOIN=$O(^PS(52.51,"AC1",PDATE,PSOIN)) Q:'PSOIN D
19 ..S PSOTR=$P($G(^PS(52.51,PSOIN,0)),"^",10)
20 ..I 'PERR,PSOTR=3 Q
21 ..I PSOTR=1!(PSOTR=4) Q
22 ..S DIK="^PS(52.51,",DA=PSOIN D ^DIK
23 I $D(ZTQUEUED) S ZTREQ="@"
24Q K %H,DA,DIR,DIRUT,DIK,PDT,PERR,PTR,X,X1,X2,XMDUZ,XMK,XMZ,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,DELCNT
25 ;
26 Q
Note: See TracBrowser for help on using the repository browser.