PRCPBALM.m

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 ---PRCPBALM   1723     printed  Apr 23, 2025@18:27:33                                                                                                                                                                                                    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