source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWOLD1.m@ 1801

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

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1PSGWOLD1 ;BHAM ISC/PTD,CML-Purge Old Inventory Data - CONTINUED (Delete Drugs Inactivated in AOU & Delete AOUs with No Drugs or Pointers to 58.2) ; 21 Jul 93 / 3:21 PM
2 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
3 D NOW^%DTC S PSGWDT=X
4 S AOUDA=0
5AOULP S AOUDA=$O(^PSI(58.1,AOUDA)),DRGDA=0 G:'AOUDA END
6DRGLP S DRGDA=$O(^PSI(58.1,AOUDA,1,DRGDA)) G:'DRGDA AOUDEL
7DRGDEL ;DELETE INACTIVATED DRUG FROM AOU IF INACTIVE DATE LESS THAN OR EQUAL EDT, AND THERE IS NO INVENTORY DATA IN FILE FOR DRUG.
8 ;G:$P(^PSI(58.1,AOUDA,1,DRGDA,0),"^",10)'="Y" DRGLP
9 S LOC=^PSI(58.1,AOUDA,1,DRGDA,0),DRGNUM=$P(LOC,"^") I $P(LOC,"^",3)="" S $P(^PSI(58.1,AOUDA,1,DRGDA,0),"^",10)="" G DRGLP
10 G:$P(LOC,"^",3)>PSGWDT DRGLP G:$O(^PSI(58.1,AOUDA,1,DRGDA,1,0)) DRGLP G:$O(^PSI(58.1,AOUDA,1,DRGDA,3,0)) DRGLP G:$O(^PSI(58.1,AOUDA,1,DRGDA,5,0)) DRGLP
11 I $D(^PSI(58.3,"B",DRGNUM)) G DRGLP
12 S DIK="^PSI(58.1,AOUDA,1,",DA=DRGDA,DA(1)=AOUDA D ^DIK K DIK G DRGLP
13 ;
14AOUDEL G:$O(^PSI(58.1,AOUDA,1,0)) AOULP
15 S GRPDA=0,DELFL=1
16GRLP S GRPDA=$O(^PSI(58.2,GRPDA)),PTR=0 G:'GRPDA DEL
17PTRLP S PTR=$O(^PSI(58.2,GRPDA,1,"B",PTR)) G:'PTR GRLP I PTR=AOUDA S DELFL=0
18 G PTRLP
19 ;
20DEL G:DELFL=0 AOULP
21 S DIK="^PSI(58.1,",DA=AOUDA D ^DIK K DIK G AOULP
22 ;
23END K AOUDA,DRGDA,LOC,DRGNUM,GRPDA,DELFL,PTR,DA,PSGWDT,%,%H,%I,X
24 Q
Note: See TracBrowser for help on using the repository browser.