- PRCPAWU0 ;WISC/RFJ-adjustment utilities ;11 Mar 94
- ;;5.1;IFCAP;**124**;Oct 20, 2000;Build 2
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- ITEM() ; select item from tmp($j,"prcpawap","item",*itemnumber*) global
- N %,COUNT,ITEMDA,PRCPFLAG,X
- F D Q:ITEMDA'=""
- . W !," Select ITEM: "
- . R X:DTIME I '$T!(X["^")!(X="") S ITEMDA="^" Q
- . I $D(^TMP($J,"PRCPAWAP","ITEM",+X)) S ITEMDA=+X Q
- . S ITEMDA=""
- . W !,"Select the ITEM NUMBER from the list below:",!
- . S COUNT=0,X="" F S X=$O(^TMP($J,"PRCPAWAP","ITEM",X)) Q:X=""!($G(PRCPFLAG)) D
- . . W " ITEM NUMBER: ",X,?23,$E($$DESCR^PRCPUX1(PRCP("I"),+X),1,30),?58,"NSN: ",$$NSN^PRCPUX1(+X) S COUNT=COUNT+1
- . . I COUNT#20=0 D P^PRCPUREP S %="",$P(%," ",80)="" W $C(13),%
- . . W !
- Q ITEMDA
- ;
- ;
- VOUCHER() ; enter reference voucher number
- N DIR,X,Y
- S DIR(0)="FA^5:5",DIR("A")=" VOUCHER NUMBER: ",DIR("A",1)=" >> Enter DOCUMENT IDENTIFIER number. <<"
- D ^DIR
- Q Y
- ;
- ;
- QTY(LOW,HIGH) ; adjust quantity from low to high
- ; return qty, qty=^ for ^ entered
- N DIR,X,Y
- S DIR(0)="NA^"_LOW_":"_HIGH_":0",DIR("A")=" ADJUSTED QUANTITY: ",DIR("B")=0
- S DIR("A",1)=" >> Enter the adjusted quantity in the range "_LOW_" to "_HIGH_". <<"
- D ^DIR
- Q Y
- ;
- ;
- VALUE(LOW,HIGH,PROMPT,DEFAULT) ; adjust value from low to high
- ; ask in prompt with default value
- N DIR,X,Y
- S DIR(0)="NAO^"_LOW_":"_HIGH_":2",DIR("A")=" ADJUSTED TOTAL"_PROMPT_" VALUE: " S:DEFAULT'="" DIR("B")=DEFAULT
- S DIR("A",1)=" >> Enter the adjusted value in the range "_LOW_" to "_HIGH_". <<"
- D ^DIR
- Q Y
- ;
- ;
- REASON(DEFAULT,NODISV) ; enter reason text
- ;NODISV=1 will stop default reason from ^DISV
- N DIR,REASON,X,Y
- I DEFAULT="",'$G(NODISV) S REASON=$G(^DISV(+$G(DUZ),"PRCPAWU0","REASON"))
- S DIR(0)="F^1:80",DIR("A")=" REASON TEXT",DIR("B")=$S(DEFAULT=""&'$G(NODISV):$G(REASON),1:DEFAULT)
- S DIR("A",1)=" >> Enter the reason text which will appear on the transaction register. <<"
- D ^DIR
- I (DEFAULT=""&'$G(NODISV)),Y'["^" S ^DISV(DUZ,"PRCPAWU0","REASON")=Y
- Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPAWU0 2130 printed Feb 18, 2025@23:39:20 Page 2
- PRCPAWU0 ;WISC/RFJ-adjustment utilities ;11 Mar 94
- +1 ;;5.1;IFCAP;**124**;Oct 20, 2000;Build 2
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- ITEM() ; select item from tmp($j,"prcpawap","item",*itemnumber*) global
- +1 NEW %,COUNT,ITEMDA,PRCPFLAG,X
- +2 FOR
- Begin DoDot:1
- +3 WRITE !," Select ITEM: "
- +4 READ X:DTIME
- IF '$TEST!(X["^")!(X="")
- SET ITEMDA="^"
- QUIT
- +5 IF $DATA(^TMP($JOB,"PRCPAWAP","ITEM",+X))
- SET ITEMDA=+X
- QUIT
- +6 SET ITEMDA=""
- +7 WRITE !,"Select the ITEM NUMBER from the list below:",!
- +8 SET COUNT=0
- SET X=""
- FOR
- SET X=$ORDER(^TMP($JOB,"PRCPAWAP","ITEM",X))
- if X=""!($GET(PRCPFLAG))
- QUIT
- Begin DoDot:2
- +9 WRITE " ITEM NUMBER: ",X,?23,$EXTRACT($$DESCR^PRCPUX1(PRCP("I"),+X),1,30),?58,"NSN: ",$$NSN^PRCPUX1(+X)
- SET COUNT=COUNT+1
- +10 IF COUNT#20=0
- DO P^PRCPUREP
- SET %=""
- SET $PIECE(%," ",80)=""
- WRITE $CHAR(13),%
- +11 WRITE !
- End DoDot:2
- End DoDot:1
- if ITEMDA'=""
- QUIT
- +12 QUIT ITEMDA
- +13 ;
- +14 ;
- VOUCHER() ; enter reference voucher number
- +1 NEW DIR,X,Y
- +2 SET DIR(0)="FA^5:5"
- SET DIR("A")=" VOUCHER NUMBER: "
- SET DIR("A",1)=" >> Enter DOCUMENT IDENTIFIER number. <<"
- +3 DO ^DIR
- +4 QUIT Y
- +5 ;
- +6 ;
- QTY(LOW,HIGH) ; adjust quantity from low to high
- +1 ; return qty, qty=^ for ^ entered
- +2 NEW DIR,X,Y
- +3 SET DIR(0)="NA^"_LOW_":"_HIGH_":0"
- SET DIR("A")=" ADJUSTED QUANTITY: "
- SET DIR("B")=0
- +4 SET DIR("A",1)=" >> Enter the adjusted quantity in the range "_LOW_" to "_HIGH_". <<"
- +5 DO ^DIR
- +6 QUIT Y
- +7 ;
- +8 ;
- VALUE(LOW,HIGH,PROMPT,DEFAULT) ; adjust value from low to high
- +1 ; ask in prompt with default value
- +2 NEW DIR,X,Y
- +3 SET DIR(0)="NAO^"_LOW_":"_HIGH_":2"
- SET DIR("A")=" ADJUSTED TOTAL"_PROMPT_" VALUE: "
- if DEFAULT'=""
- SET DIR("B")=DEFAULT
- +4 SET DIR("A",1)=" >> Enter the adjusted value in the range "_LOW_" to "_HIGH_". <<"
- +5 DO ^DIR
- +6 QUIT Y
- +7 ;
- +8 ;
- REASON(DEFAULT,NODISV) ; enter reason text
- +1 ;NODISV=1 will stop default reason from ^DISV
- +2 NEW DIR,REASON,X,Y
- +3 IF DEFAULT=""
- IF '$GET(NODISV)
- SET REASON=$GET(^DISV(+$GET(DUZ),"PRCPAWU0","REASON"))
- +4 SET DIR(0)="F^1:80"
- SET DIR("A")=" REASON TEXT"
- SET DIR("B")=$SELECT(DEFAULT=""&'$GET(NODISV):$GET(REASON),1:DEFAULT)
- +5 SET DIR("A",1)=" >> Enter the reason text which will appear on the transaction register. <<"
- +6 DO ^DIR
- +7 IF (DEFAULT=""&'$GET(NODISV))
- IF Y'["^"
- SET ^DISV(DUZ,"PRCPAWU0","REASON")=Y
- +8 QUIT Y