- PSGWODRN ;BHAM ISC/MPH,PTD,CML-Enter an On-Demand Request - for Nursing Staff ;Oct 17, 2017@14:48
- ;;2.3;Automatic Replenishment/Ward Stock;**11,19**;4 JAN 94;Build 45
- N PSGWITMC S PSGWITMC=0 ; PSGWITMC is a counter of the number of passes through ITEM
- 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="^"&(PSGWITMC<1)),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(2,58.11)="16///"_ODT,DR(3,58.28)="2////"_DUZ_";S PSGWOLD=$P(^PSI(58.1,AOU,1,DA(1),5,DA,0),""^"",2);1T;S PSGWQD=X-PSGWOLD"
- I $$GET^XPAR("ALL","PSGW_WS_LVL_ON") N IEN S IEN=ITEM_","_AOU_"," W !,"Stock Level Allowed is ",$$GET1^DIQ(58.11,IEN,1),"." K IEN ;Patch PSWG*2.3*19
- I PSGBOT'>0 S PSGDR=$P(^PSDRUG(PSGDR,0),"^"),DIE("NO^")="Other value",DIE="^PSI(58.1,",DA=AOU,DR="1///"_PSGDR D ^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,IEN S PSGWITMC=PSGWITMC+1 G ITEM
- END ;
- G:'PRTFLG BOT
- N PSGWTEMP S PSGWTEMP=$$GET1^DIQ(3.5,$P(PSGWSITE,"^",32),.01)
- I PSGWTEMP'="" D AUTOQ K PSGWTEMP,PSGWITMC
- 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,PSGWTEMP,PSGWITMC K:$D(PSGWFLG) PSGWSITE,PSGWFLG Q
- AUTOQ ;Patch to Auto queue Ward Stock Request to pharmacy printer (PSGW*2.3*19)
- S ALL=0,(BDT,EDT)=ODT
- S ZTIO=$$GET1^DIQ(3.5,$P(PSGWSITE,"^",32),.01)
- S ZTDESC="AUTO-PRINT WARD STOCK REQUEST" S ZTRTN="ENQ^PSGWODP" S:$D(AOULP) ZTSAVE("AOULP*")="" F G="BDT","EDT" S:$D(@G) ZTSAVE(G)="" S ZTDTH=$H
- D ^%ZTLOAD
- K ZTRTN,ZTDEC,ZTIO,ZTSAVE
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWODRN 4161 printed Jan 18, 2025@02:40:55 Page 2
- PSGWODRN ;BHAM ISC/MPH,PTD,CML-Enter an On-Demand Request - for Nursing Staff ;Oct 17, 2017@14:48
- +1 ;;2.3;Automatic Replenishment/Ward Stock;**11,19**;4 JAN 94;Build 45
- +2 ; PSGWITMC is a counter of the number of passes through ITEM
- NEW PSGWITMC
- SET PSGWITMC=0
- +3 IF '$DATA(PSGWSITE)
- DO ^PSGWSET
- if '$DATA(PSGWSITE)
- QUIT
- SET PSGWFLG=1
- +4 ; I '$P(PSGWSITE,"^",27) S BCFLG=0 G DATE
- SET BCFLG=0
- GOTO DATE
- +5 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="^"&(PSGWITMC<1))
- 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(2,58.11)="16///"_ODT
- SET DR(3,58.28)="2////"_DUZ_";S PSGWOLD=$P(^PSI(58.1,AOU,1,DA(1),5,DA,0),""^"",2);1T;S PSGWQD=X-PSGWOLD"
- +1 ;Patch PSWG*2.3*19
- IF $$GET^XPAR("ALL","PSGW_WS_LVL_ON")
- NEW IEN
- SET IEN=ITEM_","_AOU_","
- WRITE !,"Stock Level Allowed is ",$$GET1^DIQ(58.11,IEN,1),"."
- KILL IEN
- +2 IF PSGBOT'>0
- SET PSGDR=$PIECE(^PSDRUG(PSGDR,0),"^")
- SET DIE("NO^")="Other value"
- SET DIE="^PSI(58.1,"
- SET DA=AOU
- SET DR="1///"_PSGDR
- DO ^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,IEN
- SET PSGWITMC=PSGWITMC+1
- GOTO ITEM
- END ;
- +1 if 'PRTFLG
- GOTO BOT
- +2 NEW PSGWTEMP
- SET PSGWTEMP=$$GET1^DIQ(3.5,$PIECE(PSGWSITE,"^",32),.01)
- +3 IF PSGWTEMP'=""
- DO AUTOQ
- KILL PSGWTEMP,PSGWITMC
- +4 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
- +5 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
- +6 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,PSGWTEMP,PSGWITMC
- if $DATA(PSGWFLG)
- KILL PSGWSITE,PSGWFLG
- QUIT
- AUTOQ ;Patch to Auto queue Ward Stock Request to pharmacy printer (PSGW*2.3*19)
- +1 SET ALL=0
- SET (BDT,EDT)=ODT
- +2 SET ZTIO=$$GET1^DIQ(3.5,$PIECE(PSGWSITE,"^",32),.01)
- +3 SET ZTDESC="AUTO-PRINT WARD STOCK REQUEST"
- SET ZTRTN="ENQ^PSGWODP"
- if $DATA(AOULP)
- SET ZTSAVE("AOULP*")=""
- FOR G="BDT","EDT"
- if $DATA(@G)
- SET ZTSAVE(G)=""
- SET ZTDTH=$HOROLOG
- +4 DO ^%ZTLOAD
- +5 KILL ZTRTN,ZTDEC,ZTIO,ZTSAVE
- +6 QUIT
- +7 ;