source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPBAL1.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1PRCPBAL1 ;WISC/RFJ-process barcode data ;04 Dec 92
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7EEITEMS ; called from protocol file to enter/edit invpt items
8 D FULL^VALM1
9 N PRC,PRCP
10 D ^PRCPEILM
11 D BUILD^PRCPBALB
12 S VALMBCK="R"
13 Q
14 ;
15 ;
16EDITQTY ; called from protocol file to edit quantities
17 D FULL^VALM1
18 N %,D0,DA,DI,DIC,DIE,DQ,DR,I,J,X,Y
19 S (DIC,DIE)="^PRCT(446.4,"_PRCTDA_",2,",DA(1)=PRCTDA,DA=PRCTDA1,DR=1
20 D ^DIE
21 D BUILD^PRCPBALB
22 S VALMBCK="R"
23 Q
24 ;
25 ;
26POST ; called from protocol file to post quantities
27 D FULL^VALM1
28 S VALMBCK="R"
29 N %,%H,%I,DA,DIC,DIK,INVPT,ITEMDA,QTY,RECORD,PRCPBALM
30 S XP="*** ARE YOU SURE ***",XP(1)="YOU WANT TO UPDATE ON HAND BALANCES IN BARCODED INVENTORY POINTS",XH="ENTER 'YES' TO UPDATE THE QUANTITIES IN THE INVENTORY POINTS."
31 W ! I $$YN^PRCPUYN(2)'=1 Q
32 ;
33 I $G(PRCPFSCA) D Q:%<1
34 . K X S X(1)="Some of the items to upload have been scanned more than once. You have the option to: 1) Upload the LAST SCAN of the item only; or 2) ADD THE QUANTITIES together for all scans of the item." D DISPLAY^PRCPUX2(5,75,.X)
35 . S XP="Do you want to ADD THE QUANTITIES TOGETHER",XH="Enter YES to add the quantities together,",XH(1)=" NO to only upload the last scan of the item, or ^ to exit."
36 . S %=$$YN^PRCPUYN(2) S PRCPFSCA=$S(%=1:1,1:0)
37 ;
38 S INVPT=0 F S INVPT=$O(^TMP($J,"PRCPBALMU",INVPT)) Q:'INVPT S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPBALMU",INVPT,ITEMDA)) Q:'ITEMDA D
39 . S RECORD=0,QTY=0 F S RECORD=$O(^TMP($J,"PRCPBALMU",INVPT,ITEMDA,RECORD)) Q:'RECORD S QTY=$S('$G(PRCPFSCA):^(RECORD),1:QTY+^(RECORD))
40 . K PRCPBALM
41 . S PRCPBALM("I")=INVPT,PRCPBALM("ITEM")=ITEMDA
42 . I PRCPTYPE="U" S PRCPBALM("QTY")=-QTY,PRCPBALM("COM")="Barcode Usage",PRCPBALM("TYP")="U"
43 . I PRCPTYPE="P" S PRCPBALM("QTY")=QTY-$P($G(^PRCP(445,INVPT,1,ITEMDA,0)),"^",7),PRCPBALM("COM")="Barcode Physical Count",PRCPBALM("TYP")="P"
44 . L +^PRCP(445,INVPT,1,ITEMDA,0)
45 . S %=$$UPDATE^PRCPUSA(.PRCPBALM)
46 . L -^PRCP(445,INVPT,1,ITEMDA,0)
47 . I %="" S RECORD=0 F S RECORD=$O(^TMP($J,"PRCPBALMU",INVPT,ITEMDA,RECORD)) Q:'RECORD S %=$G(^PRCT(446.4,PRCTDA,2,PRCTDA1,1,RECORD,0)) I %'="" S ^(0)="*"_%
48 ;
49 D NOW^%DTC S Y=% D DD^%DT S $P(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^",3)="FINISHED ON "_Y
50 K VALMBCK
51 ; ask to purge
52 K X S X(1)="NOTE: You should PURGE all barcode uploads that have been loaded. This will keep the database clean and prevent the barcode upload from being posted to the inventory points more than once."
53 D DISPLAY^PRCPUX2(5,75,.X)
54 S XP="Do you want to PURGE this upload entry",XH="Enter 'YES' to purge the entry, 'NO' or '^' to exit."
55 W ! S %=$$YN^PRCPUYN(1) I '% Q
56 I %=1 S DA(1)=PRCTDA,DA=PRCTDA1,DIK="^PRCT(446.4,"_PRCTDA_",2," D ^DIK
57 D AUTOGEN^PRCPBAL2
58 Q
Note: See TracBrowser for help on using the repository browser.