25 lines
1.3 KiB
Mathematica
25 lines
1.3 KiB
Mathematica
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.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
|
|
D NOW^%DTC S PSGWDT=X
|
|
S AOUDA=0
|
|
AOULP S AOUDA=$O(^PSI(58.1,AOUDA)),DRGDA=0 G:'AOUDA END
|
|
DRGLP S DRGDA=$O(^PSI(58.1,AOUDA,1,DRGDA)) G:'DRGDA AOUDEL
|
|
DRGDEL ;DELETE INACTIVATED DRUG FROM AOU IF INACTIVE DATE LESS THAN OR EQUAL EDT, AND THERE IS NO INVENTORY DATA IN FILE FOR DRUG.
|
|
;G:$P(^PSI(58.1,AOUDA,1,DRGDA,0),"^",10)'="Y" DRGLP
|
|
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
|
|
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
|
|
I $D(^PSI(58.3,"B",DRGNUM)) G DRGLP
|
|
S DIK="^PSI(58.1,AOUDA,1,",DA=DRGDA,DA(1)=AOUDA D ^DIK K DIK G DRGLP
|
|
;
|
|
AOUDEL G:$O(^PSI(58.1,AOUDA,1,0)) AOULP
|
|
S GRPDA=0,DELFL=1
|
|
GRLP S GRPDA=$O(^PSI(58.2,GRPDA)),PTR=0 G:'GRPDA DEL
|
|
PTRLP S PTR=$O(^PSI(58.2,GRPDA,1,"B",PTR)) G:'PTR GRLP I PTR=AOUDA S DELFL=0
|
|
G PTRLP
|
|
;
|
|
DEL G:DELFL=0 AOULP
|
|
S DIK="^PSI(58.1,",DA=AOUDA D ^DIK K DIK G AOULP
|
|
;
|
|
END K AOUDA,DRGDA,LOC,DRGNUM,GRPDA,DELFL,PTR,DA,PSGWDT,%,%H,%I,X
|
|
Q
|