source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR9P22.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.3 KB
Line 
1RMPR9P22 ;PHX/HNC/RVD/SPS-CONT GUI PC PRINTER/FAX PURCHASE CARD ;4/27/2005
2 ;;3.0;PROSTHETICS;**90,119**;Feb 09, 1996;Build 4
3 ;S RO=0 F I=1:1 S RO=$O(R664(1,RO)) Q:RO'>0 D Q:$D(J1)
4 ;.;I I>4 S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
5 ;.;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
6 ;.;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)
7 ;.;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
8 S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
9 D ADD
10 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
11 ;I '$D(RMPRMOR)&(CNT<37) F S CNT=CNT+1,^TMP($J,"RMPRPRT",CNT)=" " Q:CNT>36
12 Q
13START S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
14 S ^TMP($J,"RMPRPRT",CNT+1)="#"_RO_"."
15 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))
16 S SPACE="",RMPRBDL=$P(R664(1,RO,0),U,2),RMPRBDL=$L(RMPRBDL),$P(SPACE," ",47)=""
17 S ^TMP($J,"RMPRPRT",CNT+1)=^TMP($J,"RMPRPRT",CNT+1)_$P(R664(1,RO,0),U,2)
18 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)
19 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)
20ZWE 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
21 S ^TMP($J,"RMPRPRT",CNT+3)=""
22 D EXT
23 Q
24EXT ;CHECKING FOR EXTENDED DESCRIPTION
25 ;serial number
26 S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
27 N RMPRSSM
28 S RMPRSSM(1)=$P($G(R664(1,RO,0)),U,15)
29 S RMPRSSM(2)=$P($G(R664(1,RO,2)),U,1)
30 S RMPRSSM(3)=$P($G(R664(1,RO,2)),U,2)
31 S RMPRSSM(4)=$P($G(R664(1,RO,2)),U,3)
32 I RMPRSSM(1)'="" S ^TMP($J,"RMPRPRT",CNT+1)=" Serial Number: "_RMPRSSM(1)
33 I RMPRSSM(4)'=""&($D(^TMP($J,"RMPRPRT",CNT+1))) S ^TMP($J,"RMPRPRT",CNT+1)=^TMP($J,"RMPRPRT",CNT+1)_" Lot #: "_RMPRSSM(4)
34 I RMPRSSM(4)'=""&('$D(^TMP($J,"RMPRPRT",CNT+1))) S ^TMP($J,"RMPRPRT",CNT+1)=" Lot #: "_RMPRSSM(4)
35 I RMPRSSM(3)'="" S ^TMP($J,"RMPRPRT",CNT+2)=" Model: "_RMPRSSM(3)
36 I RMPRSSM(2)'=""&($D(^TMP($J,"RMPRPRT",CNT+2))) S ^TMP($J,"RMPRPRT",CNT+2)=^TMP($J,"RMPRPRT",CNT+2)_" Make: "_RMPRSSM(2)
37 I RMPRSSM(2)'=""&('$D(^TMP($J,"RMPRPRT",CNT+2))) S ^TMP($J,"RMPRPRT",CNT+2)=" Make: "_RMPRSSM(2)
38 K RMPRSSM
39 ;
40 S RMPRCH=$G(R664(1,RO,1,0))
41 I RMPRCH="" Q
42 S RMPR90=0
43 S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
44 F S RMPR90=$O(R664(1,RO,1,RMPR90)) Q:RMPR90="" D
45 .D:$D(RMPRMOR)&(CNT>60) CONT
46 .;D:'$D(RMPRMOR)&(CNT>38) CONT
47 .S CNT=CNT+1
48 .S ^TMP($J,"RMPRPRT",CNT)=R664(1,RO,1,RMPR90,0)
49 Q
50WRI ;CONTINUATION OF 10-2421
51 W !,@RMPR90
52 Q
53CONT ;
54 D:'$D(RMPRMOR) CON
55 S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
56 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
57 Q
58ADD S (RMPRAMT2,RMPRAMT,RMPRAMT1,RMPRAMTN)=0
59 S RMSHI=$S($P(R664(0),U,11)'="":$P(R664(0),U,11),1:$P(R664(0),U,10))
60 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
61 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
62 Q
63ADD1 S RMPRAMT1=$J($P(R664(1,RC,0),U,4)*RMPRI,0,2) S RMPRAMT=RMPRAMT+RMPRAMT1 Q
64CON ;CONTINUATION OF 2421
65 S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
66 S ^TMP($J,"RMPRPRT",CNT+1)=RMPRB
67 S ^TMP($J,"RMPRPRT",CNT+2)="16. Contract Number: "
68 S RO("C")=$O(R664(1,0)),ROCL=$P($G(R664(1,RO("C"),0)),U,14)
69 I RO("C") S ^TMP($J,"RMPRPRT",CNT+2)=^TMP($J,"RMPRPRT",CNT+2)_$P(R664(1,RO("C"),0),U,14)
70 S SPACE="",ROCL=$L(ROCL),$P(SPACE," ",39-ROCL)=""
71 S RMPRAMTJ=$J($FN(RMPRAMT,"P",2),9)
72 S ^TMP($J,"RMPRPRT",CNT+2)=^TMP($J,"RMPRPRT",CNT+2)_SPACE_"Subtotal: $"_RMPRAMTJ
73 S ^TMP($J,"RMPRPRT",CNT+3)=" ACCT.#: "_RMPRVACN K RMPRVACN
74 S ^TMP($J,"RMPRPRT",CNT+3)=^TMP($J,"RMPRPRT",CNT+3)_" Discount: $"
75 I $D(RMPRAMT2) S RMAMT2J=$J($FN(RMPRAMT2,"P",2),7),^TMP($J,"RMPRPRT",CNT+3)=^TMP($J,"RMPRPRT",CNT+3)_RMAMT2J
76 S RMSHIJ=$J($FN(RMSHI,"P",2),5)
77 S ^TMP($J,"RMPRPRT",CNT+3)=^TMP($J,"RMPRPRT",CNT+3)_" Shipping: $"_RMSHIJ
78 S RMAMTNJ=$J($FN(RMPRAMTN,"P",2),9)
79 S ^TMP($J,"RMPRPRT",CNT+3)=^TMP($J,"RMPRPRT",CNT+3)_" Total: $"_RMAMTNJ
80 S ^TMP($J,"RMPRPRT",CNT+4)=RMPRB
81 S ^TMP($J,"RMPRPRT",CNT+5)="17. Signature of"
82 S ^TMP($J,"RMPRPRT",CNT+5)=^TMP($J,"RMPRPRT",CNT+5)_" 18. DATE 19. Signature and Title of 20. Date"
83 S ^TMP($J,"RMPRPRT",CNT+6)=" Requesting Official Contracting/Accountable Officer"
84 S ^TMP($J,"RMPRPRT",CNT+7)=" "_RDUZ_" "_RMPR("SIG")
85 S ^TMP($J,"RMPRPRT",CNT+8)=RMPRB
86 S ^TMP($J,"RMPRPRT",CNT+9)=" Order and Receipt Action"
87 S ^TMP($J,"RMPRPRT",CNT+10)=RMPRB
88 S ^TMP($J,"RMPRPRT",CNT+11)="21. Order Number 22. Exp Date 23. Date Item Received 24. Date Delivered"
89 I DUZ=$P(^RMPR(664,RMPRA,0),U,9)!($D(^XUSEC("RMPR FCP MANAGER",DUZ))) D
90 .N RMPRPRCD
91 .S RMPRPRCD=$$DEC^RMPR4LI($P(^RMPR(664,RMPRA,4),U,1),$P(^RMPR(664,RMPRA,0),U,9),RMPRA)
92 .S ^TMP($J,"RMPRPRT",CNT+12)=RMPRPRCD
93 E S ^TMP($J,"RMPRPRT",CNT+12)=" encrypted"
94 S ^TMP($J,"RMPRPRT",CNT+13)=RMPRB
95 S ^TMP($J,"RMPRPRT",CNT+14)="25. The articles or services listed herein have been received, or rendered"
96 S ^TMP($J,"RMPRPRT",CNT+15)="ordered in the quantity and quality specified originally or as shown by"
97 S ^TMP($J,"RMPRPRT",CNT+16)="authenticated changes, except as noted."
98 S ^TMP($J,"RMPRPRT",CNT+17)=""
99 S ^TMP($J,"RMPRPRT",CNT+18)=" Signature of Veteran or VA Official"
100 S ^TMP($J,"RMPRPRT",CNT+19)=RMPRB
101 S ^TMP($J,"RMPRPRT",CNT+20)=" Acct. Symbol "_$$STA^RMPRUTIL_"-"_$P($G(^RMPR(664,RMPRA,4)),U,5)
102 S ^TMP($J,"RMPRPRT",CNT+21)=RMPRB
103 S ^TMP($J,"RMPRPRT",CNT+22)=" ADP Form 10-2421PC APR 1991" S RMPRMOR1=1
104 Q
Note: See TracBrowser for help on using the repository browser.