| 1 | PRCPBALM ;WISC/RGY,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 | PHYSICAL ; physical count
|
|---|
| 8 | D UPDATE("P") Q
|
|---|
| 9 | ;
|
|---|
| 10 | ;
|
|---|
| 11 | USAGE ; usage
|
|---|
| 12 | D UPDATE("U") Q
|
|---|
| 13 | ;
|
|---|
| 14 | ;
|
|---|
| 15 | UPDATE(PRCPTYPE) ; update inventory count
|
|---|
| 16 | ; type P:physical counts, U:usage
|
|---|
| 17 | I PRCPTYPE'="P",PRCPTYPE'="U" Q
|
|---|
| 18 | I '$D(PRCTID)!'$D(PRCTTI)!'$O(^PRCT(446.4,PRCTID,2,PRCTTI,1,0)) Q
|
|---|
| 19 | N PRCPFSCA,PRCTDA,PRCTDA1,PRCTDATA,PRCTDAT1,Y
|
|---|
| 20 | S PRCTDA=+PRCTID,PRCTDA1=+PRCTTI
|
|---|
| 21 | S PRCTDATA=$G(^PRCT(446.4,PRCTDA,0)) I PRCTDATA="" Q
|
|---|
| 22 | S PRCTDAT1=$G(^PRCT(446.4,PRCTDA,2,PRCTDA1,0)) I PRCTDAT1="" Q
|
|---|
| 23 | I $E($G(^PRCT(446.4,PRCTDA,2,PRCTDA1,1,1,0)),1,2)'="ID" W !," Error: First record not an Identifier record." Q
|
|---|
| 24 | S Y=$P(PRCTDAT1,"^") D DD^%DT S $P(PRCTDAT1,"^")=Y
|
|---|
| 25 | S $P(PRCTDAT1,"^",2)=$$USER^PRCPUREP(+$P(PRCTDAT1,"^",2))
|
|---|
| 26 | L +^PRCT(446.4,PRCTDA,2,PRCTDA1):5 I '$T D SHOWWHO^PRCPULOC(446.4,PRCTDA_"-"_PRCTDA,0) Q
|
|---|
| 27 | D ADD^PRCPULOC(446.4,PRCTDA_"-"_PRCTDA1,0,"Upload Barcode Data")
|
|---|
| 28 | D EN^VALM("PRCP UPLOAD BARCODE DATA")
|
|---|
| 29 | D CLEAR^PRCPULOC(446.4,PRCTDA_"-"_PRCTDA1,0)
|
|---|
| 30 | L -^PRCT(446.4,PRCTDA,2,PRCTDA1)
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | ;
|
|---|
| 34 | HDR ; header
|
|---|
| 35 | S VALMHDR(1)="UPLOAD PROGRAM: "_$P(PRCTDATA,"^")
|
|---|
| 36 | S VALMHDR(2)=$E(" UPLOAD DATE: "_$P(PRCTDAT1,"^")_" USER: "_$P(PRCTDAT1,"^",2)_" ",1,66)_"* *QUANTITY* *"
|
|---|
| 37 | S VALMHDR(3)="LINE DESCRIPTION IM# NSN UNIT/IS ONHAND UPLOAD"
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | ;
|
|---|
| 41 | EXIT ; exit
|
|---|
| 42 | K ^TMP($J,"PRCPBALM"),^TMP($J,"PRCPBALMAG"),^TMP($J,"PRCPBALMD"),^TMP($J,"PRCPBALME"),^TMP($J,"PRCPBALMU"),^TMP($J,"PRCPBAL3")
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | ;
|
|---|
| 46 | INIT ; build array
|
|---|
| 47 | D BUILD^PRCPBALB
|
|---|
| 48 | Q
|
|---|
