- 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 Apr 23, 2025@17:54:10 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
