PRCPUX2 ;WISC/RFJ/VAC/DST-extrinsic functions ; 2/21/07 10:52am
;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
;Per VHA Directive 2004-038, this routine should not be modified.
;*98 Added three new calls to support On-Demand Items
;*98 Added fourth call to support ODI All items or single item
Q
;
;
ISMSFLAG(SITE) ; isms switch on|off for site
; switch=0 or 1 for log code sheet format
; switch=2 for isms code sheet formats
N % S %=+$P($G(^PRC(411,+SITE,0)),"^",23)
Q $S(1:1,%=0:1,1:%)
;
;
INPERCNT(V1,V2,V3,V4) ; initialize percent graph
; v1=total number of entries
; v2=display character
; v3=reverse video on (optional)
; v4=reverse video off (optional)
; returns number v2 to display per entry
W !!?30,"% COMPLETE",!?10,"0 10 20 30 40 50 60 70 80 90 100"
W !?10,"|----+----+----+----+----+----+----+----+----+----|"
W !?10,V3,V2,V4
S %=.02*V1,%=$S(%=0:50,1:1/%)
Q %
;
;
SHPERCNT(V1,V2,V3,V4,V5,V6) ; display percent complete
; v1=current entry number executed
; v2=display this many v3 for each entry
; v3=character to display
; v4=reverse video on (optional)
; v5=reverse video off (optional)
; return last one displayed
N %
S X=V1*V2\1 S:X>50 X=50 F %=((V1-1*V2\1)+1):1:X W V4,V3,V5 I $X>50,$D(PRCP("XY")) X PRCP("XY")
Q X
;
;
QPERCNT(V1,V2,V3,V4) ; finish percent display
; v1=last v2 displayed
; v2=character to display
; v3=reverse video on (optional)
; v4=reverse video off (optional)
N %
F %=V1+1:1:50 W V3,V2,V4 I $X>50,$D(PRCP("XY")) X PRCP("XY")
Q
;
;
DISPLAY(DX1,DX2,X) ; display message
; dx1 = begin column
; dx2 = end column
; x = message
N %,END,LENGTH,LINE,NEXT,PRCPFLAG,PRCPLINE,TEXT
S LENGTH=DX2-DX1 I LENGTH<10 S (DX1,DX2)=1,LENGTH=79
S DX1=DX1-1,DX2=DX2-1,PRCPLINE="",$P(PRCPLINE,"-",LENGTH)="",PRCPLINE="+"_PRCPLINE_"+"
W !?DX1,PRCPLINE
S LINE=0,TEXT=""
F D I TEXT="",'$O(X(LINE)) Q
. ;
. ; get more text if less than 240 characters
. F D Q:$G(PRCPFLAG)
. . S NEXT=+$O(X(LINE))
. . I NEXT,$L(TEXT)+$L($G(X(NEXT)))<240 S TEXT=TEXT_$S(TEXT'="":" ",1:"")_$G(X(NEXT)) K X(NEXT) Q
. . S PRCPFLAG=1
. ;
. ; fit text in window
. F END=LENGTH:-1:0 S %=$E(TEXT,END) I %=""!(%=" ") Q
. I END=0 S END=LENGTH
. W !?DX1,"|",$E(TEXT,1,END-1),?DX2,"|" S TEXT=$E(TEXT,END+1,255)
W !?DX1,PRCPLINE
Q
;
ODITEM(INVPT,ITEMDA) ;Return a flag for On-Demand Item
; If an item is in the warehouse, return a "W", if the item is an
; on-demand item, return a "Y", otherwise return a null.
Q:$P($G(^PRCP(445,INVPT,0)),"^",3)="W" "W"
Q:$P($G(^PRCP(445,INVPT,1,ITEMDA,0)),"^",30)="N" ""
Q $P($G(^PRCP(445,INVPT,1,ITEMDA,0)),"^",30)
;
ODIPROM(Y) ; Display prompt to user for On-Demand Items selection
;
; DIRUT - "^" entered, exit from this option and return to menu.
; Y - user selection, passed to calling routine for further process:
; if Y = 1 - display Standard Items on the report only.
; if Y = 2 - display On-Demand Items on the report only.
; if Y = 3 - display All Items on the report.
;
N X
W !
S X(1)=" Select On-Demand/Standard items to include on this report: "
D DISPLAY^PRCPUX2(3,75,.X)
; Choose one
K DIR
S DIR(0)="S^1:Standard Items Only;2:On-Demand Items Only;3:All Items (Both Standard and On-Demand)"
S DIR("A")="Display information for"
D ^DIR
K DIR
Q:$D(DIRUT) 0
Q Y
;
SRTPRMP(Y) ; Display prompt for On-Demand Items SORT selection
;
; DIRUT - "^" entered, exit from this option and return to menu.
; Y - user selection, passed to calling routine for further process:
; If Y = 1, report sorted by Item Description
; Y = 2, report sorted by Item Number
N X
W !
S X(1)=" Select the order in which you want the item information to appear. "
D DISPLAY^PRCPUX2(3,42,.X)
K DIR
S DIR(0)="S^1:ITEM DESCRIPTION;2:ITEM NUMBER"
S DIR("A")="Sort By"
D ^DIR
K DIR
Q:$D(DIRUT) 0
Q Y
;
SINGIT(PRCPIP) ; Prompt for selecting a single item or all items
; *98 Used by PRCPRODA
; ITEMSEL=NULL for all items selected or non-NULL for a single item
N XP,ITEMSEL
SING1 S %=0,ITEMSEL=""
W !
W "To select All items, press RETURN."
S ITEMSEL=$$ITEM^PRCPUITM(PRCPIP,0,"","")
I ITEMSEL=0 D G SING1:%=2
.S XP="Do you want to select ALL items"
.W !
.S %=$$YN^PRCPUYN(1)
.I %=1 S ITEMSEL="" Q
.S ITEMSEL="^"
Q ITEMSEL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPUX2 4521 printed Oct 16, 2024@18:17:17 Page 2
PRCPUX2 ;WISC/RFJ/VAC/DST-extrinsic functions ; 2/21/07 10:52am
+1 ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;*98 Added three new calls to support On-Demand Items
+4 ;*98 Added fourth call to support ODI All items or single item
+5 QUIT
+6 ;
+7 ;
ISMSFLAG(SITE) ; isms switch on|off for site
+1 ; switch=0 or 1 for log code sheet format
+2 ; switch=2 for isms code sheet formats
+3 NEW %
SET %=+$PIECE($GET(^PRC(411,+SITE,0)),"^",23)
+4 QUIT $SELECT(1:1,%=0:1,1:%)
+5 ;
+6 ;
INPERCNT(V1,V2,V3,V4) ; initialize percent graph
+1 ; v1=total number of entries
+2 ; v2=display character
+3 ; v3=reverse video on (optional)
+4 ; v4=reverse video off (optional)
+5 ; returns number v2 to display per entry
+6 WRITE !!?30,"% COMPLETE",!?10,"0 10 20 30 40 50 60 70 80 90 100"
+7 WRITE !?10,"|----+----+----+----+----+----+----+----+----+----|"
+8 WRITE !?10,V3,V2,V4
+9 SET %=.02*V1
SET %=$SELECT(%=0:50,1:1/%)
+10 QUIT %
+11 ;
+12 ;
SHPERCNT(V1,V2,V3,V4,V5,V6) ; display percent complete
+1 ; v1=current entry number executed
+2 ; v2=display this many v3 for each entry
+3 ; v3=character to display
+4 ; v4=reverse video on (optional)
+5 ; v5=reverse video off (optional)
+6 ; return last one displayed
+7 NEW %
+8 SET X=V1*V2\1
if X>50
SET X=50
FOR %=((V1-1*V2\1)+1):1:X
WRITE V4,V3,V5
IF $X>50
IF $DATA(PRCP("XY"))
XECUTE PRCP("XY")
+9 QUIT X
+10 ;
+11 ;
QPERCNT(V1,V2,V3,V4) ; finish percent display
+1 ; v1=last v2 displayed
+2 ; v2=character to display
+3 ; v3=reverse video on (optional)
+4 ; v4=reverse video off (optional)
+5 NEW %
+6 FOR %=V1+1:1:50
WRITE V3,V2,V4
IF $X>50
IF $DATA(PRCP("XY"))
XECUTE PRCP("XY")
+7 QUIT
+8 ;
+9 ;
DISPLAY(DX1,DX2,X) ; display message
+1 ; dx1 = begin column
+2 ; dx2 = end column
+3 ; x = message
+4 NEW %,END,LENGTH,LINE,NEXT,PRCPFLAG,PRCPLINE,TEXT
+5 SET LENGTH=DX2-DX1
IF LENGTH<10
SET (DX1,DX2)=1
SET LENGTH=79
+6 SET DX1=DX1-1
SET DX2=DX2-1
SET PRCPLINE=""
SET $PIECE(PRCPLINE,"-",LENGTH)=""
SET PRCPLINE="+"_PRCPLINE_"+"
+7 WRITE !?DX1,PRCPLINE
+8 SET LINE=0
SET TEXT=""
+9 FOR
Begin DoDot:1
+10 ;
+11 ; get more text if less than 240 characters
+12 FOR
Begin DoDot:2
+13 SET NEXT=+$ORDER(X(LINE))
+14 IF NEXT
IF $LENGTH(TEXT)+$LENGTH($GET(X(NEXT)))<240
SET TEXT=TEXT_$SELECT(TEXT'="":" ",1:"")_$GET(X(NEXT))
KILL X(NEXT)
QUIT
+15 SET PRCPFLAG=1
End DoDot:2
if $GET(PRCPFLAG)
QUIT
+16 ;
+17 ; fit text in window
+18 FOR END=LENGTH:-1:0
SET %=$EXTRACT(TEXT,END)
IF %=""!(%=" ")
QUIT
+19 IF END=0
SET END=LENGTH
+20 WRITE !?DX1,"|",$EXTRACT(TEXT,1,END-1),?DX2,"|"
SET TEXT=$EXTRACT(TEXT,END+1,255)
End DoDot:1
IF TEXT=""
IF '$ORDER(X(LINE))
QUIT
+21 WRITE !?DX1,PRCPLINE
+22 QUIT
+23 ;
ODITEM(INVPT,ITEMDA) ;Return a flag for On-Demand Item
+1 ; If an item is in the warehouse, return a "W", if the item is an
+2 ; on-demand item, return a "Y", otherwise return a null.
+3 if $PIECE($GET(^PRCP(445,INVPT,0)),"^",3)="W"
QUIT "W"
+4 if $PIECE($GET(^PRCP(445,INVPT,1,ITEMDA,0)),"^",30)="N"
QUIT ""
+5 QUIT $PIECE($GET(^PRCP(445,INVPT,1,ITEMDA,0)),"^",30)
+6 ;
ODIPROM(Y) ; Display prompt to user for On-Demand Items selection
+1 ;
+2 ; DIRUT - "^" entered, exit from this option and return to menu.
+3 ; Y - user selection, passed to calling routine for further process:
+4 ; if Y = 1 - display Standard Items on the report only.
+5 ; if Y = 2 - display On-Demand Items on the report only.
+6 ; if Y = 3 - display All Items on the report.
+7 ;
+8 NEW X
+9 WRITE !
+10 SET X(1)=" Select On-Demand/Standard items to include on this report: "
+11 DO DISPLAY^PRCPUX2(3,75,.X)
+12 ; Choose one
+13 KILL DIR
+14 SET DIR(0)="S^1:Standard Items Only;2:On-Demand Items Only;3:All Items (Both Standard and On-Demand)"
+15 SET DIR("A")="Display information for"
+16 DO ^DIR
+17 KILL DIR
+18 if $DATA(DIRUT)
QUIT 0
+19 QUIT Y
+20 ;
SRTPRMP(Y) ; Display prompt for On-Demand Items SORT selection
+1 ;
+2 ; DIRUT - "^" entered, exit from this option and return to menu.
+3 ; Y - user selection, passed to calling routine for further process:
+4 ; If Y = 1, report sorted by Item Description
+5 ; Y = 2, report sorted by Item Number
+6 NEW X
+7 WRITE !
+8 SET X(1)=" Select the order in which you want the item information to appear. "
+9 DO DISPLAY^PRCPUX2(3,42,.X)
+10 KILL DIR
+11 SET DIR(0)="S^1:ITEM DESCRIPTION;2:ITEM NUMBER"
+12 SET DIR("A")="Sort By"
+13 DO ^DIR
+14 KILL DIR
+15 if $DATA(DIRUT)
QUIT 0
+16 QUIT Y
+17 ;
SINGIT(PRCPIP) ; Prompt for selecting a single item or all items
+1 ; *98 Used by PRCPRODA
+2 ; ITEMSEL=NULL for all items selected or non-NULL for a single item
+3 NEW XP,ITEMSEL
SING1 SET %=0
SET ITEMSEL=""
+1 WRITE !
+2 WRITE "To select All items, press RETURN."
+3 SET ITEMSEL=$$ITEM^PRCPUITM(PRCPIP,0,"","")
+4 IF ITEMSEL=0
Begin DoDot:1
+5 SET XP="Do you want to select ALL items"
+6 WRITE !
+7 SET %=$$YN^PRCPUYN(1)
+8 IF %=1
SET ITEMSEL=""
QUIT
+9 SET ITEMSEL="^"
End DoDot:1
if %=2
GOTO SING1
+10 QUIT ITEMSEL
