| 1 | PSOHLSG4 ;BIR/LC-Purge entries from file 52.51 ;03/20/96
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**26**;DEC 1997
|
|---|
| 3 | PURGE ;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
|
|---|
| 15 | DQ ;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="@"
|
|---|
| 24 | Q 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
|
|---|
