RMPR9P22 ;PHX/HNC/RVD/SPS-CONT GUI PC PRINTER/FAX PURCHASE CARD ;4/27/2005
;;3.0;PROSTHETICS;**90,119**;Feb 09, 1996;Build 4
;S RO=0 F I=1:1 S RO=$O(R664(1,RO)) Q:RO'>0 D Q:$D(J1)
;.;I I>4 S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
;.;I I>4 S J1=1 S ^TMP($J,"RMPRPRT",CNT+1)=" ",S ^TMP($J,"RMPRPRT",CNT+2)=" ***SEE ATTACHED CONTINUATION SHEET FOR ITEM DESCRIPTION(S)***",S ^TMP($J,"RMPRPRT",CNT+3)=" ",S ^TMP($J,"RMPRPRT",CNT+4)=" " Q
;.;I $D(R664(1,RO,1,0)) S RP=0 F J=1:1 S RP=$O(R664(1,RO,1,RP)) Q:RP="" D Q:$D(J1)
;.;I I>4!((J+I)>4) S J1=1 S ^TMP($J,"RMPRPRT",CNT+5)=" ",^TMP($J,"RMPRPRT",CNT+6)=" ",^TMP($J,"RMPRPRT",CNT+7)=" ***SEE ATTACHED CONTINUATION SHEET FOR ITEM DESCRIPTION(S)***",^TMP($J,"RMPRPRT",CNT+8)=" ",^TMP($J,"RMPRPRT",CNT+9)=" " Q
S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
D ADD
S RO=0 F S RO=$O(R664(1,RO)) Q:RO'>0 D:$D(RMPRMOR)&(CNT>58) CONT D:'$D(RMPRMOR) ADD D START
;I '$D(RMPRMOR)&(CNT<37) F S CNT=CNT+1,^TMP($J,"RMPRPRT",CNT)=" " Q:CNT>36
Q
START S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
S ^TMP($J,"RMPRPRT",CNT+1)="#"_RO_"."
S RMPRI=$S($P(R664(1,RO,0),U,7)'="":$P(R664(1,RO,0),U,7),1:$P(R664(1,RO,0),U,3))
S SPACE="",RMPRBDL=$P(R664(1,RO,0),U,2),RMPRBDL=$L(RMPRBDL),$P(SPACE," ",47)=""
S ^TMP($J,"RMPRPRT",CNT+1)=^TMP($J,"RMPRPRT",CNT+1)_$P(R664(1,RO,0),U,2)
S ^TMP($J,"RMPRPRT",CNT+2)=SPACE_$J($P(R664(1,RO,0),U,4),6) S RMPRUT=$P(R664(1,RO,0),U,5)
I $D(^PRCD(420.5,+RMPRUT,0)) S ^TMP($J,"RMPRPRT",CNT+2)=^TMP($J,"RMPRPRT",CNT+2)_" "_$P(^PRCD(420.5,+RMPRUT,0),U,1)_" "_$J($FN(RMPRI,"P",2),6)
ZWE S RMPRTOT=RMPRI*$P(R664(1,RO,0),U,4),RMPRTOTJ=$J($FN(RMPRTOT,"P",2),8) S ^TMP($J,"RMPRPRT",CNT+2)=^TMP($J,"RMPRPRT",CNT+2)_" "_RMPRTOTJ
S ^TMP($J,"RMPRPRT",CNT+3)=""
D EXT
Q
EXT ;CHECKING FOR EXTENDED DESCRIPTION
;serial number
S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
N RMPRSSM
S RMPRSSM(1)=$P($G(R664(1,RO,0)),U,15)
S RMPRSSM(2)=$P($G(R664(1,RO,2)),U,1)
S RMPRSSM(3)=$P($G(R664(1,RO,2)),U,2)
S RMPRSSM(4)=$P($G(R664(1,RO,2)),U,3)
I RMPRSSM(1)'="" S ^TMP($J,"RMPRPRT",CNT+1)=" Serial Number: "_RMPRSSM(1)
I RMPRSSM(4)'=""&($D(^TMP($J,"RMPRPRT",CNT+1))) S ^TMP($J,"RMPRPRT",CNT+1)=^TMP($J,"RMPRPRT",CNT+1)_" Lot #: "_RMPRSSM(4)
I RMPRSSM(4)'=""&('$D(^TMP($J,"RMPRPRT",CNT+1))) S ^TMP($J,"RMPRPRT",CNT+1)=" Lot #: "_RMPRSSM(4)
I RMPRSSM(3)'="" S ^TMP($J,"RMPRPRT",CNT+2)=" Model: "_RMPRSSM(3)
I RMPRSSM(2)'=""&($D(^TMP($J,"RMPRPRT",CNT+2))) S ^TMP($J,"RMPRPRT",CNT+2)=^TMP($J,"RMPRPRT",CNT+2)_" Make: "_RMPRSSM(2)
I RMPRSSM(2)'=""&('$D(^TMP($J,"RMPRPRT",CNT+2))) S ^TMP($J,"RMPRPRT",CNT+2)=" Make: "_RMPRSSM(2)
K RMPRSSM
;
S RMPRCH=$G(R664(1,RO,1,0))
I RMPRCH="" Q
S RMPR90=0
S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
F S RMPR90=$O(R664(1,RO,1,RMPR90)) Q:RMPR90="" D
.D:$D(RMPRMOR)&(CNT>60) CONT
.;D:'$D(RMPRMOR)&(CNT>38) CONT
.S CNT=CNT+1
.S ^TMP($J,"RMPRPRT",CNT)=R664(1,RO,1,RMPR90,0)
Q
WRI ;CONTINUATION OF 10-2421
W !,@RMPR90
Q
CONT ;
D:'$D(RMPRMOR) CON
S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
S ^TMP($J,"RMPRPRT",CNT+1)="CONTINUATION OF PURCHASE CARD ORDER NUMBER: "_$P($G(^RMPR(664,RMPRA,4)),U,5)_" PAGE "_RMPRPAGE S RMPRMOR=1,RMPRPAGE=RMPRPAGE+1 D HDR^RMPR9P21
Q
ADD S (RMPRAMT2,RMPRAMT,RMPRAMT1,RMPRAMTN)=0
S RMSHI=$S($P(R664(0),U,11)'="":$P(R664(0),U,11),1:$P(R664(0),U,10))
S RC=0 F S RC=$O(R664(1,RC)) Q:RC=""!(RC["B") S RMPRI=$S($P(R664(1,RC,0),U,7)'="":$P(R664(1,RC,0),U,7),1:$P(R664(1,RC,0),U,3)) D ADD1
I $D(R664(2)) S RMPRDISC=$S($P(R664(2),U,6)'="":$P(R664(2),U,6),1:"") I $D(RMPRDISC) S RMPRAMT2=$J(RMPRDISC*RMPRAMT/100,0,2),RMPRAMTN=RMPRAMT-$J(RMPRAMT2,0,2),RMPRAMTN=$J(RMPRAMTN+RMSHI,0,2) Q
Q
ADD1 S RMPRAMT1=$J($P(R664(1,RC,0),U,4)*RMPRI,0,2) S RMPRAMT=RMPRAMT+RMPRAMT1 Q
CON ;CONTINUATION OF 2421
S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
S ^TMP($J,"RMPRPRT",CNT+1)=RMPRB
S ^TMP($J,"RMPRPRT",CNT+2)="16. Contract Number: "
S RO("C")=$O(R664(1,0)),ROCL=$P($G(R664(1,RO("C"),0)),U,14)
I RO("C") S ^TMP($J,"RMPRPRT",CNT+2)=^TMP($J,"RMPRPRT",CNT+2)_$P(R664(1,RO("C"),0),U,14)
S SPACE="",ROCL=$L(ROCL),$P(SPACE," ",39-ROCL)=""
S RMPRAMTJ=$J($FN(RMPRAMT,"P",2),9)
S ^TMP($J,"RMPRPRT",CNT+2)=^TMP($J,"RMPRPRT",CNT+2)_SPACE_"Subtotal: $"_RMPRAMTJ
S ^TMP($J,"RMPRPRT",CNT+3)=" ACCT.#: "_RMPRVACN K RMPRVACN
S ^TMP($J,"RMPRPRT",CNT+3)=^TMP($J,"RMPRPRT",CNT+3)_" Discount: $"
I $D(RMPRAMT2) S RMAMT2J=$J($FN(RMPRAMT2,"P",2),7),^TMP($J,"RMPRPRT",CNT+3)=^TMP($J,"RMPRPRT",CNT+3)_RMAMT2J
S RMSHIJ=$J($FN(RMSHI,"P",2),5)
S ^TMP($J,"RMPRPRT",CNT+3)=^TMP($J,"RMPRPRT",CNT+3)_" Shipping: $"_RMSHIJ
S RMAMTNJ=$J($FN(RMPRAMTN,"P",2),9)
S ^TMP($J,"RMPRPRT",CNT+3)=^TMP($J,"RMPRPRT",CNT+3)_" Total: $"_RMAMTNJ
S ^TMP($J,"RMPRPRT",CNT+4)=RMPRB
S ^TMP($J,"RMPRPRT",CNT+5)="17. Signature of"
S ^TMP($J,"RMPRPRT",CNT+5)=^TMP($J,"RMPRPRT",CNT+5)_" 18. DATE 19. Signature and Title of 20. Date"
S ^TMP($J,"RMPRPRT",CNT+6)=" Requesting Official Contracting/Accountable Officer"
S ^TMP($J,"RMPRPRT",CNT+7)=" "_RDUZ_" "_RMPR("SIG")
S ^TMP($J,"RMPRPRT",CNT+8)=RMPRB
S ^TMP($J,"RMPRPRT",CNT+9)=" Order and Receipt Action"
S ^TMP($J,"RMPRPRT",CNT+10)=RMPRB
S ^TMP($J,"RMPRPRT",CNT+11)="21. Order Number 22. Exp Date 23. Date Item Received 24. Date Delivered"
I DUZ=$P(^RMPR(664,RMPRA,0),U,9)!($D(^XUSEC("RMPR FCP MANAGER",DUZ))) D
.N RMPRPRCD
.S RMPRPRCD=$$DEC^RMPR4LI($P(^RMPR(664,RMPRA,4),U,1),$P(^RMPR(664,RMPRA,0),U,9),RMPRA)
.S ^TMP($J,"RMPRPRT",CNT+12)=RMPRPRCD
E S ^TMP($J,"RMPRPRT",CNT+12)=" encrypted"
S ^TMP($J,"RMPRPRT",CNT+13)=RMPRB
S ^TMP($J,"RMPRPRT",CNT+14)="25. The articles or services listed herein have been received, or rendered"
S ^TMP($J,"RMPRPRT",CNT+15)="ordered in the quantity and quality specified originally or as shown by"
S ^TMP($J,"RMPRPRT",CNT+16)="authenticated changes, except as noted."
S ^TMP($J,"RMPRPRT",CNT+17)=""
S ^TMP($J,"RMPRPRT",CNT+18)=" Signature of Veteran or VA Official"
S ^TMP($J,"RMPRPRT",CNT+19)=RMPRB
S ^TMP($J,"RMPRPRT",CNT+20)=" Acct. Symbol "_$$STA^RMPRUTIL_"-"_$P($G(^RMPR(664,RMPRA,4)),U,5)
S ^TMP($J,"RMPRPRT",CNT+21)=RMPRB
S ^TMP($J,"RMPRPRT",CNT+22)=" ADP Form 10-2421PC APR 1991" S RMPRMOR1=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR9P22 6539 printed Dec 13, 2024@02:33:42 Page 2
RMPR9P22 ;PHX/HNC/RVD/SPS-CONT GUI PC PRINTER/FAX PURCHASE CARD ;4/27/2005
+1 ;;3.0;PROSTHETICS;**90,119**;Feb 09, 1996;Build 4
+2 ;S RO=0 F I=1:1 S RO=$O(R664(1,RO)) Q:RO'>0 D Q:$D(J1)
+3 ;.;I I>4 S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
+4 ;.;I I>4 S J1=1 S ^TMP($J,"RMPRPRT",CNT+1)=" ",S ^TMP($J,"RMPRPRT",CNT+2)=" ***SEE ATTACHED CONTINUATION SHEET FOR ITEM DESCRIPTION(S)***",S ^TMP($J,"RMPRPRT",CNT+3)=" ",S ^TMP($J,"RMPRPRT",CNT+4)=" " Q
+5 ;.;I $D(R664(1,RO,1,0)) S RP=0 F J=1:1 S RP=$O(R664(1,RO,1,RP)) Q:RP="" D Q:$D(J1)
+6 ;.;I I>4!((J+I)>4) S J1=1 S ^TMP($J,"RMPRPRT",CNT+5)=" ",^TMP($J,"RMPRPRT",CNT+6)=" ",^TMP($J,"RMPRPRT",CNT+7)=" ***SEE ATTACHED CONTINUATION SHEET FOR ITEM DESCRIPTION(S)***",^TMP($J,"RMPRPRT",CNT+8)=" ",^TMP($J,"RMPRPRT",CNT+9)=" " Q
+7 SET K=""
FOR
SET K=$ORDER(^TMP($JOB,"RMPRPRT",K))
if K=""
QUIT
SET CNT=K
+8 DO ADD
+9 SET RO=0
FOR
SET RO=$ORDER(R664(1,RO))
if RO'>0
QUIT
if $DATA(RMPRMOR)&(CNT>58)
DO CONT
if '$DATA(RMPRMOR)
DO ADD
DO START
+10 ;I '$D(RMPRMOR)&(CNT<37) F S CNT=CNT+1,^TMP($J,"RMPRPRT",CNT)=" " Q:CNT>36
+11 QUIT
START SET K=""
FOR
SET K=$ORDER(^TMP($JOB,"RMPRPRT",K))
if K=""
QUIT
SET CNT=K
+1 SET ^TMP($JOB,"RMPRPRT",CNT+1)="#"_RO_"."
+2 SET RMPRI=$SELECT($PIECE(R664(1,RO,0),U,7)'="":$PIECE(R664(1,RO,0),U,7),1:$PIECE(R664(1,RO,0),U,3))
+3 SET SPACE=""
SET RMPRBDL=$PIECE(R664(1,RO,0),U,2)
SET RMPRBDL=$LENGTH(RMPRBDL)
SET $PIECE(SPACE," ",47)=""
+4 SET ^TMP($JOB,"RMPRPRT",CNT+1)=^TMP($JOB,"RMPRPRT",CNT+1)_$PIECE(R664(1,RO,0),U,2)
+5 SET ^TMP($JOB,"RMPRPRT",CNT+2)=SPACE_$JUSTIFY($PIECE(R664(1,RO,0),U,4),6)
SET RMPRUT=$PIECE(R664(1,RO,0),U,5)
+6 IF $DATA(^PRCD(420.5,+RMPRUT,0))
SET ^TMP($JOB,"RMPRPRT",CNT+2)=^TMP($JOB,"RMPRPRT",CNT+2)_" "_$PIECE(^PRCD(420.5,+RMPRUT,0),U,1)_" "_$JUSTIFY($FNUMBER(RMPRI,"P",2),6)
ZWE SET RMPRTOT=RMPRI*$PIECE(R664(1,RO,0),U,4)
SET RMPRTOTJ=$JUSTIFY($FNUMBER(RMPRTOT,"P",2),8)
SET ^TMP($JOB,"RMPRPRT",CNT+2)=^TMP($JOB,"RMPRPRT",CNT+2)_" "_RMPRTOTJ
+1 SET ^TMP($JOB,"RMPRPRT",CNT+3)=""
+2 DO EXT
+3 QUIT
EXT ;CHECKING FOR EXTENDED DESCRIPTION
+1 ;serial number
+2 SET K=""
FOR
SET K=$ORDER(^TMP($JOB,"RMPRPRT",K))
if K=""
QUIT
SET CNT=K
+3 NEW RMPRSSM
+4 SET RMPRSSM(1)=$PIECE($GET(R664(1,RO,0)),U,15)
+5 SET RMPRSSM(2)=$PIECE($GET(R664(1,RO,2)),U,1)
+6 SET RMPRSSM(3)=$PIECE($GET(R664(1,RO,2)),U,2)
+7 SET RMPRSSM(4)=$PIECE($GET(R664(1,RO,2)),U,3)
+8 IF RMPRSSM(1)'=""
SET ^TMP($JOB,"RMPRPRT",CNT+1)=" Serial Number: "_RMPRSSM(1)
+9 IF RMPRSSM(4)'=""&($DATA(^TMP($JOB,"RMPRPRT",CNT+1)))
SET ^TMP($JOB,"RMPRPRT",CNT+1)=^TMP($JOB,"RMPRPRT",CNT+1)_" Lot #: "_RMPRSSM(4)
+10 IF RMPRSSM(4)'=""&('$DATA(^TMP($JOB,"RMPRPRT",CNT+1)))
SET ^TMP($JOB,"RMPRPRT",CNT+1)=" Lot #: "_RMPRSSM(4)
+11 IF RMPRSSM(3)'=""
SET ^TMP($JOB,"RMPRPRT",CNT+2)=" Model: "_RMPRSSM(3)
+12 IF RMPRSSM(2)'=""&($DATA(^TMP($JOB,"RMPRPRT",CNT+2)))
SET ^TMP($JOB,"RMPRPRT",CNT+2)=^TMP($JOB,"RMPRPRT",CNT+2)_" Make: "_RMPRSSM(2)
+13 IF RMPRSSM(2)'=""&('$DATA(^TMP($JOB,"RMPRPRT",CNT+2)))
SET ^TMP($JOB,"RMPRPRT",CNT+2)=" Make: "_RMPRSSM(2)
+14 KILL RMPRSSM
+15 ;
+16 SET RMPRCH=$GET(R664(1,RO,1,0))
+17 IF RMPRCH=""
QUIT
+18 SET RMPR90=0
+19 SET K=""
FOR
SET K=$ORDER(^TMP($JOB,"RMPRPRT",K))
if K=""
QUIT
SET CNT=K
+20 FOR
SET RMPR90=$ORDER(R664(1,RO,1,RMPR90))
if RMPR90=""
QUIT
Begin DoDot:1
+21 if $DATA(RMPRMOR)&(CNT>60)
DO CONT
+22 ;D:'$D(RMPRMOR)&(CNT>38) CONT
+23 SET CNT=CNT+1
+24 SET ^TMP($JOB,"RMPRPRT",CNT)=R664(1,RO,1,RMPR90,0)
End DoDot:1
+25 QUIT
WRI ;CONTINUATION OF 10-2421
+1 WRITE !,@RMPR90
+2 QUIT
CONT ;
+1 if '$DATA(RMPRMOR)
DO CON
+2 SET K=""
FOR
SET K=$ORDER(^TMP($JOB,"RMPRPRT",K))
if K=""
QUIT
SET CNT=K
+3 SET ^TMP($JOB,"RMPRPRT",CNT+1)="CONTINUATION OF PURCHASE CARD ORDER NUMBER: "_$PIECE($GET(^RMPR(664,RMPRA,4)),U,5)_" PAGE "_RMPRPAGE
SET RMPRMOR=1
SET RMPRPAGE=RMPRPAGE+1
DO HDR^RMPR9P21
+4 QUIT
ADD SET (RMPRAMT2,RMPRAMT,RMPRAMT1,RMPRAMTN)=0
+1 SET RMSHI=$SELECT($PIECE(R664(0),U,11)'="":$PIECE(R664(0),U,11),1:$PIECE(R664(0),U,10))
+2 SET RC=0
FOR
SET RC=$ORDER(R664(1,RC))
if RC=""!(RC["B")
QUIT
SET RMPRI=$SELECT($PIECE(R664(1,RC,0),U,7)'="":$PIECE(R664(1,RC,0),U,7),1:$PIECE(R664(1,RC,0),U,3))
DO ADD1
+3 IF $DATA(R664(2))
SET RMPRDISC=$SELECT($PIECE(R664(2),U,6)'="":$PIECE(R664(2),U,6),1:"")
IF $DATA(RMPRDISC)
SET RMPRAMT2=$JUSTIFY(RMPRDISC*RMPRAMT/100,0,2)
SET RMPRAMTN=RMPRAMT-$JUSTIFY(RMPRAMT2,0,2)
SET RMPRAMTN=$JUSTIFY(RMPRAMTN+RMSHI,0,2)
QUIT
+4 QUIT
ADD1 SET RMPRAMT1=$JUSTIFY($PIECE(R664(1,RC,0),U,4)*RMPRI,0,2)
SET RMPRAMT=RMPRAMT+RMPRAMT1
QUIT
CON ;CONTINUATION OF 2421
+1 SET K=""
FOR
SET K=$ORDER(^TMP($JOB,"RMPRPRT",K))
if K=""
QUIT
SET CNT=K
+2 SET ^TMP($JOB,"RMPRPRT",CNT+1)=RMPRB
+3 SET ^TMP($JOB,"RMPRPRT",CNT+2)="16. Contract Number: "
+4 SET RO("C")=$ORDER(R664(1,0))
SET ROCL=$PIECE($GET(R664(1,RO("C"),0)),U,14)
+5 IF RO("C")
SET ^TMP($JOB,"RMPRPRT",CNT+2)=^TMP($JOB,"RMPRPRT",CNT+2)_$PIECE(R664(1,RO("C"),0),U,14)
+6 SET SPACE=""
SET ROCL=$LENGTH(ROCL)
SET $PIECE(SPACE," ",39-ROCL)=""
+7 SET RMPRAMTJ=$JUSTIFY($FNUMBER(RMPRAMT,"P",2),9)
+8 SET ^TMP($JOB,"RMPRPRT",CNT+2)=^TMP($JOB,"RMPRPRT",CNT+2)_SPACE_"Subtotal: $"_RMPRAMTJ
+9 SET ^TMP($JOB,"RMPRPRT",CNT+3)=" ACCT.#: "_RMPRVACN
KILL RMPRVACN
+10 SET ^TMP($JOB,"RMPRPRT",CNT+3)=^TMP($JOB,"RMPRPRT",CNT+3)_" Discount: $"
+11 IF $DATA(RMPRAMT2)
SET RMAMT2J=$JUSTIFY($FNUMBER(RMPRAMT2,"P",2),7)
SET ^TMP($JOB,"RMPRPRT",CNT+3)=^TMP($JOB,"RMPRPRT",CNT+3)_RMAMT2J
+12 SET RMSHIJ=$JUSTIFY($FNUMBER(RMSHI,"P",2),5)
+13 SET ^TMP($JOB,"RMPRPRT",CNT+3)=^TMP($JOB,"RMPRPRT",CNT+3)_" Shipping: $"_RMSHIJ
+14 SET RMAMTNJ=$JUSTIFY($FNUMBER(RMPRAMTN,"P",2),9)
+15 SET ^TMP($JOB,"RMPRPRT",CNT+3)=^TMP($JOB,"RMPRPRT",CNT+3)_" Total: $"_RMAMTNJ
+16 SET ^TMP($JOB,"RMPRPRT",CNT+4)=RMPRB
+17 SET ^TMP($JOB,"RMPRPRT",CNT+5)="17. Signature of"
+18 SET ^TMP($JOB,"RMPRPRT",CNT+5)=^TMP($JOB,"RMPRPRT",CNT+5)_" 18. DATE 19. Signature and Title of 20. Date"
+19 SET ^TMP($JOB,"RMPRPRT",CNT+6)=" Requesting Official Contracting/Accountable Officer"
+20 SET ^TMP($JOB,"RMPRPRT",CNT+7)=" "_RDUZ_" "_RMPR("SIG")
+21 SET ^TMP($JOB,"RMPRPRT",CNT+8)=RMPRB
+22 SET ^TMP($JOB,"RMPRPRT",CNT+9)=" Order and Receipt Action"
+23 SET ^TMP($JOB,"RMPRPRT",CNT+10)=RMPRB
+24 SET ^TMP($JOB,"RMPRPRT",CNT+11)="21. Order Number 22. Exp Date 23. Date Item Received 24. Date Delivered"
+25 IF DUZ=$PIECE(^RMPR(664,RMPRA,0),U,9)!($DATA(^XUSEC("RMPR FCP MANAGER",DUZ)))
Begin DoDot:1
+26 NEW RMPRPRCD
+27 SET RMPRPRCD=$$DEC^RMPR4LI($PIECE(^RMPR(664,RMPRA,4),U,1),$PIECE(^RMPR(664,RMPRA,0),U,9),RMPRA)
+28 SET ^TMP($JOB,"RMPRPRT",CNT+12)=RMPRPRCD
End DoDot:1
+29 IF '$TEST
SET ^TMP($JOB,"RMPRPRT",CNT+12)=" encrypted"
+30 SET ^TMP($JOB,"RMPRPRT",CNT+13)=RMPRB
+31 SET ^TMP($JOB,"RMPRPRT",CNT+14)="25. The articles or services listed herein have been received, or rendered"
+32 SET ^TMP($JOB,"RMPRPRT",CNT+15)="ordered in the quantity and quality specified originally or as shown by"
+33 SET ^TMP($JOB,"RMPRPRT",CNT+16)="authenticated changes, except as noted."
+34 SET ^TMP($JOB,"RMPRPRT",CNT+17)=""
+35 SET ^TMP($JOB,"RMPRPRT",CNT+18)=" Signature of Veteran or VA Official"
+36 SET ^TMP($JOB,"RMPRPRT",CNT+19)=RMPRB
+37 SET ^TMP($JOB,"RMPRPRT",CNT+20)=" Acct. Symbol "_$$STA^RMPRUTIL_"-"_$P($GET(^RMPR(664,RMPRA,4)),U,5)
+38 SET ^TMP($JOB,"RMPRPRT",CNT+21)=RMPRB
+39 SET ^TMP($JOB,"RMPRPRT",CNT+22)=" ADP Form 10-2421PC APR 1991"
SET RMPRMOR1=1
+40 QUIT
