| [613] | 1 | PRCPBAL1 ;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 | ;
|
|---|
| 7 | EEITEMS ; 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 | ;
|
|---|
| 16 | EDITQTY ; 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 | ;
|
|---|
| 26 | POST ; 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
|
|---|
