PRCPSMA0.m

PRCPSMA0 ;WISC/RFJ-isms adjustment transaction                      ;27 Apr 92

 ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

 ;

ADJUST(INVPTDA,ITEMDA,QTY,VALUE,AVGCOST,BACKORD) ;adjustment transaction

 ;  invptda = inventory internal entry number

 ;  itemda  = item internal entry number

 ;  qty     = quantity adjustment

 ;  value   = value adjustment

 ;  avgcost = (optional) use this avgcost if defined

 ;  backord = set to null for version 4

 ;

 ;  if qty, no value or avgcost.

 ;  if value, use avgcost but no qty

 ;

 ;  returns 'string("at")' of code sheet

 ;

 N NSN,SKU

 S NSN=$TR($$NSN^PRCPUX1(ITEMDA),"-"),SKU=$$SKU^PRCPUX1(INVPTDA,ITEMDA) I SKU["?"!(NSN="") S STRING("AT")="" Q

 I VALUE S VALUE=$P(VALUE,".")_$P($J(VALUE,0,2),".",2)

 I VALUE,'AVGCOST S AVGCOST=+$P($G(^PRCP(445,+INVPTDA,1,+ITEMDA,0)),"^",22)

 I AVGCOST S AVGCOST=$P(AVGCOST,".")_$P($J(AVGCOST,0,2),".",2)

 S STRING("AT")="AT^"_NSN_"^"_SKU_"^"_QTY_"^"_VALUE_"^"_AVGCOST_"^"_BACKORD_"^|"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCPSMA0   1043     printed  Apr 23, 2025@18:30:21                                                                                                                                                                                                    Page 2

PRCPSMA0  ;WISC/RFJ-isms adjustment transaction                      ;27 Apr 92

 +1       ;;5.1;IFCAP;;Oct 20, 2000

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        QUIT 

 +4       ;

ADJUST(INVPTDA,ITEMDA,QTY,VALUE,AVGCOST,BACKORD) ;adjustment transaction

 +1       ;  invptda = inventory internal entry number

 +2       ;  itemda  = item internal entry number

 +3       ;  qty     = quantity adjustment

 +4       ;  value   = value adjustment

 +5       ;  avgcost = (optional) use this avgcost if defined

 +6       ;  backord = set to null for version 4

 +7       ;

 +8       ;  if qty, no value or avgcost.

 +9       ;  if value, use avgcost but no qty

 +10      ;

 +11      ;  returns 'string("at")' of code sheet

 +12      ;

 +13       NEW NSN,SKU

 +14       SET NSN=$TRANSLATE($$NSN^PRCPUX1(ITEMDA),"-")

           SET SKU=$$SKU^PRCPUX1(INVPTDA,ITEMDA)

           IF SKU["?"!(NSN="")

               SET STRING("AT")=""

               QUIT 

 +15       IF VALUE

               SET VALUE=$PIECE(VALUE,".")_$PIECE($JUSTIFY(VALUE,0,2),".",2)

 +16       IF VALUE

               IF 'AVGCOST

                   SET AVGCOST=+$PIECE($GET(^PRCP(445,+INVPTDA,1,+ITEMDA,0)),"^",22)

 +17       IF AVGCOST

               SET AVGCOST=$PIECE(AVGCOST,".")_$PIECE($JUSTIFY(AVGCOST,0,2),".",2)

 +18       SET STRING("AT")="AT^"_NSN_"^"_SKU_"^"_QTY_"^"_VALUE_"^"_AVGCOST_"^"_BACKORD_"^|"

 +19       QUIT