PSGWODRN ;BHAM ISC/MPH,PTD,CML-Enter an On-Demand Request - for Nursing Staff ; 17 Mar 97 / 2:48 PM
;;2.3; Automatic Replenishment/Ward Stock ;**11**;4 JAN 94
I '$D(PSGWSITE) D ^PSGWSET Q:'$D(PSGWSITE) S PSGWFLG=1
S BCFLG=0 G DATE ; I '$P(PSGWSITE,"^",27) S BCFLG=0 G DATE
W !!,"This option can be used with a Bar Code Reader and a printed listing from",!,"the option 'LIST BAR CODED STOCK ITEMS'.",!!,"If you choose to use a bar code reader, you MUST use it to enter both",!,"the AOU and the ITEM."
ASK W !!,"Do you wish to use a Bar Code Reader" S %=2 D YN^DICN G:%<0!(%="") BOT I %<1 W !,"PLEASE ANSWER 'YES' OR 'NO'." G ASK
S BCFLG=$S(%<2:1,1:0)
DATE S PSGWV="AMIS COMPILE FLAG" R !!,"SELECT DATE/TIME FOR ON-DEMAND REQUEST: NOW // ",ODT:DTIME S:'$T ODT="^" G:ODT="^" BOT S:ODT="" ODT="NOW"
I "?"[$E(ODT) S X="?",DIC(0)="M",DIC="^PSI(58.1,",D="OND" D IX^DIC K DIC G DATE
DT S %DT="ET",%DT(0)="-NOW",X=ODT D ^%DT K %DT(0) G:Y<0 DATE S (ODT,PSGWADT)=Y,PSGWCAT="W",AMISFL=0,PRTFLG=0
AOU R !,"Select MEDICATION AREA OF USE: ",X:DTIME S:'$T X="^" G BOT:"^"[X I BCFLG,X'?1"A".N W *7," ??",!,"Wand the bar code. It should be in the format of an 'A' followed by a series",!,"of number(s). Ex. - 'A123'" G AOU
S:BCFLG X=$P(X,"A",2) S DIC="^PSI(58.1,",DIC(0)="QEMN",DIC("S")="I $S('$D(^(""I"")):1,'^(""I""):1,^(""I"")>DT:1,1:0)" D ^DIC K DIC
G:X?1."?" AOU G:Y<0 BOT S (AOU,PSGWAOU)=+Y S:($P(^PSI(58.1,AOU,0),"^",3)'=1)&($P(PSGWSITE,"^",25)=1) AMISFL=1
I '$D(^PSI(58.1,AOU,1,0)) S ^(0)="^58.11IP^^"
ITEM R !,"Select ITEM: ",X:DTIME S:'$T X="^" G BOT:X="^",END:X="" I BCFLG,X'?1"I".N W *7," ??",!,"Wand the bar code. It should be in the format of an 'I' followed by a series",!,"of number(s). Ex. - 'I123'" G ITEM
S:BCFLG X=$P(X,"I",2) S DIC="^PSI(58.1,AOU,1,",DIC(0)="QEM",DA(1)=AOU,DIC("S")="S DRGDA=+^(0) I $S('$D(^(""I"")):1,$O(^(""I"",0))'>DT:0,1:1) D SCR2^PSGWOD2" D ^DIC K DIC G ITEM:X?1."?"!(Y<0) S (PSGDR,PSGWDN)=$P(Y,"^",2),ITEM=+Y
BACKOD S X=PSGDR,PSGBOT=0,DIC="^PSI(58.3,",DIC(0)="" D ^DIC K DIC G:Y<0 UPD S PSGBON=+Y
F J=0:0 S J=$S($D(^PSI(58.3,PSGBON,1,AOU,1,J)):$O(^(J)),1:0) Q:J'>0 S:$S($P(^(J,0),"^",5)="":1,1:0) PSGBOT=PSGBOT+$P(^(0),"^",2)
W:PSGBOT'=0 !!,"Item is on BACKORDER. You may not enter a quantity.",!,"Total Backordered for this item is ",PSGBOT,".",!!
UPD I PSGBOT'>0 S DR="16///"_ODT,DR(2,58.28)="2////"_DUZ_";S PSGWOLD=$P(^PSI(58.1,AOU,1,DA(1),5,DA,0),""^"",2);1T;S PSGWQD=X-PSGWOLD"
I S PSGDR=$P(^PSDRUG(PSGDR,0),"^"),DIE="^PSI(58.1,AOU,1,",DA(1)=AOU,DA=ITEM D ^DIE K DIE I $D(PSGWQD),(PSGWQD'=0) S PRTFLG=1 I AMISFL=1 S ^PSI(58.5,"AMIS",$H,PSGWADT,PSGWCAT,PSGWAOU,PSGWDN,PSGWQD)=""
DONE K PSGBON,PSGBOT,PSGDR,PSGWDN,PSGWQD,PSGWOLD,X,Y,J,DR G ITEM
END G:'PRTFLG BOT R !!,"Do you wish to print a copy of this on-demand request ? N//",ANS:DTIME S:'$T ANS="^" S:ANS="" ANS="^" G:ANS="^" BOT
I "YyNn"'[$E(ANS) W !!,"Answer ""Y"" or ""N"". If you answer yes, the program will print a ""pick list"" or",!,"hard copy of this on-demand request. The report lists the date, AOU, items,",!,"quantities, and person entering request." G END
I "Yy"[$E(ANS) S ALL=0,(BDT,EDT)=ODT G DEV^PSGWODP
BOT K %,BCFLG,PSGBON,PSGBOT,PSGDR,DR,AOU,ODT,ANS,PSGWADT,PSGWCAT,PSGWDN,PSGWOLD,PSGWQD,PSGWAOU,AMISFL,KEY,PSGWV,DA,D,DIE,%DT,%W,D0,D1,D2,DI,DLAYGO,DQ,ITEM,PRTFLG,DRGDA K:$D(PSGWFLG) PSGWSITE,PSGWFLG Q
PSGWODRN ;BHAM ISC/MPH,PTD,CML-Enter an On-Demand Request - for Nursing Staff ; 17 Mar 97 / 2:48 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
+3 ; I '$P(PSGWSITE,"^",27) S BCFLG=0 G DATE
SET BCFLG=0
GOTO DATE
+4 WRITE !!,"This option can be used with a Bar Code Reader and a printed listing from",!,"the option 'LIST BAR CODED STOCK ITEMS'.",!!,"If you choose to use a bar code reader, you MUST use it to enter both",!,"the AOU and the ITEM."
ASK WRITE !!,"Do you wish to use a Bar Code Reader"
SET %=2
DO YN^DICN
IF %<0!(%="")
GOTO BOT
IF %<1
WRITE !,"PLEASE ANSWER 'YES' OR 'NO'."
GOTO ASK
+1 SET BCFLG=$SELECT(%<2:1,1:0)
DATE SET PSGWV="AMIS COMPILE FLAG"
READ !!,"SELECT DATE/TIME FOR ON-DEMAND REQUEST: NOW // ",ODT:DTIME
IF '$TEST
SET ODT="^"
IF ODT="^"
GOTO BOT
IF ODT=""
SET ODT="NOW"
+1 IF "?"[$EXTRACT(ODT)
SET X="?"
SET DIC(0)="M"
SET DIC="^PSI(58.1,"
SET D="OND"
DO IX^DIC
KILL DIC
GOTO DATE
DT SET %DT="ET"
SET %DT(0)="-NOW"
SET X=ODT
DO ^%DT
KILL %DT(0)
IF Y<0
GOTO DATE
SET (ODT,PSGWADT)=Y
SET PSGWCAT="W"
SET AMISFL=0
SET PRTFLG=0
AOU READ !,"Select MEDICATION AREA OF USE: ",X:DTIME
IF '$TEST
SET X="^"
IF "^"[X
GOTO BOT
IF BCFLG
IF X'?1"A".N
WRITE *7," ??",!,"Wand the bar code. It should be in the format of an 'A' followed by a series",!,"of number(s). Ex. - 'A123'"
GOTO AOU
+1 IF BCFLG
SET X=$PIECE(X,"A",2)
SET DIC="^PSI(58.1,"
SET DIC(0)="QEMN"
SET DIC("S")="I $S('$D(^(""I"")):1,'^(""I""):1,^(""I"")>DT:1,1:0)"
DO ^DIC
KILL DIC
+2 IF X?1."?"
GOTO AOU
IF Y<0
GOTO BOT
SET (AOU,PSGWAOU)=+Y
IF ($PIECE(^PSI(58.1,AOU,0),"^",3)'=1)&($PIECE(PSGWSITE,"^",25)=1)
SET AMISFL=1
+3 IF '$DATA(^PSI(58.1,AOU,1,0))
SET ^(0)="^58.11IP^^"
ITEM READ !,"Select ITEM: ",X:DTIME
IF '$TEST
SET X="^"
IF X="^"
GOTO BOT
IF X=""
GOTO END
IF BCFLG
IF X'?1"I".N
WRITE *7," ??",!,"Wand the bar code. It should be in the format of an 'I' followed by a series",!,"of number(s). Ex. - 'I123'"
GOTO ITEM
+1 IF BCFLG
SET X=$PIECE(X,"I",2)
SET DIC="^PSI(58.1,AOU,1,"
SET DIC(0)="QEM"
SET DA(1)=AOU
SET DIC("S")="S DRGDA=+^(0) I $S('$D(^(""I"")):1,$O(^(""I"",0))'>DT:0,1:1) D SCR2^PSGWOD2"
DO ^DIC
KILL DIC
IF X?1."?"!(Y<0)
GOTO ITEM
SET (PSGDR,PSGWDN)=$PIECE(Y,"^",2)
SET ITEM=+Y
BACKOD SET X=PSGDR
SET PSGBOT=0
SET DIC="^PSI(58.3,"
SET DIC(0)=""
DO ^DIC
KILL DIC
IF Y<0
GOTO UPD
SET PSGBON=+Y
+1 FOR J=0:0
SET J=$SELECT($DATA(^PSI(58.3,PSGBON,1,AOU,1,J)):$ORDER(^(J)),1:0)
IF J'>0
QUIT
IF $SELECT($PIECE(^(J,0),"^",5)=""
SET PSGBOT=PSGBOT+$PIECE(^(0),"^",2)
+2 IF PSGBOT'=0
WRITE !!,"Item is on BACKORDER. You may not enter a quantity.",!,"Total Backordered for this item is ",PSGBOT,".",!!
UPD IF PSGBOT'>0
SET DR="16///"_ODT
SET DR(2,58.28)="2////"_DUZ_";S PSGWOLD=$P(^PSI(58.1,AOU,1,DA(1),5,DA,0),""^"",2);1T;S PSGWQD=X-PSGWOLD"
+1 IF $TEST
SET PSGDR=$PIECE(^PSDRUG(PSGDR,0),"^")
SET DIE="^PSI(58.1,AOU,1,"
SET DA(1)=AOU
SET DA=ITEM
DO ^DIE
KILL DIE
IF $DATA(PSGWQD)
IF (PSGWQD'=0)
SET PRTFLG=1
IF AMISFL=1
SET ^PSI(58.5,"AMIS",$HOROLOG,PSGWADT,PSGWCAT,PSGWAOU,PSGWDN,PSGWQD)=""
DONE KILL PSGBON,PSGBOT,PSGDR,PSGWDN,PSGWQD,PSGWOLD,X,Y,J,DR
GOTO ITEM
END IF 'PRTFLG
GOTO BOT
READ !!,"Do you wish to print a copy of this on-demand request ? N//",ANS:DTIME
IF '$TEST
SET ANS="^"
IF ANS=""
SET ANS="^"
IF ANS="^"
GOTO BOT
+1 IF "YyNn"'[$EXTRACT(ANS)
WRITE !!,"Answer ""Y"" or ""N"". If you answer yes, the program will print a ""pick list"" or",!,"hard copy of this on-demand request. The report lists the date, AOU, items,",!,"quantities, and person entering request."
GOTO END
+2 IF "Yy"[$EXTRACT(ANS)
SET ALL=0
SET (BDT,EDT)=ODT
GOTO DEV^PSGWODP
BOT KILL %,BCFLG,PSGBON,PSGBOT,PSGDR,DR,AOU,ODT,ANS,PSGWADT,PSGWCAT,PSGWDN,PSGWOLD,PSGWQD,PSGWAOU,AMISFL,KEY,PSGWV,DA,D,DIE,%DT,%W,D0,D1,D2,DI,DLAYGO,DQ,ITEM,PRTFLG,DRGDA
IF $DATA(PSGWFLG)
KILL PSGWSITE,PSGWFLG
QUIT
