PSGWOND.m

PSGWOND ;BHAM ISC/MPH,CML-Delete an On-Demand Request ; 19 Mar 97 / 2:35 PM

 ;;2.3; Automatic Replenishment/Ward Stock ;**11**;4 JAN 94

 I '$D(PSGWSITE) D ^PSGWSET Q:'$D(PSGWSITE)  S PSGWFLG=1

DATE S PSGWV="AMIS COMPILE FLAG" R !!,"SELECT DATE/TIME FOR ON-DEMAND REQUEST: ",PSGWODT:DTIME S:'$T PSGWODT="^" G:"^"[PSGWODT END

 I "?"[$E(PSGWODT) S X="?",DIC(0)="M",D="OND",DIC="^PSI(58.1," D IX^DIC G DATE

DT S %DT="ET",X=PSGWODT D ^%DT G:Y<0 DATE S (PSGWODT,PSGWADT)=Y,PSGWCAT="W" I '$D(^PSI(58.1,"OND",PSGWODT)) W !,"On-Demand Request Date/Time not found, please try again...",! K PSGWODT G DATE

RD R !,"Do you wish to delete ALL items on this on-demand request? N// ",X:DTIME S:X="" X="N" S:'$T X="^" G:X="^" END

 I "YyNn"'[$E(X) D HELP G RD

 G NOLOOP:"Nn"[$E(X,1,1),LOOP:"Yy"[$E(X,1,1)

END K X,Y,DA,DIE,DIC,DR,PSGWAOU,PSGWIT,PSGWDA,PSGWODT,PSGWITN,PSGWADT,PSGWCAT,PSGWDN,PSGWQD,KEY,PSGWV,%DT,D,%,%W,%Y,%Y1,D0,D1,D2,DI,DLAYGO K:$D(PSGWFLG) PSGWSITE,PSGWFLG Q

HELP W !!,"Answer ""Y"" or ""N"".  If yes, the program will loop thru",!,"all items which were requested on the date/time selected",!,"and delete the request.  If no, the user will be asked",!,"for the AOU and the item will be removed.",! Q

 ;

LOOP F PSGWAOU=0:0 S PSGWAOU=$O(^PSI(58.1,"OND",PSGWODT,PSGWAOU)) Q:PSGWAOU'>0  F PSGWIT=0:0 S PSGWIT=$O(^PSI(58.1,"OND",PSGWODT,PSGWAOU,PSGWIT)) Q:PSGWIT'>0  D LOOP2

 G END

LOOP2 F PSGWDA=0:0 S PSGWDA=$O(^PSI(58.1,"OND",PSGWODT,PSGWAOU,PSGWIT,PSGWDA)) Q:PSGWDA'>0  D DEL

 Q

DEL S (PSGWITN,PSGWDN)=$P(^PSI(58.1,PSGWAOU,1,PSGWIT,0),"^"),PSGWQD=$P(^PSI(58.1,PSGWAOU,1,PSGWIT,5,PSGWDA,0),"^",2)*-1

 I ($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)=""

 W !," ",$P(^PSI(58.1,PSGWAOU,0),"^"),"   ",$P(^PSDRUG(PSGWITN,0),"^")," On-demand request deleted" S PSGWITN=$P(^PSDRUG(PSGWITN,0),"^")

 S DA=PSGWDA,DA(1)=PSGWIT,DA(2)=PSGWAOU,DIE="^PSI(58.1,"_DA(2)_",1,"_DA(1)_",5,",DR=".01///@" D ^DIE

 Q

NOLOOP S DIC="^PSI(58.1,",DIC(0)="QEA",DIC("S")="I $D(^PSI(58.1,""OND"",PSGWODT,+Y))" D ^DIC G:Y<0 END S PSGWAOU=+Y K DIC

ITEM S DIC="^PSI(58.1,PSGWAOU,1,",DIC(0)="QEAO",DIC("S")="I $D(^PSI(58.1,""OND"",PSGWODT,PSGWAOU,+Y))" D ^DIC K DIC G:Y<0 NOLOOP S PSGWIT=+Y,PSGWDA=0,PSGWDA=$O(^PSI(58.1,"OND",PSGWODT,PSGWAOU,PSGWIT,PSGWDA))

 D DEL G ITEM

PSGWOND   ;BHAM ISC/MPH,CML-Delete an On-Demand Request ; 19 Mar 97 / 2:35 PM

 +1       ;;2.3; Automatic Replenishment/Ward Stock ;**11**;4 JAN 94

 +2        IF '$DATA(PSGWSITE)

               DO ^PSGWSET

               IF '$DATA(PSGWSITE)

                   QUIT 

               SET PSGWFLG=1

DATE       SET PSGWV="AMIS COMPILE FLAG"

           READ !!,"SELECT DATE/TIME FOR ON-DEMAND REQUEST: ",PSGWODT:DTIME

           IF '$TEST

               SET PSGWODT="^"

           IF "^"[PSGWODT

               GOTO END

 +1        IF "?"[$EXTRACT(PSGWODT)

               SET X="?"

               SET DIC(0)="M"

               SET D="OND"

               SET DIC="^PSI(58.1,"

               DO IX^DIC

               GOTO DATE

DT         SET %DT="ET"

           SET X=PSGWODT

           DO ^%DT

           IF Y<0

               GOTO DATE

           SET (PSGWODT,PSGWADT)=Y

           SET PSGWCAT="W"

           IF '$DATA(^PSI(58.1,"OND",PSGWODT))

               WRITE !,"On-Demand Request Date/Time not found, please try again...",!

               KILL PSGWODT

               GOTO DATE

RD         READ !,"Do you wish to delete ALL items on this on-demand request? N// ",X:DTIME

           IF X=""

               SET X="N"

           IF '$TEST

               SET X="^"

           IF X="^"

               GOTO END

 +1        IF "YyNn"'[$EXTRACT(X)

               DO HELP

               GOTO RD

 +2        IF "Nn"[$EXTRACT(X,1,1)

               GOTO NOLOOP

           IF "Yy"[$EXTRACT(X,1,1)

               GOTO LOOP

END        KILL X,Y,DA,DIE,DIC,DR,PSGWAOU,PSGWIT,PSGWDA,PSGWODT,PSGWITN,PSGWADT,PSGWCAT,PSGWDN,PSGWQD,KEY,PSGWV,%DT,D,%,%W,%Y,%Y1,D0,D1,D2,DI,DLAYGO

           IF $DATA(PSGWFLG)

               KILL PSGWSITE,PSGWFLG

           QUIT 

HELP       WRITE !!,"Answer ""Y"" or ""N"".  If yes, the program will loop thru",!,"all items which were requested on the date/time selected",!,"and delete the request.  If no, the user will be asked",!,"for the AOU and the item will be removed.",!

           QUIT 

 +1       ;

LOOP       FOR PSGWAOU=0:0

               SET PSGWAOU=$ORDER(^PSI(58.1,"OND",PSGWODT,PSGWAOU))

               IF PSGWAOU'>0

                   QUIT 

               FOR PSGWIT=0:0

                   SET PSGWIT=$ORDER(^PSI(58.1,"OND",PSGWODT,PSGWAOU,PSGWIT))

                   IF PSGWIT'>0

                       QUIT 

                   DO LOOP2

 +1        GOTO END

LOOP2      FOR PSGWDA=0:0

               SET PSGWDA=$ORDER(^PSI(58.1,"OND",PSGWODT,PSGWAOU,PSGWIT,PSGWDA))

               IF PSGWDA'>0

                   QUIT 

               DO DEL

 +1        QUIT 

DEL        SET (PSGWITN,PSGWDN)=$PIECE(^PSI(58.1,PSGWAOU,1,PSGWIT,0),"^")

           SET PSGWQD=$PIECE(^PSI(58.1,PSGWAOU,1,PSGWIT,5,PSGWDA,0),"^",2)*-1

 +1        IF ($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)=""

 +2        WRITE !," ",$PIECE(^PSI(58.1,PSGWAOU,0),"^"),"   ",$PIECE(^PSDRUG(PSGWITN,0),"^")," On-demand request deleted"

           SET PSGWITN=$PIECE(^PSDRUG(PSGWITN,0),"^")

 +3        SET DA=PSGWDA

           SET DA(1)=PSGWIT

           SET DA(2)=PSGWAOU

           SET DIE="^PSI(58.1,"_DA(2)_",1,"_DA(1)_",5,"

           SET DR=".01///@"

           DO ^DIE

 +4        QUIT 

NOLOOP     SET DIC="^PSI(58.1,"

           SET DIC(0)="QEA"

           SET DIC("S")="I $D(^PSI(58.1,""OND"",PSGWODT,+Y))"

           DO ^DIC

           IF Y<0

               GOTO END

           SET PSGWAOU=+Y

           KILL DIC

ITEM       SET DIC="^PSI(58.1,PSGWAOU,1,"

           SET DIC(0)="QEAO"

           SET DIC("S")="I $D(^PSI(58.1,""OND"",PSGWODT,PSGWAOU,+Y))"

           DO ^DIC

           KILL DIC

           IF Y<0

               GOTO NOLOOP

           SET PSGWIT=+Y

           SET PSGWDA=0

           SET PSGWDA=$ORDER(^PSI(58.1,"OND",PSGWODT,PSGWAOU,PSGWIT,PSGWDA))

 +1        DO DEL

           GOTO ITEM