- 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 Mar 13, 2025@20:44:44 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
