PRCPSMPI ;WISC/RFJ-issue code sheets to isms ;29 May 92
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
DQ(TRANNO,TRANID) ; create/trans issue code sheet to isms
; tranno=issue transaction number (full 5 pieces of '-')
; tranid=transaction register id
N COUNT,DATA,ISSUCOST,ITEMDA,NSN,QTY,TRANREG,UI,VALUSOLD,VOUCHER
;
; start gathering items posted
S COUNT=1 K ^TMP($J,"STRING")
S TRANREG=0 F S TRANREG=$O(^PRCP(445.2,"C",TRANNO,TRANREG)) Q:'TRANREG S DATA=$G(^PRCP(445.2,TRANREG,0)) I DATA'="",$P(DATA,"^",2)=TRANID D
. I '$D(VOUCHER) S VOUCHER=$P(DATA,"^",15)
. S ITEMDA=+$P(DATA,"^",5),NSN=$TR($$NSN^PRCPUX1(ITEMDA),"-"),UI=$P($P(DATA,"^",6),"/",2)
. S QTY=-$P(DATA,"^",7) I 'QTY Q
. S VALUSOLD=-$TR($J($P(DATA,"^",22),0,2),"."),ISSUCOST=-$TR($J($P(DATA,"^",23),0,4),".")
. S ^TMP($J,"STRING",COUNT)="IS^"_NSN_"^"_UI_"^"_QTY_"00^"_VALUSOLD_"^0^"_ISSUCOST_"^|",COUNT=COUNT+1
I COUNT=1 Q
;
; prcpwait used in routine prcpsmsi when retransmitting
; isms code sheets
I '$G(PRCPWAIT) D CODESHT^PRCPSMGO(PRC("SITE"),"ISS",VOUCHER)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPSMPI 1171 printed Nov 22, 2024@17:26:01 Page 2
PRCPSMPI ;WISC/RFJ-issue code sheets to isms ;29 May 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 ;
DQ(TRANNO,TRANID) ; create/trans issue code sheet to isms
+1 ; tranno=issue transaction number (full 5 pieces of '-')
+2 ; tranid=transaction register id
+3 NEW COUNT,DATA,ISSUCOST,ITEMDA,NSN,QTY,TRANREG,UI,VALUSOLD,VOUCHER
+4 ;
+5 ; start gathering items posted
+6 SET COUNT=1
KILL ^TMP($JOB,"STRING")
+7 SET TRANREG=0
FOR
SET TRANREG=$ORDER(^PRCP(445.2,"C",TRANNO,TRANREG))
if 'TRANREG
QUIT
SET DATA=$GET(^PRCP(445.2,TRANREG,0))
IF DATA'=""
IF $PIECE(DATA,"^",2)=TRANID
Begin DoDot:1
+8 IF '$DATA(VOUCHER)
SET VOUCHER=$PIECE(DATA,"^",15)
+9 SET ITEMDA=+$PIECE(DATA,"^",5)
SET NSN=$TRANSLATE($$NSN^PRCPUX1(ITEMDA),"-")
SET UI=$PIECE($PIECE(DATA,"^",6),"/",2)
+10 SET QTY=-$PIECE(DATA,"^",7)
IF 'QTY
QUIT
+11 SET VALUSOLD=-$TRANSLATE($JUSTIFY($PIECE(DATA,"^",22),0,2),".")
SET ISSUCOST=-$TRANSLATE($JUSTIFY($PIECE(DATA,"^",23),0,4),".")
+12 SET ^TMP($JOB,"STRING",COUNT)="IS^"_NSN_"^"_UI_"^"_QTY_"00^"_VALUSOLD_"^0^"_ISSUCOST_"^|"
SET COUNT=COUNT+1
End DoDot:1
+13 IF COUNT=1
QUIT
+14 ;
+15 ; prcpwait used in routine prcpsmsi when retransmitting
+16 ; isms code sheets
+17 IF '$GET(PRCPWAIT)
DO CODESHT^PRCPSMGO(PRC("SITE"),"ISS",VOUCHER)
+18 QUIT
