source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWOLD.m@ 1154

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1PSGWOLD ;BHAM ISC/PTD,CML-Purge Old Inventory Data (Auto Replenish, On-Demands, Returns & Backorder Data) ; 21 Jul 93 / 3:16 PM
2 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
3 W !!,"This option will purge data from files PSI(58.1), PSI(58.3), and PSI(58.19).",!,"You should retain the data for at least 1 quarter.",!,"Therefore, the option will NOT ALLOW DELETION of data newer than ""T-100"".",!!
4 W ?34,"**WARNING**",!?22,"Since this option is CPU intensive,",!?17,"it should be QUEUED to run in the ""off"" hours!",!!
5BDT S BDT=0 I '$O(^PSI(58.19,"B",BDT)) W !,"There is NO data in the Pharmacy AOU Inventory file.",!! K BDT Q
6 E S BDT=$P($O(^PSI(58.19,"B",BDT)),".")
7EDT S %DT="AEXP",%DT("A")="Purge INVENTORY data older than (and including): ",%DT("B")="T-100" D ^%DT K %DT G:Y<0 END S (EDT,X2)=Y
8 D NOW^%DTC S X1=$P(%,".") D ^%DTC I X<100 W !!,"Data less than 100 days old may NOT BE DELETED!",!! G EDT
9 I BDT>EDT W !!,"No INVENTORY data to purge in selected date range.",!! G END
10ASK S Y=EDT X ^DD("DD") W !!,"I will now delete INVENTORY data that is older than (and including) ",Y,!,"Are you SURE that is what you want to do? NO// " R X:DTIME
11 G:'$T!("^Nn"[$E(X)) END
12 I "YyNn"'[$E(X) W !!,"Answer ""yes"" if you wish to purge INVENTORY data.",!,"Answer ""no"" or <return> if you do not.",!! G ASK
13 S ZTIO="",ZTRTN="ENQ^PSGWOLD",ZTDESC="Purge Inventory Data" F G="BDT","EDT" S:$D(@G) ZTSAVE(G)=""
14 D ^%ZTLOAD,HOME^%ZIS I $D(ZTSK) W !,"INVENTORY purge queued!" K ZTSK
15 G END
16 ;
17ENQ ;ENTRY POINT WHEN QUEUED
18 S LPDT=BDT-1,DATDA=0
19DTLP S LPDT=$O(^PSI(58.19,"B",LPDT)) G:($P(LPDT,".")>EDT)!'LPDT BO
20DTDA S DATDA=$O(^PSI(58.19,"B",LPDT,DATDA)),AOUDA=0 G:'DATDA DTLP S DELFL="" D INVK G AOULP
21AOULP S AOUDA=$O(^PSI(58.1,AOUDA)),DRGDA=0 G:'AOUDA DTDA
22DRGLP S DRGDA=$O(^PSI(58.1,AOUDA,1,DRGDA)) G:'DRGDA AOULP
23 ;
24AR ;DELETE DATA IN THE INVENTORY SUBFILE 58.12
25 I $D(^PSI(58.1,AOUDA,1,DRGDA,1,DATDA,0)) S DIE="^PSI(58.1,"_AOUDA_",1,"_DRGDA_",1,",DA=DATDA,DA(1)=DRGDA,DA(2)=AOUDA,DR=".01///@" D ^DIE K DIE
26 G RETURNS
27 ;
28RETURNS ;DELETE DATA IN THE RETURNS SUBFILE 58.15
29 S RETDT=0
30RETLP S RETDT=$O(^PSI(58.1,AOUDA,1,DRGDA,3,RETDT)) G:'RETDT OD
31 I RETDT'>EDT S DIE="^PSI(58.1,"_AOUDA_",1,"_DRGDA_",3,",DA=RETDT,DA(1)=DRGDA,DA(2)=AOUDA,DR=".01///@" D ^DIE K DIE G RETLP
32 G RETLP
33 ;
34OD ;DELETE DATA IN THE ON-DEMAND REQUEST SUBFILE 58.28
35 S ODA=0
36ODLP S ODA=$O(^PSI(58.1,AOUDA,1,DRGDA,5,ODA)) G:'ODA DRGLP S ODT=$P($P(^PSI(58.1,AOUDA,1,DRGDA,5,ODA,0),"^"),".")
37 I ODT'>EDT S DIE="^PSI(58.1,"_AOUDA_",1,"_DRGDA_",5,",DA=ODA,DA(1)=DRGDA,DA(2)=AOUDA,DR=".01///@" D ^DIE K DIE G ODLP
38 G ODLP
39 ;
40BO ;DELETE DATA IN FILE 58.3 - BACKORDER FILE
41 S (DRG,BODTDA)=0
42BXREF F JJ=0:0 S DRG=$O(^PSI(58.3,DRG)) Q:'DRG I '$O(^PSI(58.3,DRG,1,0)) S DIE="^PSI(58.3,",DA=DRG,DR=".01///@" D ^DIE K DIE
43BODTLP S DELFL="",BODTDA=$O(^PSI(58.3,"D",BODTDA)),BODRG=0 G:'BODTDA DONE
44BODRGLP S BODRG=$O(^PSI(58.3,"D",BODTDA,BODRG)),BOAOU=0 D:'BODRG INVK G:'BODRG BODTLP
45BOAOULP S BOAOU=$O(^PSI(58.3,"D",BODTDA,BODRG,BOAOU)),BOINV=0 G:'BOAOU BODRGLP
46BOINVLP S BOINV=$O(^PSI(58.3,"D",BODTDA,BODRG,BOAOU,BOINV)) G:'BOINV BOAOULP
47 I (($P(^PSI(58.3,BODRG,1,BOAOU,1,BOINV,0),"^",5)'="")&($P(^(0),"^",5)'>EDT)) S DIE="^PSI(58.3,"_BODRG_",1,"_BOAOU_",1,",DA=BOINV,DA(1)=BOAOU,DA(2)=BODRG,DR=".01///@" D ^DIE K DIE D BODEL G BOINVLP
48 S DELFL="NO" G BOINVLP
49 ;
50INVK ;DELETE DATA IN FILE 58.19 - PHARMACY AOU INVENTORY FILE
51 I DELFL="" S DIK="^PSI(58.19,",DA=$S(DATDA="":BODTDA,1:DATDA) D ^DIK K DIK
52 Q
53 ;
54BODEL ;IF ALL BACKORDER DATES DELETED FOR BO AOU, THEN DELETE AOU FROM SUBFILE. IF ALL AOUS DELETED FOR DRUG, THEN DELETE DRUG FROM FILE.
55 I '$O(^PSI(58.3,BODRG,1,BOAOU,1,0)) S DIE="^PSI(58.3,"_BODRG_",1,",DA=BOAOU,DA(1)=BODRG,DR=".01///@" D ^DIE K DIE
56 I '$O(^PSI(58.3,BODRG,1,0)) S DIE="^PSI(58.3,",DA=BODRG,DR=".01///@" D ^DIE K DIE
57 Q
58 ;
59DONE D ^PSGWOLD1
60END K ZTSK,BDT,EDT,X,Y,LPDT,DATDA,AOUDA,INVDA,DRGDA,ODA,ODT,RETDT,BODTDA,BODRG,BOAOU,BOINV,DELFL,DRG,JJ,%,%I,%H,DA,DR,G,ZTIO
61 S:$D(ZTQUEUED) ZTREQ="@" Q
Note: See TracBrowser for help on using the repository browser.