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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWOND 2346 printed Dec 13, 2024@01:39:43 Page 2
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
