PSGWRI ;BHAM ISC/PTD,CML-Return Items for AOU ; 29 Dec 93 / 9:16 AM
;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
I '$D(PSGWSITE) D ^PSGWSET Q:'$D(PSGWSITE) S PSGWFLG=1
AOU S PSGWV="AMIS COMPILE FLAG",PSGWCAT="R",(PSGWADT,PSGWQD)="",DIC="^PSI(58.1,",DIC(0)="QEAM" D ^DIC K DIC G:Y<0 END S PSGWAOU=+Y
I '$D(^PSI(58.1,PSGWAOU,1,0)) S ^(0)="^58.11IP^^"
ITEM S DIC="^PSI(58.1,PSGWAOU,1,",DIC(0)="QEAOM" D ^DIC K DIC K:Y<0 PSGWAOU G:Y<0 AOU S PSGWDN=$P(Y,"^",2),PSGWDDA=+Y
I '$D(^PSI(58.1,PSGWAOU,1,PSGWDDA,3,0)) S ^(0)="^58.15^^"
DATE S DIC="^PSI(58.1,PSGWAOU,1,PSGWDDA,3,",DIC(0)="QEAML" D ^DIC K DIC G:Y<0 END S (DA,PSGWADT)=+Y S PSGWOLD=$P(^PSI(58.1,PSGWAOU,1,PSGWDDA,3,PSGWADT,0),"^",2)
DIE S DA(2)=PSGWAOU,DA(1)=PSGWDDA,DIE="^PSI(58.1,PSGWAOU,1,PSGWDDA,3,",DR="1;S PSGWQD=X-PSGWOLD;2" D ^DIE K DIE G:$D(Y) DONE
I $D(PSGWADT)&($P(^PSI(58.1,PSGWAOU,0),"^",3)'=1)&($P(PSGWSITE,"^",25)=1)&(PSGWQD'=0) S ^PSI(58.5,"AMIS",$H,PSGWADT,PSGWCAT,PSGWAOU,PSGWDN,PSGWQD)=""
DONE K PSGWDN,PSGWADT,PSGWQD,PSGWOLD,PSGWDDA G ITEM
;
END K PSGWADT,PSGWAOU,PSGWDN,PSGWQD,PSGWCAT,PSGWDDA,PSGWOLD,KEY,PSGWV,DA,DR,%,%DT,%W,C,D0,DI,DQ,Y
K:$D(PSGWFLG) PSGWFLG,PSGWSITE Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWRI 1176 printed Nov 22, 2024@16:50:16 Page 2
PSGWRI ;BHAM ISC/PTD,CML-Return Items for AOU ; 29 Dec 93 / 9:16 AM
+1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
+2 IF '$DATA(PSGWSITE)
DO ^PSGWSET
if '$DATA(PSGWSITE)
QUIT
SET PSGWFLG=1
AOU SET PSGWV="AMIS COMPILE FLAG"
SET PSGWCAT="R"
SET (PSGWADT,PSGWQD)=""
SET DIC="^PSI(58.1,"
SET DIC(0)="QEAM"
DO ^DIC
KILL DIC
if Y<0
GOTO END
SET PSGWAOU=+Y
+1 IF '$DATA(^PSI(58.1,PSGWAOU,1,0))
SET ^(0)="^58.11IP^^"
ITEM SET DIC="^PSI(58.1,PSGWAOU,1,"
SET DIC(0)="QEAOM"
DO ^DIC
KILL DIC
if Y<0
KILL PSGWAOU
if Y<0
GOTO AOU
SET PSGWDN=$PIECE(Y,"^",2)
SET PSGWDDA=+Y
+1 IF '$DATA(^PSI(58.1,PSGWAOU,1,PSGWDDA,3,0))
SET ^(0)="^58.15^^"
DATE SET DIC="^PSI(58.1,PSGWAOU,1,PSGWDDA,3,"
SET DIC(0)="QEAML"
DO ^DIC
KILL DIC
if Y<0
GOTO END
SET (DA,PSGWADT)=+Y
SET PSGWOLD=$PIECE(^PSI(58.1,PSGWAOU,1,PSGWDDA,3,PSGWADT,0),"^",2)
DIE SET DA(2)=PSGWAOU
SET DA(1)=PSGWDDA
SET DIE="^PSI(58.1,PSGWAOU,1,PSGWDDA,3,"
SET DR="1;S PSGWQD=X-PSGWOLD;2"
DO ^DIE
KILL DIE
if $DATA(Y)
GOTO DONE
+1 IF $DATA(PSGWADT)&($PIECE(^PSI(58.1,PSGWAOU,0),"^",3)'=1)&($PIECE(PSGWSITE,"^",25)=1)&(PSGWQD'=0)
SET ^PSI(58.5,"AMIS",$HOROLOG,PSGWADT,PSGWCAT,PSGWAOU,PSGWDN,PSGWQD)=""
DONE KILL PSGWDN,PSGWADT,PSGWQD,PSGWOLD,PSGWDDA
GOTO ITEM
+1 ;
END KILL PSGWADT,PSGWAOU,PSGWDN,PSGWQD,PSGWCAT,PSGWDDA,PSGWOLD,KEY,PSGWV,DA,DR,%,%DT,%W,C,D0,DI,DQ,Y
+1 if $DATA(PSGWFLG)
KILL PSGWFLG,PSGWSITE
QUIT
