source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPBALM.m@ 1710

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1PRCPBALM ;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 ;
7PHYSICAL ; physical count
8 D UPDATE("P") Q
9 ;
10 ;
11USAGE ; usage
12 D UPDATE("U") Q
13 ;
14 ;
15UPDATE(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 ;
34HDR ; 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 ;
41EXIT ; 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 ;
46INIT ; build array
47 D BUILD^PRCPBALB
48 Q
Note: See TracBrowser for help on using the repository browser.