PRCPBALM ;WISC/RGY,RFJ-process barcode data ;04 Dec 92
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
PHYSICAL ; physical count
D UPDATE("P") Q
;
;
USAGE ; usage
D UPDATE("U") Q
;
;
UPDATE(PRCPTYPE) ; update inventory count
; type P:physical counts, U:usage
I PRCPTYPE'="P",PRCPTYPE'="U" Q
I '$D(PRCTID)!'$D(PRCTTI)!'$O(^PRCT(446.4,PRCTID,2,PRCTTI,1,0)) Q
N PRCPFSCA,PRCTDA,PRCTDA1,PRCTDATA,PRCTDAT1,Y
S PRCTDA=+PRCTID,PRCTDA1=+PRCTTI
S PRCTDATA=$G(^PRCT(446.4,PRCTDA,0)) I PRCTDATA="" Q
S PRCTDAT1=$G(^PRCT(446.4,PRCTDA,2,PRCTDA1,0)) I PRCTDAT1="" Q
I $E($G(^PRCT(446.4,PRCTDA,2,PRCTDA1,1,1,0)),1,2)'="ID" W !," Error: First record not an Identifier record." Q
S Y=$P(PRCTDAT1,"^") D DD^%DT S $P(PRCTDAT1,"^")=Y
S $P(PRCTDAT1,"^",2)=$$USER^PRCPUREP(+$P(PRCTDAT1,"^",2))
L +^PRCT(446.4,PRCTDA,2,PRCTDA1):5 I '$T D SHOWWHO^PRCPULOC(446.4,PRCTDA_"-"_PRCTDA,0) Q
D ADD^PRCPULOC(446.4,PRCTDA_"-"_PRCTDA1,0,"Upload Barcode Data")
D EN^VALM("PRCP UPLOAD BARCODE DATA")
D CLEAR^PRCPULOC(446.4,PRCTDA_"-"_PRCTDA1,0)
L -^PRCT(446.4,PRCTDA,2,PRCTDA1)
Q
;
;
HDR ; header
S VALMHDR(1)="UPLOAD PROGRAM: "_$P(PRCTDATA,"^")
S VALMHDR(2)=$E(" UPLOAD DATE: "_$P(PRCTDAT1,"^")_" USER: "_$P(PRCTDAT1,"^",2)_" ",1,66)_"* *QUANTITY* *"
S VALMHDR(3)="LINE DESCRIPTION IM# NSN UNIT/IS ONHAND UPLOAD"
Q
;
;
EXIT ; exit
K ^TMP($J,"PRCPBALM"),^TMP($J,"PRCPBALMAG"),^TMP($J,"PRCPBALMD"),^TMP($J,"PRCPBALME"),^TMP($J,"PRCPBALMU"),^TMP($J,"PRCPBAL3")
Q
;
;
INIT ; build array
D BUILD^PRCPBALB
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPBALM 1723 printed Oct 16, 2024@18:13:47 Page 2
PRCPBALM ;WISC/RGY,RFJ-process barcode data ;04 Dec 92
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
PHYSICAL ; physical count
+1 DO UPDATE("P")
QUIT
+2 ;
+3 ;
USAGE ; usage
+1 DO UPDATE("U")
QUIT
+2 ;
+3 ;
UPDATE(PRCPTYPE) ; update inventory count
+1 ; type P:physical counts, U:usage
+2 IF PRCPTYPE'="P"
IF PRCPTYPE'="U"
QUIT
+3 IF '$DATA(PRCTID)!'$DATA(PRCTTI)!'$ORDER(^PRCT(446.4,PRCTID,2,PRCTTI,1,0))
QUIT
+4 NEW PRCPFSCA,PRCTDA,PRCTDA1,PRCTDATA,PRCTDAT1,Y
+5 SET PRCTDA=+PRCTID
SET PRCTDA1=+PRCTTI
+6 SET PRCTDATA=$GET(^PRCT(446.4,PRCTDA,0))
IF PRCTDATA=""
QUIT
+7 SET PRCTDAT1=$GET(^PRCT(446.4,PRCTDA,2,PRCTDA1,0))
IF PRCTDAT1=""
QUIT
+8 IF $EXTRACT($GET(^PRCT(446.4,PRCTDA,2,PRCTDA1,1,1,0)),1,2)'="ID"
WRITE !," Error: First record not an Identifier record."
QUIT
+9 SET Y=$PIECE(PRCTDAT1,"^")
DO DD^%DT
SET $PIECE(PRCTDAT1,"^")=Y
+10 SET $PIECE(PRCTDAT1,"^",2)=$$USER^PRCPUREP(+$PIECE(PRCTDAT1,"^",2))
+11 LOCK +^PRCT(446.4,PRCTDA,2,PRCTDA1):5
IF '$TEST
DO SHOWWHO^PRCPULOC(446.4,PRCTDA_"-"_PRCTDA,0)
QUIT
+12 DO ADD^PRCPULOC(446.4,PRCTDA_"-"_PRCTDA1,0,"Upload Barcode Data")
+13 DO EN^VALM("PRCP UPLOAD BARCODE DATA")
+14 DO CLEAR^PRCPULOC(446.4,PRCTDA_"-"_PRCTDA1,0)
+15 LOCK -^PRCT(446.4,PRCTDA,2,PRCTDA1)
+16 QUIT
+17 ;
+18 ;
HDR ; header
+1 SET VALMHDR(1)="UPLOAD PROGRAM: "_$PIECE(PRCTDATA,"^")
+2 SET VALMHDR(2)=$EXTRACT(" UPLOAD DATE: "_$PIECE(PRCTDAT1,"^")_" USER: "_$PIECE(PRCTDAT1,"^",2)_" ",1,66)_"* *QUANTITY* *"
+3 SET VALMHDR(3)="LINE DESCRIPTION IM# NSN UNIT/IS ONHAND UPLOAD"
+4 QUIT
+5 ;
+6 ;
EXIT ; exit
+1 KILL ^TMP($JOB,"PRCPBALM"),^TMP($JOB,"PRCPBALMAG"),^TMP($JOB,"PRCPBALMD"),^TMP($JOB,"PRCPBALME"),^TMP($JOB,"PRCPBALMU"),^TMP($JOB,"PRCPBAL3")
+2 QUIT
+3 ;
+4 ;
INIT ; build array
+1 DO BUILD^PRCPBALB
+2 QUIT
