- 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 Feb 18, 2025@23:42:44 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
