PRCPURS4 ;WISC/RFJ-select item list ;11 Aug 93
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
ITEMSEL ; select a group of items from inventory point
; if all items are selected, return prcpalli=1
; selected items are returned in tmp($j,"prcpurs4",itemda)
N ITEMDA
K PRCPALLI,^TMP($J,"PRCPURS4")
W !!,"To select ALL items, press RETURN."
F S ITEMDA=$$ITEM^PRCPUITM(PRCP("I"),0,"","") Q:'ITEMDA S ^TMP($J,"PRCPURS4",ITEMDA)=""
I ITEMDA["^" K ^TMP($J,"PRCPURS4"),PRCPALLI Q
I $O(^TMP($J,"PRCPURS4",0)) Q
S XP="Do you want to select ALL items",XH="Enter 'YES' to select ALL items, 'NO' or '^' to exit."
W ! I $$YN^PRCPUYN(1)'=1 Q
S PRCPALLI=1
Q
;
;
ITEMMAST(PRCPDATE) ; select a group of items from item master file
; prcpdate = date to check for opening balance
; if all items are selected, return allitems=1
; selected items are returned in tmp($j,"prcpitems",itemda)
K ALLITEMS,^TMP($J,"PRCPITEMS")
W !!,"To select ALL items, press RETURN."
F S ITEMDA=$$MASTITEM^PRCPUITM($S(PRCPDATE:"I $D(^PRCP(445.1,PRCP(""I""),1,+Y,1,PRCPDATE,0))",1:"")) Q:'ITEMDA S ^TMP($J,"PRCPITEMS",ITEMDA)=""
I ITEMDA["^" K ^TMP($J,"PRCPITEMS") Q
I '$O(^TMP($J,"PRCPITEMS",0)) S XP="Do you want to select ALL items",XH="Enter 'YES' to select ALL items, 'NO' or '^' to exit." W ! S %=$$YN^PRCPUYN(0) I %=1 S ALLITEMS=1
I '$O(^TMP($J,"PRCPITEMS",0)),'$D(ALLITEMS) W !!,"NO ITEMS SELECTED!" Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPURS4 1523 printed Sep 23, 2025@19:52:26 Page 2
PRCPURS4 ;WISC/RFJ-select item list ;11 Aug 93
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
ITEMSEL ; select a group of items from inventory point
+1 ; if all items are selected, return prcpalli=1
+2 ; selected items are returned in tmp($j,"prcpurs4",itemda)
+3 NEW ITEMDA
+4 KILL PRCPALLI,^TMP($JOB,"PRCPURS4")
+5 WRITE !!,"To select ALL items, press RETURN."
+6 FOR
SET ITEMDA=$$ITEM^PRCPUITM(PRCP("I"),0,"","")
if 'ITEMDA
QUIT
SET ^TMP($JOB,"PRCPURS4",ITEMDA)=""
+7 IF ITEMDA["^"
KILL ^TMP($JOB,"PRCPURS4"),PRCPALLI
QUIT
+8 IF $ORDER(^TMP($JOB,"PRCPURS4",0))
QUIT
+9 SET XP="Do you want to select ALL items"
SET XH="Enter 'YES' to select ALL items, 'NO' or '^' to exit."
+10 WRITE !
IF $$YN^PRCPUYN(1)'=1
QUIT
+11 SET PRCPALLI=1
+12 QUIT
+13 ;
+14 ;
ITEMMAST(PRCPDATE) ; select a group of items from item master file
+1 ; prcpdate = date to check for opening balance
+2 ; if all items are selected, return allitems=1
+3 ; selected items are returned in tmp($j,"prcpitems",itemda)
+4 KILL ALLITEMS,^TMP($JOB,"PRCPITEMS")
+5 WRITE !!,"To select ALL items, press RETURN."
+6 FOR
SET ITEMDA=$$MASTITEM^PRCPUITM($SELECT(PRCPDATE:"I $D(^PRCP(445.1,PRCP(""I""),1,+Y,1,PRCPDATE,0))",1:""))
if 'ITEMDA
QUIT
SET ^TMP($JOB,"PRCPITEMS",ITEMDA)=""
+7 IF ITEMDA["^"
KILL ^TMP($JOB,"PRCPITEMS")
QUIT
+8 IF '$ORDER(^TMP($JOB,"PRCPITEMS",0))
SET XP="Do you want to select ALL items"
SET XH="Enter 'YES' to select ALL items, 'NO' or '^' to exit."
WRITE !
SET %=$$YN^PRCPUYN(0)
IF %=1
SET ALLITEMS=1
+9 IF '$ORDER(^TMP($JOB,"PRCPITEMS",0))
IF '$DATA(ALLITEMS)
WRITE !!,"NO ITEMS SELECTED!"
QUIT
+10 QUIT
