PSGWRI.m

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 ---PSGWRI   1176     printed  Apr 09, 2024@20:44:33                                                                                                                                                                                                      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