| 1 | PRCPWPPL ;WISC/RFJ-primary receive issue book (list manager) ;20 Jan 93
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D ^PRCPUSEL Q:'$G(PRCP("I"))
|
|---|
| 5 | I PRCP("DPTYPE")'="P" W !,"ONLY THE PRIMARY CAN RECEIVE ISSUE BOOKS!" Q
|
|---|
| 6 | I $P(^PRCP(445,PRCP("I"),0),"^",16)'="N" W !,"BEFORE USING THIS OPTION, THE 'PRIMARY UPDATED BY WAREHOUSE' MUST BE SET TO NO." Q
|
|---|
| 7 | I $$CHECK^PRCPCUT1(PRCP("I")) Q
|
|---|
| 8 | N PRCPDA,PRCPFINL,PRCPIBNM,PRCPINPT,PRCPWHSE,PRCPPVNO,X,Y
|
|---|
| 9 | S PRCPINPT=PRCP("I")
|
|---|
| 10 | S X="" W ! D ESIG^PRCUESIG(DUZ,.X) I X'>0 Q
|
|---|
| 11 | S PRCPPVNO=+$O(^PRC(440,"AC","S",0))_";PRC(440," I '$D(^PRC(440,+PRCPPVNO,0)) W !!,"THERE IS NOT A VENDOR IN THE VENDOR FILE (#440) DESIGNATED AS A SUPPLY WHSE." Q
|
|---|
| 12 | F S PRCPDA=$$SELECTIB Q:PRCPDA<1 D
|
|---|
| 13 | . L +^PRCS(410,PRCPDA):5 I '$T D SHOWWHO^PRCPULOC(410,PRCPDA,0) Q
|
|---|
| 14 | . D ADD^PRCPULOC(410,PRCPDA,0,"Receive Issue Book")
|
|---|
| 15 | . S PRCPIBNM=$P(^PRCS(410,PRCPDA,0),"^")
|
|---|
| 16 | . S PRCPWHSE=0 F S PRCPWHSE=$O(^PRCP(445,"AC","W",PRCPWHSE)) Q:'PRCPWHSE I +$G(^PRCP(445,PRCPWHSE,0))=+PRCPIBNM Q
|
|---|
| 17 | . I 'PRCPWHSE W !,"THERE IS NOT A WAREHOUSE DESIGNATED FOR STATION '",+PRCPIBNM,"'." D UNLOCK Q
|
|---|
| 18 | . I $P($G(^PRCS(410,PRCPDA,9)),"^",3) S PRCPFINL=1
|
|---|
| 19 | . D EN^VALM("PRCP ISSUE BOOK RECEIVING")
|
|---|
| 20 | . D UNLOCK
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | ;
|
|---|
| 24 | UNLOCK ; unlock issue book
|
|---|
| 25 | D CLEAR^PRCPULOC(410,PRCPDA,0)
|
|---|
| 26 | L -^PRCS(410,PRCPDA)
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | ;
|
|---|
| 30 | INIT ; build array
|
|---|
| 31 | K ^TMP($J,"PRCPWPPLPOST")
|
|---|
| 32 | D REBUILD^PRCPWPPB
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | ;
|
|---|
| 36 | HDR ; header
|
|---|
| 37 | N SPACE
|
|---|
| 38 | S SPACE=" "
|
|---|
| 39 | S VALMHDR(1)=$E("ISSUE BOOK: "_PRCPIBNM_" FROM: "_$E($$INVNAME^PRCPUX1(PRCPWHSE),1,15)_SPACE,1,69)_$S($G(PRCPFINL):"** FINAL **",1:"")
|
|---|
| 40 | S VALMHDR(2)="LINE DESCRIPTION IM# NSN ** Q U A N T I T Y (in U/R) **"
|
|---|
| 41 | S VALMHDR(3)=" UNIT CONV UNIT UNIT/IS UNIT/REC WHSE PRIM *TO*"
|
|---|
| 42 | S VALMHDR(4)=" /IS FACT /REC AVGCOST UNITCOST ORDERED POSTED REC'D RECEIVE"
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | ;
|
|---|
| 46 | EXIT ; exit
|
|---|
| 47 | K ^TMP($J,"PRCPWPPL"),^TMP($J,"PRCPWPPLPOST"),^TMP($J,"PRCPWPPLLIST")
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | ;
|
|---|
| 51 | SELECTIB() ; select issue book
|
|---|
| 52 | N %,DIC,I,X,Y,Z
|
|---|
| 53 | S DIC="^PRCS(410,",DIC(0)="QEAMZ",DIC("A")="Select TRANSACTION NUMBER: "
|
|---|
| 54 | S DIC("S")="I $P(^(0),U,6)=PRCP(""I""),$P(^(0),U,2)=""O"",$P(^(0),U,4)=5,$P($G(^(3)),U,4)=+PRCPPVNO,$P($G(^(7)),U,6)]"""",$S('$D(^PRC(443,+Y,0)):1,$P(^(0),U,3)]"""":1,1:0)"
|
|---|
| 55 | W ! D ^PRCSDIC
|
|---|
| 56 | Q +Y
|
|---|
