PSGWONDM ;BHAM ISC/MPH,PTD,CML,KKA-Enter an On-Demand Request - for Pharmacy Use ; 19 May 93 / 9:19 AM
;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
I '$D(PSGWSITE) D ^PSGWSET Q:'$D(PSGWSITE) S PSGWFLG=1
S PRTFLG=0,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 D HELP G ASK
S BCFLG=$S(%<2:1,1:0)
DATE S PSGWV="AMIS COMPILE FLAG" R !!,"SELECT DATE/TIME FOR ON-DEMAND REQUEST: ",PSGWDT:DTIME S:'$T PSGWDT="^" G:"^"[PSGWDT END
I "?"[$E(PSGWDT) 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=PSGWDT D ^%DT K %DT(0) G:Y<0 DATE S:'$D(PSGWODT) BDT=Y S (EDT,PSGWODT,ADT)=Y,CAT="W"
AOU R !,"Select AOU: ",X:DTIME S:'$T X="^" G BOT:X="^",DATE: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 AMISFL=0,DIC="^PSI(58.1,",DIC(0)="QEMNZ",DIC("S")="I $S('$D(^(""I"")):1,'^(""I""):1,^(""I"")>DT:1,1:0)" D ^DIC K DIC
G AOU:X?1."?",DATE:Y<0 S (AOU,PSGWAOU)=+Y I ($P(^PSI(58.1,AOU,0),"^",3)'=1)&($P(PSGWSITE,"^",25)=1) S 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="^",AOU: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)="QLOEM",DIC("DR")="12///1",DA(1)=AOU,DIC("S")="D SCR^PSGWOD2" D ^DIC K DIC G ITEM:X?1."?"!(Y<0) S (PSGDR,PSGWDN)=$P(Y,"^",2),NEWI=$P(Y,"^",3),ITEM=+Y
I 'NEWI S PSGWDUZ=DUZ,PREV=0 S PREV=$O(^PSI(58.1,"OND",BDT,AOU,+Y,0)) I +PREV S PSGWDUZ=$P(^PSI(58.1,AOU,1,+Y,5,PREV,0),"^",3) D NOW^%DTC S EDITDT=%
BACKOD S X=PSGDR,BOT=0,DIC="^PSI(58.3,",DIC(0)="" D ^DIC G:Y<0 NEWI S BON=+Y
F J=0:0 S J=$S($D(^PSI(58.3,BON,1,AOU,1,J)):$O(^(J)),1:0) Q:J'>0 S:$S($P(^(J,0),"^",5)="":1,1:0) BOT=BOT+$P(^(0),"^",2)
W:BOT'=0 !!,"Total Backordered for this item is ",BOT
RD I BOT>0 R !,"Do you wish to continue the demand request" S %=2 D YN^DICN G:%<0!(%="") END G:%=2 DONE I %<1 D HELP G RD
NEWI I NEWI D DIENEW^PSGWOD2 ;R !,"Is this new item a one-time request" S %=1 D YN^DICN G:%<0!(%="") BOT D:%<1 HELP G:%<1 NEWI D DIENEW
I 'NEWI S DR="16///"_PSGWODT,DR(2,58.28)="2////"_PSGWDUZ_";S OLD=$P(^PSI(58.1,AOU,1,DA(1),5,DA,0),""^"",2);1;S QD=X-OLD" I PREV S DR(2,58.28)=DR(2,58.28)_";4////"_DUZ_";5///"_EDITDT
UPD S PSGDR=$P(^PSDRUG(PSGDR,0),"^"),DIE="^PSI(58.1,AOU,1,",DA(1)=AOU,DA=ITEM D ^DIE K DIE I $D(QD),(QD'=0) S PRTFLG=1 I AMISFL=1 S ^PSI(58.5,"AMIS",$H,ADT,CAT,PSGWAOU,PSGWDN,QD)=""
;S PSGDR=$P(^PSDRUG(PSGDR,0),"^"),DIE="^PSI(58.1,",DA=AOU,DR="1///"_PSGDR D ^DIE K DIE I $D(QD),(QD'=0) S PRTFLG=1 I AMISFL=1 S ^PSI(58.5,"AMIS",$H,ADT,CAT,PSGWAOU,PSGWDN,QD)=""
EXP I 'NEWI,'BCFLG,$P(^PSI(58.1,AOU,0),"^",4) S DA(1)=AOU,DA=ITEM,DIE="^PSI(58.1,"_DA(1)_",1,",DR="35T" D ^DIE K DIE,DIC
DONE K %,EDITDT,PREV,BON,BOT,PSGDR,NEWI,X,Y,J,DR,PSGWDN,PSGWDUZ,QD,OLD,DRGDA 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="^" G:"^"[ANS BOT
I "YyNn"'[$E(ANS,1,1) 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",!," and quantities dispensed." G END
I "Yy"[$E(ANS,1,1) G EN^PSGWODP
BOT K %,%H,%I,BCFLG,BON,BOT,PSGDR,NEWI,DR,AOU,PSGWODT,PSGWDT,ANS,PSGWD,ADT,CAT,PSGWDN,QD,OLD,AMISFL,KEY,PSGWV,PSGWAOU,BDT,EDT,DIC,PSGWDRG,%DT,D,J,%W,C,D0,D1,D2,DI,DLAYGO,DQ,X,Y,DRGDA,DA,DIE,EDITDT,PREV,PSGWDUZ,ITEM,PRTFLG
K:$D(PSGWFLG) PSGWFLG,PSGWSITE Q
;
HELP W !,"PLEASE ANSWER ""YES"" OR ""NO""." Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWONDM 4039 printed Apr 09, 2024@20:44:17 Page 2
PSGWONDM ;BHAM ISC/MPH,PTD,CML,KKA-Enter an On-Demand Request - for Pharmacy Use ; 19 May 93 / 9:19 AM
+1 ;;2.3; Automatic Replenishment/Ward Stock ;;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 PRTFLG=0
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
DO HELP
GOTO ASK
+1 SET BCFLG=$SELECT(%<2:1,1:0)
DATE SET PSGWV="AMIS COMPILE FLAG"
READ !!,"SELECT DATE/TIME FOR ON-DEMAND REQUEST: ",PSGWDT:DTIME
if '$TEST
SET PSGWDT="^"
if "^"[PSGWDT
GOTO END
+1 IF "?"[$EXTRACT(PSGWDT)
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=PSGWDT
DO ^%DT
KILL %DT(0)
if Y<0
GOTO DATE
if '$DATA(PSGWODT)
SET BDT=Y
SET (EDT,PSGWODT,ADT)=Y
SET CAT="W"
AOU READ !,"Select AOU: ",X:DTIME
if '$TEST
SET X="^"
if X="^"
GOTO BOT
if X=""
GOTO DATE
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 AMISFL=0
SET DIC="^PSI(58.1,"
SET DIC(0)="QEMNZ"
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 DATE
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 AOU
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)="QLOEM"
SET DIC("DR")="12///1"
SET DA(1)=AOU
SET DIC("S")="D SCR^PSGWOD2"
DO ^DIC
KILL DIC
if X?1."?"!(Y<0)
GOTO ITEM
SET (PSGDR,PSGWDN)=$PIECE(Y,"^",2)
SET NEWI=$PIECE(Y,"^",3)
SET ITEM=+Y
+2 IF 'NEWI
SET PSGWDUZ=DUZ
SET PREV=0
SET PREV=$ORDER(^PSI(58.1,"OND",BDT,AOU,+Y,0))
IF +PREV
SET PSGWDUZ=$PIECE(^PSI(58.1,AOU,1,+Y,5,PREV,0),"^",3)
DO NOW^%DTC
SET EDITDT=%
BACKOD SET X=PSGDR
SET BOT=0
SET DIC="^PSI(58.3,"
SET DIC(0)=""
DO ^DIC
if Y<0
GOTO NEWI
SET BON=+Y
+1 FOR J=0:0
SET J=$SELECT($DATA(^PSI(58.3,BON,1,AOU,1,J)):$ORDER(^(J)),1:0)
if J'>0
QUIT
if $SELECT($PIECE(^(J,0),"^",5)=""
SET BOT=BOT+$PIECE(^(0),"^",2)
+2 if BOT'=0
WRITE !!,"Total Backordered for this item is ",BOT
RD IF BOT>0
READ !,"Do you wish to continue the demand request"
SET %=2
DO YN^DICN
if %<0!(%="")
GOTO END
if %=2
GOTO DONE
IF %<1
DO HELP
GOTO RD
NEWI ;R !,"Is this new item a one-time request" S %=1 D YN^DICN G:%<0!(%="") BOT D:%<1 HELP G:%<1 NEWI D DIENEW
IF NEWI
DO DIENEW^PSGWOD2
+1 IF 'NEWI
SET DR="16///"_PSGWODT
SET DR(2,58.28)="2////"_PSGWDUZ_";S OLD=$P(^PSI(58.1,AOU,1,DA(1),5,DA,0),""^"",2);1;S QD=X-OLD"
IF PREV
SET DR(2,58.28)=DR(2,58.28)_";4////"_DUZ_";5///"_EDITDT
UPD 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(QD)
IF (QD'=0)
SET PRTFLG=1
IF AMISFL=1
SET ^PSI(58.5,"AMIS",$HOROLOG,ADT,CAT,PSGWAOU,PSGWDN,QD)=""
+1 ;S PSGDR=$P(^PSDRUG(PSGDR,0),"^"),DIE="^PSI(58.1,",DA=AOU,DR="1///"_PSGDR D ^DIE K DIE I $D(QD),(QD'=0) S PRTFLG=1 I AMISFL=1 S ^PSI(58.5,"AMIS",$H,ADT,CAT,PSGWAOU,PSGWDN,QD)=""
EXP IF 'NEWI
IF 'BCFLG
IF $PIECE(^PSI(58.1,AOU,0),"^",4)
SET DA(1)=AOU
SET DA=ITEM
SET DIE="^PSI(58.1,"_DA(1)_",1,"
SET DR="35T"
DO ^DIE
KILL DIE,DIC
DONE KILL %,EDITDT,PREV,BON,BOT,PSGDR,NEWI,X,Y,J,DR,PSGWDN,PSGWDUZ,QD,OLD,DRGDA
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
GOTO BOT
+1 IF "YyNn"'[$EXTRACT(ANS,1,1)
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",!," and quantities dispensed."
GOTO END
+2 IF "Yy"[$EXTRACT(ANS,1,1)
GOTO EN^PSGWODP
BOT KILL %,%H,%I,BCFLG,BON,BOT,PSGDR,NEWI,DR,AOU,PSGWODT,PSGWDT,ANS,PSGWD,ADT,CAT,PSGWDN,QD,OLD,AMISFL,KEY,PSGWV,PSGWAOU,BDT,EDT,DIC,PSGWDRG,%DT,D,J,%W,C,D0,D1,D2,DI,DLAYGO,DQ,X,Y,DRGDA,DA,DIE,EDITDT,PREV,PSGWDUZ,ITEM,PRTFLG
+1 if $DATA(PSGWFLG)
KILL PSGWFLG,PSGWSITE
QUIT
+2 ;
HELP WRITE !,"PLEASE ANSWER ""YES"" OR ""NO""."
QUIT
