| 1 | PRCPAWAP ;WISC/RFJ-adjustment approval ;11 Mar 94
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D ^PRCPUSEL Q:'$D(PRCP("I"))
|
|---|
| 5 | I PRCP("DPTYPE")'="W" W !,"ONLY THE WAREHOUSE CAN USE THIS OPTION." Q
|
|---|
| 6 | S IOP="HOME" D ^%ZIS K IOP
|
|---|
| 7 | ;
|
|---|
| 8 | N %,%DT,%H,%I,D,D0,DA,DATA,DI,DIC,DQ,DR,ITEMDA,NOW,NOWDT,PRCPFLAG,TRANID,UNAPPR,X,Y
|
|---|
| 9 | ADJ ; get adjustment number, quit if no adjustment is selected.
|
|---|
| 10 | K PRCPFLAG
|
|---|
| 11 | S TRANID=$$ADJUSTNO I TRANID["^" Q
|
|---|
| 12 | ;
|
|---|
| 13 | ; get a list of unapproved adjustments and store in tmp global.
|
|---|
| 14 | K ^TMP($J,"PRCPAWAP")
|
|---|
| 15 | S (DA,UNAPPR)=0
|
|---|
| 16 | F S DA=$O(^PRCP(445.2,"T",PRCP("I"),TRANID,DA)) Q:'DA S DATA=$G(^PRCP(445.2,DA,0)) I $P(DATA,"^",5) D
|
|---|
| 17 | . S ^TMP($J,"PRCPAWAP","ITEM",$P(DATA,"^",5))=DA
|
|---|
| 18 | . S:'$P(DATA,"^",20) UNAPPR=UNAPPR+1,^TMP($J,"PRCPAWAP","UNAPPR",$P(DATA,"^",5),DA)=""
|
|---|
| 19 | W !!?10,">> THERE IS '",UNAPPR,"' UNAPPROVED ITEMS ON THIS ADJUSTMENT. <<"
|
|---|
| 20 | ;
|
|---|
| 21 | ; approve **all** items for the selected adjustment.
|
|---|
| 22 | D NOW^%DTC S (Y,NOWDT)=% D DD^%DT S NOW=Y
|
|---|
| 23 | I UNAPPR D I $D(PRCPFLAG) K ^TMP($J,"PRCPAWAP") G ADJ
|
|---|
| 24 | . S XP=" DO YOU WANT TO APPROVE ALL OF THE ITEMS ON THIS ADJUSTMENT",XH=" ENTER 'YES' TO APPROVE ALL THE ITEMS ON THE ADJUSTMENT, 'NO' TO SELECT ITEMS."
|
|---|
| 25 | . W ! S %=$$YN^PRCPUYN(2)
|
|---|
| 26 | . I %=2 Q
|
|---|
| 27 | . I %'=1 S PRCPFLAG=1 Q
|
|---|
| 28 | . W !!?10,"approving adjustment items"
|
|---|
| 29 | . S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPAWAP","UNAPPR",ITEMDA)) Q:'ITEMDA S DA=0 F S DA=$O(^TMP($J,"PRCPAWAP","UNAPPR",ITEMDA,DA)) Q:'DA I $D(^PRCP(445.2,DA,0)) D
|
|---|
| 30 | . . L +^PRCP(445.2,DA)
|
|---|
| 31 | . . S DATA=^PRCP(445.2,DA,0) I $P(DATA,"^",20)="" W "." S $P(DATA,"^",20)=NOWDT,$P(DATA,"^",21)=DUZ,^(0)=DATA
|
|---|
| 32 | . . L -^PRCP(445.2,DA)
|
|---|
| 33 | . W !!?10,">> ALL ITEMS ON ADJUSTMENT HAVE BEEN APPROVED. <<"
|
|---|
| 34 | . S PRCPFLAG=1
|
|---|
| 35 | ;
|
|---|
| 36 | ITEM ; aprrove items as selected. only selection of items from the
|
|---|
| 37 | ; selected adjustment number. quit if no item is selected.
|
|---|
| 38 | W ! S ITEMDA=$$ITEM^PRCPAWU0 I ITEMDA["^" K ^TMP($J,"PRCPAWAP") G ADJ
|
|---|
| 39 | S DA=^TMP($J,"PRCPAWAP","ITEM",ITEMDA)
|
|---|
| 40 | L +^PRCP(445.2,DA)
|
|---|
| 41 | S DATA=^PRCP(445.2,DA,0),DR="20 ADJUSTMENT APPROVAL" I $P(DATA,"^",20)="" S DR=DR_"//"_NOW
|
|---|
| 42 | E W !!?10,">> ITEM ADJUSTMENT HAS ALREADY BEEN APPROVED, '@' FOR UNAPPROVED. <<"
|
|---|
| 43 | S DIE="^PRCP(445.2," D ^DIE K DIE
|
|---|
| 44 | S DATA=^PRCP(445.2,DA,0) I $P(DATA,"^",20),'$P(DATA,"^",21) S $P(^(0),"^",21)=DUZ,$P(DATA,"^",6)=DUZ
|
|---|
| 45 | I '$P(DATA,"^",20),$P(DATA,"^",21) S $P(^PRCP(445.2,DA,0),"^",21)=""
|
|---|
| 46 | L -^PRCP(445.2,DA)
|
|---|
| 47 | G ITEM
|
|---|
| 48 | ;
|
|---|
| 49 | ;
|
|---|
| 50 | ADJUSTNO() ; return selected adjustment number from file 445.2.
|
|---|
| 51 | N %,ADJNO,COUNT,PRCPFLAG,X
|
|---|
| 52 | F D Q:ADJNO'=""
|
|---|
| 53 | . W !!,"Select ADJUSTMENT NUMBER: "
|
|---|
| 54 | . R X:DTIME I '$T!(X["^")!(X="") S ADJNO="^" Q
|
|---|
| 55 | . S:$E(X) X="A"_X
|
|---|
| 56 | . I $E(X)="A",$D(^PRCP(445.2,"T",PRCP("I"),X)) S ADJNO=X Q
|
|---|
| 57 | . S ADJNO=""
|
|---|
| 58 | . W !,"Select the ADJUSTMENT NUMBER from the list below:",!
|
|---|
| 59 | . S COUNT=0,X="A" F S X=$O(^PRCP(445.2,"T",PRCP("I"),X)) Q:$E(X)'="A"!($G(PRCPFLAG)) D
|
|---|
| 60 | . . W " ADJUSTMENT NUMBER: ",X S COUNT=COUNT+1
|
|---|
| 61 | . . I COUNT#20=0 D P^PRCPUREP S %="",$P(%," ",80)="" W $C(13),%
|
|---|
| 62 | . . W !
|
|---|
| 63 | Q ADJNO
|
|---|
