| 1 | PRCPEITG ;WOIFO/CC-enter/edit inventory items (On-Demand) ; 11/6/06 9:56am
|
|---|
| 2 | ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | ODI(PRCPINPT,PRCPITEM) ; ask On-Demand and reason if appropriate, save data
|
|---|
| 8 | ;
|
|---|
| 9 | ; PRCPINPT inventory point ien
|
|---|
| 10 | ; PRCPITEM ien of the selected item
|
|---|
| 11 | ;
|
|---|
| 12 | N DIR,DIRUT,DIROUT,DTOUT,DUOUT,PRCPARRY,PRCPEDIT,PRCPIEN,PRCPONN,PRCPONO,PRCPREAS,Y
|
|---|
| 13 | S PRCPONO=$P(^PRCP(445,+PRCPINPT,1,+PRCPITEM,0),"^",30) ; O-D Flag
|
|---|
| 14 | I PRCPONO'="Y" S PRCPONO="N" ; if no value is defined, O-D Flag is No
|
|---|
| 15 | ; Can user edit this On-Demand setting?
|
|---|
| 16 | S PRCPEDIT=0
|
|---|
| 17 | I $D(^PRCP(445,+PRCPINPT,9,"B",DUZ)) S PRCPEDIT=1 ; authorized user
|
|---|
| 18 | ;
|
|---|
| 19 | ; Display On-Demand value. If user is not authorized,
|
|---|
| 20 | ; display << not editable >> , pause and exit
|
|---|
| 21 | I 'PRCPEDIT D EN^DDIOL("ON-DEMAND: "_$S(PRCPONO="N":"NO",1:"YES")_"// <<may not edit>>") D R^PRCPUREP Q
|
|---|
| 22 | ; if user can edit value, proceed with prompting
|
|---|
| 23 | YN S DIR(0)="Y",DIR("A")="ON-DEMAND",DIR("B")=PRCPONO
|
|---|
| 24 | S DIR("?",1)="Enter 'Y'es for low usage items qualifying to be On-Demand"
|
|---|
| 25 | S DIR("?")=" 'N'o for routinely used (standard) items"
|
|---|
| 26 | D ^DIR K DIR
|
|---|
| 27 | ; prompt user, default to value on file
|
|---|
| 28 | ; if user up-arrows or times out, exit
|
|---|
| 29 | I $D(DUOUT)!$D(DTOUT) G NOCHANGE
|
|---|
| 30 | I Y'=0,Y'=1 W "??" G YN
|
|---|
| 31 | I Y=1 S PRCPONN="Y"
|
|---|
| 32 | I Y=0 S PRCPONN="N"
|
|---|
| 33 | ; if new value agrees with current setting, exit
|
|---|
| 34 | I PRCPONN=PRCPONO Q ; no additional processing required
|
|---|
| 35 | ;
|
|---|
| 36 | ; prompt user for reason
|
|---|
| 37 | RS S DIR(0)="F^3:30",DIR("A")="REASON FOR CHANGE"
|
|---|
| 38 | S DIR("?")="Enter 3 - 30 characters with no embedded '^' and no leading spaces"
|
|---|
| 39 | ; if user enters '^', all spaces or just hits return, tell user setting will not be changed - no reason entered, prompt On-Demand again.
|
|---|
| 40 | D ^DIR K DIR
|
|---|
| 41 | I $D(DUOUT)!$D(DTOUT) G NOCHANGE
|
|---|
| 42 | F Q:$E(Y,1)'=" " S Y=$E(Y,2,$L(Y))
|
|---|
| 43 | I Y']"" W "??" G RS
|
|---|
| 44 | S PRCPREAS=Y
|
|---|
| 45 | ;
|
|---|
| 46 | ; save new setting, date/time, DUZ, reason in audit file
|
|---|
| 47 | S PRCPIEN="+1,"_+PRCPITEM_","_+PRCPINPT_","
|
|---|
| 48 | S PRCPARRY(445.13,PRCPIEN,.01)=$$NOW^XLFDT
|
|---|
| 49 | S PRCPARRY(445.13,PRCPIEN,1)=DUZ
|
|---|
| 50 | S PRCPARRY(445.13,PRCPIEN,2)=PRCPREAS
|
|---|
| 51 | S PRCPARRY(445.13,PRCPIEN,3)=PRCPONN
|
|---|
| 52 | D UPDATE^DIE("","PRCPARRY")
|
|---|
| 53 | I $D(^TMP("DIERR",$J)) W "NOTHING SAVED" ; likely system or space err
|
|---|
| 54 | ;
|
|---|
| 55 | ; Save new setting into field .8
|
|---|
| 56 | S PRCPIEN=+PRCPITEM_","_+PRCPINPT_","
|
|---|
| 57 | K PRCPARRY S PRCPARRY(445.01,PRCPIEN,.8)=PRCPONN
|
|---|
| 58 | D UPDATE^DIE("","PRCPARRY")
|
|---|
| 59 | I $D(^TMP("DIERR",$J)) W "NOTHING SAVED" ; likely system or space err
|
|---|
| 60 | OD Q
|
|---|
| 61 | ;
|
|---|
| 62 | NOCHANGE D EN^DDIOL("NO DATA UPDATED. VALID RESPONSE AND/OR REASON NOT ENTERED.")
|
|---|
| 63 | D R^PRCPUREP
|
|---|
| 64 | Q
|
|---|
