source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPWPL3.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1PRCPWPL3 ;WISC/RFJ-whse post issue book (post) ;13 Jan 94
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7POST ; post issue book
8 D FULL^VALM1
9 S VALMBCK="R"
10 I '$O(^TMP($J,"PRCPWPLMPOST",0)) S VALMSG="THERE ARE NO ITEMS TO POST" D Q
11 . W !!!!?5,$G(PRCP("RV1")),"WARNING: ",VALMSG,$G(PRCP("RV0")),!
12 . I $G(PRCPFINL) D FINAL^PRCPWPL5 K VALMBCK Q
13 . I $D(PRCPFINL) Q
14 . I $$FINALASK^PRCPWPL2=1 D FINAL^PRCPWPL5 K VALMBCK
15 ;
16 I $G(PRCPFERR) S VALMSG="ALL ERRORS MUST BE FIXED BEFORE POSTING" Q
17 ;
18 N %,CANTEEN,COSTCNTR,DRUGACCT,IBDATA,INVCOST,ITEMDA,ITEMDATA,LINEDA,PRCPFLAG,PRCPPORD,PRCPWORD,PRCPWPL3,QTYPOST,QUANTITY,TOTALINV,TOTALSAL,TOTCOST,TOTLINES,UNITCOST,X
19 N PRCPPBFY,PRCPPFCP,PRCPPSTA,PRCPWBFY,PRCPWFCP,PRCPWSTA
20 ; get whse and primary fcp data for fms code sheets
21 ; variables will be passed to prcpsfiv routine
22 D IVDATA^PRCPSFIU(PRCPDA,PRCPINPT)
23 ;
24 ; primary updated by whse posting
25 I PRCPFPRI D
26 . I $P($G(^PRCP(445,PRCPPRIM,0)),"^",20)="D" S X="PSAGIP" I $D(^%ZOSF("TEST")) X ^("TEST") I $T S DRUGACCT=1 K X S X(1)="NOTE: This is a DRUG ACCOUNTABILITY inventory point." D DISPLAY^PRCPUX2(1,79,.X)
27 ;
28RETRY ; come back to this label if reference voucher number not found
29 S XP="ARE YOU SURE YOU WANT TO POST THIS ISSUE BOOK"
30 W ! I $$YN^PRCPUYN(1)'=1 Q
31 ;
32 I '$$LOCK Q
33 ;
34 ; get reference number if it does not exist
35 I $G(PRCPORD)="" D I PRCPORD="" D UNLOCK G RETRY
36 . S PRCPORD=$$IBCNS^PRCPWPU1(PRC("SITE")_"-I"_$E(PRC("FY"),2))
37 . I PRCPORD="" Q
38 . S $P(^PRCS(410,PRCPDA,445),"^")=PRCPORD
39 ;
40 S PRCPWORD=$$ORDERNO^PRCPUTRX(PRCPINPT)
41 I PRCPFPRI S PRCPPORD=$$ORDERNO^PRCPUTRX(PRCPPRIM)
42 W !!?4,"REFERENCE VOUCHER NUMBER : ",PRCPORD
43 W !?4,"WHSE TRANSACTION REGISTER ID: R",PRCPWORD
44 I $P($G(^PRC(420,PRCPPSTA,1,PRCPPFCP,0)),"^",12)=4 S CANTEEN=1
45 D POST^PRCPWPL4
46 Q
47 ;
48 ;
49LOCK() ; lock whse and primary invpts
50 ; return 1 for success
51 L +^PRCP(445,PRCPINPT,1):5 I '$T D SHOWWHO^PRCPULOC(445,PRCPINPT_"-1",0) Q 0
52 I PRCPFPRI L +^PRCP(445,PRCPPRIM,1):5 I '$T D SHOWWHO^PRCPULOC(445,PRCPPRIM_"-1",0) L -^PRCP(445,PRCPINPT,1) Q 0
53 D ADD^PRCPULOC(445,PRCPINPT_"-1",0,"Post Issue Book")
54 I PRCPFPRI D ADD^PRCPULOC(445,PRCPPRIM_"-1",0,"Post Issue Book")
55 Q 1
56 ;
57 ;
58UNLOCK ; unlock whse and primary invpts
59 D CLEAR^PRCPULOC(445,PRCPINPT_"-1",0)
60 L -^PRCP(445,PRCPINPT,1)
61 I PRCPFPRI D CLEAR^PRCPULOC(445,PRCPPRIM_"-1",0) L -^PRCP(445,PRCPPRIM,1)
62 Q
Note: See TracBrowser for help on using the repository browser.