source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRACP.m@ 1259

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

initial load of WorldVistAEHR

File size: 971 bytes
Line 
1LRACP ;SLC/DCM - CUMULATIVE PURGE ;2/19/91 10:17 ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3QUEUE S U="^"
4 W !,"This option uses the number of days entered in the GRACE PERIOD FOR CUMULATIVE",!,"field in the LABORATORY SITE file to identify and purge patient lab data from",!,"the cumulative file.",!
5 W !?10,"The file is set for ( ",+$P(^LAB(69.9,1,0),U,12)," ) days ",!
6 W !,"Are you sure you want to continue" S %=2 D YN^DICN I %=2!(%=-1) Q
7 S ZTRTN="ENT^LRACP",ZTDESC="Cumulative Purge",ZTIO="" D ^%ZTLOAD Q
8MORE I '$D(^LR(LRDFN,0)) K ^LAC("LRAC",LRDFN) Q
9 S X=^LR(LRDFN,0),LRDPF=$P(X,U,2),DFN=$P(X,U,3) Q:$O(^LR(LRDFN,"CH",0))<LRDAYS
10 I LRDPF=2 D PT^LRX Q:$L(LRWRD)
11 K ^LAC("LRAC",LRDFN),^LAC("LRAC","B",LRDFN)
12 Q
13IDT S LRDFN=0 F S LRDFN=$O(^LAC("LRAC",LRDFN)) Q:LRDFN<1 D MORE
14 Q
15ENT ;
16 S U="^" S:$D(ZTQUEUED) ZTREQ="@"
17 G:'$P(^LAB(69.9,1,0),U,12) CLEAN S X1=DT,X2=-$P(^(0),"^",12) D C^%DTC S LRDAYS=9999999-X_.5,LRXLR="LRAC"
18 D IDT
19CLEAN ;
20 K LRDAYS,LRDFN,LRDPF,DFN
21 Q
Note: See TracBrowser for help on using the repository browser.