| [613] | 1 | PSGWOLD1 ;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
|
|---|
| 5 | AOULP S AOUDA=$O(^PSI(58.1,AOUDA)),DRGDA=0 G:'AOUDA END
|
|---|
| 6 | DRGLP S DRGDA=$O(^PSI(58.1,AOUDA,1,DRGDA)) G:'DRGDA AOUDEL
|
|---|
| 7 | DRGDEL ;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 | ;
|
|---|
| 14 | AOUDEL G:$O(^PSI(58.1,AOUDA,1,0)) AOULP
|
|---|
| 15 | S GRPDA=0,DELFL=1
|
|---|
| 16 | GRLP S GRPDA=$O(^PSI(58.2,GRPDA)),PTR=0 G:'GRPDA DEL
|
|---|
| 17 | PTRLP S PTR=$O(^PSI(58.2,GRPDA,1,"B",PTR)) G:'PTR GRLP I PTR=AOUDA S DELFL=0
|
|---|
| 18 | G PTRLP
|
|---|
| 19 | ;
|
|---|
| 20 | DEL G:DELFL=0 AOULP
|
|---|
| 21 | S DIK="^PSI(58.1,",DA=AOUDA D ^DIK K DIK G AOULP
|
|---|
| 22 | ;
|
|---|
| 23 | END K AOUDA,DRGDA,LOC,DRGNUM,GRPDA,DELFL,PTR,DA,PSGWDT,%,%H,%I,X
|
|---|
| 24 | Q
|
|---|
