| [613] | 1 | PRCPWPLM ;WISC/RFJ-whse post issue book (list manager) ;13 Jan 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:'$G(PRCP("I"))
|
|---|
| 5 | I PRCP("DPTYPE")'="W" W !,"ONLY THE WAREHOUSE CAN POST ISSUE BOOKS!" Q
|
|---|
| 6 | I $$CHECK^PRCPCUT1(PRCP("I")) Q
|
|---|
| 7 | I '$D(^PRC(442.6,"B",PRC("SITE")_"-I"_$E(PRC("FY"),2))) D Q
|
|---|
| 8 | . K X S X(1)="Before you can post issue books you need to set up a common numbering series for issue books. The common numbering series should be in the form '460-I4' where 460 is the station number and 4 is the fiscal year."
|
|---|
| 9 | . S X(2)="For this station and fiscal year, set up the common numbering series: "_PRC("SITE")_"-I"_$E(PRC("FY"),2)
|
|---|
| 10 | . D DISPLAY^PRCPUX2(5,75,.X)
|
|---|
| 11 | N PRCPDA,PRCPFERR,PRCPFINL,PRCPFNSN,PRCPFPRI,PRCPIBNM,PRCPINPT,PRCPORD,PRCPPRIM,PRCPPVNO,X,Y
|
|---|
| 12 | S PRCPINPT=PRCP("I")
|
|---|
| 13 | S X="" W ! D ESIG^PRCUESIG(DUZ,.X) I X'>0 Q
|
|---|
| 14 | 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
|
|---|
| 15 | F S PRCPDA=$$SELECTIB(1) Q:PRCPDA<1 D
|
|---|
| 16 | . L +^PRCS(410,PRCPDA):5 I '$T D SHOWWHO^PRCPULOC(410,PRCPDA,0) Q
|
|---|
| 17 | . D ADD^PRCPULOC(410,PRCPDA,0,"Post Issue Book")
|
|---|
| 18 | . I $P($G(^PRCS(410,PRCPDA,9)),"^",3)'="" W !,"*** THIS TRANSACTION NUMBER WAS JUST MADE A 'FINAL' ***" D UNLOCK Q
|
|---|
| 19 | . S PRCPIBNM=$P(^PRCS(410,PRCPDA,0),"^")
|
|---|
| 20 | . S PRCPPRIM=$P($G(^PRCS(410,PRCPDA,0)),"^",6)
|
|---|
| 21 | . ; primary inventory point not attached to issue book
|
|---|
| 22 | . I '$D(^PRCP(445,+PRCPPRIM,0)) D I 'PRCPPRIM D UNLOCK Q
|
|---|
| 23 | . . W !,"NOT A VALID PRIMARY INVENTORY POINT ('",$S(PRCPPRIM="":"<<NO ENTRY>>",1:PRCPPRIM),"')."
|
|---|
| 24 | . . F S PRCPPRIM=+$$TO^PRCPUDPT(PRCP("I")) Q:'PRCPPRIM D Q:PRCPPRIM
|
|---|
| 25 | . . . S XP=" ARE YOU SURE YOU WANT TO USE THIS INVENTORY POINT FOR DISTRIBUTION",XH="ENTER 'YES' TO USE THIS INVENTORY POINT, 'NO' TO SELECT ANOTHER INVENTORY POINT."
|
|---|
| 26 | . . . I $$YN^PRCPUYN(1)'=1 S PRCPPRIM=0 Q
|
|---|
| 27 | . . . S $P(^PRCS(410,PRCPDA,0),"^",6)=PRCPPRIM
|
|---|
| 28 | . ;
|
|---|
| 29 | . S PRCPFPRI=$S($P($G(^PRCP(445,PRCPPRIM,0)),"^",16)="N":0,1:1)
|
|---|
| 30 | . K X S X(1)="Distribution to Primary Inventory Point: "_$P($$INVNAME^PRCPUX1(PRCPPRIM),"-",2,99)_" "_$S('PRCPFPRI:"***NOT UPDATED DURING POSTING***",1:"") D DISPLAY^PRCPUX2(5,75,.X)
|
|---|
| 31 | . ;
|
|---|
| 32 | . ; get voucher number
|
|---|
| 33 | . S PRCPORD=$P($G(^PRCS(410,PRCPDA,445)),"^")
|
|---|
| 34 | . K X S X(1)="Reference Voucher Number: "_PRCPORD
|
|---|
| 35 | . I PRCPORD="" K X S X(1)="This is the FIRST time this issue book has been POSTED. The reference voucher number will automatically be generated from the common numbering series when the issue book is posted."
|
|---|
| 36 | . D DISPLAY^PRCPUX2(5,75,.X)
|
|---|
| 37 | . D R^PRCPUREP
|
|---|
| 38 | . S PRCPFNSN=+$G(^DISV(DUZ,"PRCPWPLM","SHOWNSN"))
|
|---|
| 39 | . K PRCPFINL
|
|---|
| 40 | . D EN^VALM("PRCP ISSUE BOOK POSTING")
|
|---|
| 41 | . D UNLOCK
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | ;
|
|---|
| 45 | UNLOCK ; unlock issue book
|
|---|
| 46 | D CLEAR^PRCPULOC(410,PRCPDA,0)
|
|---|
| 47 | L -^PRCS(410,PRCPDA)
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | ;
|
|---|
| 51 | INIT ; build array
|
|---|
| 52 | K ^TMP($J,"PRCPWPLMPOST")
|
|---|
| 53 | D REBUILD^PRCPWPLB
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | ;
|
|---|
| 57 | HDR ; header
|
|---|
| 58 | N SPACE
|
|---|
| 59 | S SPACE=" "
|
|---|
| 60 | S VALMHDR(1)=$E("ISSUE BOOK: "_PRCPIBNM_" POST TO: "_$E($$INVNAME^PRCPUX1(PRCPPRIM),1,15)_" "_$S('$G(PRCPFPRI):"**NOT UPDATED DURING POSTING**",1:"")_SPACE,1,69)_$S($G(PRCPFINL):"** FINAL **",1:"")
|
|---|
| 61 | S VALMHDR(2)=$E(" REF#: "_$S($G(PRCPORD)="":"to be generated",1:PRCPORD)_SPACE,1,32)_"UNIT QTY ESTIMATE * * Q U A N T I T Y * *"
|
|---|
| 62 | S VALMHDR(3)="LINE DESCRIPTION IM# /IS ONHAND UNITCOST ORDERED REMAIN TO POST"
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | ;
|
|---|
| 66 | EXIT ; exit
|
|---|
| 67 | K ^TMP($J,"PRCPWPLM"),^TMP($J,"PRCPWPLMPOST"),^TMP($J,"PRCPWPLMLIST")
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | ;
|
|---|
| 71 | SELECTIB(FINAL) ; select issue book
|
|---|
| 72 | ; final=1 for screening out ib which are final
|
|---|
| 73 | N %,DIC,I,X,Y,Z
|
|---|
| 74 | S DIC="^PRCS(410,",DIC(0)="QEAMZ",DIC("A")="Select TRANSACTION NUMBER: "
|
|---|
| 75 | S DIC("S")="I $P(^(0),U,2)=""O"",$P(^(0),U,4)=5,$P($G(^(3)),U,4)=+PRCPPVNO,$P($G(^(7)),U,6)]"""","_$S($G(FINAL):"'$P($G(^(9)),U,3),",1:"")_"$S('$D(^PRC(443,+Y,0)):1,$P(^(0),U,3)]"""":1,1:0)"
|
|---|
| 76 | W ! D ^PRCSDIC
|
|---|
| 77 | Q +Y
|
|---|
