source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRFO3.m@ 1764

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

initial load of FOIAVistA 6/30/08 version
File size: 5.6 KB
Line 
1RMPRFO3 ;PHX/HPL-PRINT FL 10-90 ADP LETTER ; 12/2/03 1:14pm
2 ;;3.0;PROSTHETICS;**82**;Feb 09, 1996
3 ;VARIABLES REQUIRED: DFN - DFN OF PATIENT ASSOCIATED WITH THE FL 10-90
4 ; RMPRFA - LETTER TYPE IN ENGLISH (e.g.: FL 10-90)
5 ; 07/21/2004 KAM Patch RMPR*3*82 - Remove Patient SSN from Letter
6VEN ;Enter the Vendor and items
7 I '$D(RMPR("SIG")) D DIV4^RMPRSIT Q:$D(X)
8 K DIC S DIC="^RMPR(665.4,",DIC(0)="L",X=DFN,DLAYGO=665.4
9 D FILE^DICN
10 S DA=+Y,ITM=DA,$P(^RMPR(665.4,DA,0),U,2)=RMPRFA
11 S $P(^RMPR(665.4,DA,0),U,4)=DUZ
12 S $P(^RMPR(665.4,DA,4),U,1)=RMPR("SIG"),$P(^(4),U,2)=RMPR("SBT")
13 S $P(^RMPR(665.4,DA,5),U,1)=DT
14 K DIK S DIK="^RMPR(665.4," D IX1^DIK
15 S ITMFLG=0
16 S DIE="^RMPR(665.4,",DR="[RMPR FL 10-90 ADP]"
17 D ^DIE,PRNT1,EXIT
18 Q
19EXIT ;KILL VARIABLES AND EXIT ROUTINE
20 K DIE,LP,LINES,LEN,LAPS,ITEM,HEADING,MORE,RMPRTMP1,RMPRTMP2
21 K RMPRLNG,RMPRADD,RMPRCIT
22 K DA,DIC,DIR,DR,ITM,ITMFLG,NAME,NOIT,RMPR1,RMPR2,RMPRDATE
23 K RMPRDEL,RMPRFA,RMPRIN,RMPRL,RMPRTY,RMPRU
24 Q
25PRNT1 ;
26 S %ZIS="MQ" D ^%ZIS G:POP EXIT
27 K IOP I $E(IOST,1,2)["C-" G ENT
28 I $D(IO("Q")) D G EXIT
29 .S ZTSAVE("DA")="",ZTSAVE("DFN")="",ZTSAVE("RMPR(")=""
30 .S ZTSAVE("DATE(")="",ZTSAVE("RMPRSITE")=""
31 .S ZTIO=ION,ZTRTN="ENT^RMPRFO3",ZTDESC="PRINT PROSTHETICS FL 10-90"
32 .D ^%ZTLOAD K ZTDESC,ZTIO,ZTRTN,ZTSAVE
33 ;
34ENT ;ENTRY POINT FOR ACTUAL PRINTING
35 ;If DA is not set then a skeleton ADP FL 10-90 letter is being printed.
36 I $G(DA)>0&('$D(RMPR)) D DIV4^RMPRSIT Q:$D(X)
37ENTR ;
38 U IO
39 S MORE=0,HEADING="REQUEST FOR QUOTATION"
40 W !!,?IOM-$L(HEADING)\2,HEADING
41 S HEADING="Date: "_$$FMTE^XLFDT(DT,"D")
42 W !,?IOM-$L(HEADING)\2,HEADING
43 W !!,?5,"TO: "
44 I $G(DA)>0 I $D(^RMPR(665.4,DA,2)) W:($P(^RMPR(665.4,DA,2),U,1)'="") $P(^PRC(440,$P(^RMPR(665.4,DA,2),U,1),0),U,1)
45 S RMPRCIT=RMPR("CITY")
46 S RMPRADD=$L(RMPR("ADD"))
47 S RMPRLNG=$S(RMPRCIT>RMPRADD:RMPRCIT,1:RMPRADD)
48 S RMPRLNG=$S(RMPRLNG>$L(RMPR("ADD")):RMPRLNG,1:$L(RMPR("ADD")))
49 S RMPRLNG=$S(RMPRLNG>$L(RMPR("NAME")):RMPRLNG,1:$L(RMPR("NAME")))
50 W ?IOM-5-RMPRLNG-6,"FROM: Prosthetics Service" ;,RMPR("NAME")
51 I $G(DA)>0 I $D(^RMPR(665.4,DA,2)) S:($P(^RMPR(665.4,DA,2),U,1)'="") RMPRTMP1=$P(^RMPR(665.4,DA,2),U,1),RMPRTMP2=^PRC(440,RMPRTMP1,0)
52 I $G(DA)'>0 S RMPRTMP2="^^^^^^^^^"
53 I $G(DA)>0 I '$D(^RMPR(665.4,DA,2)) S RMPRTMP2="^^^^^^^^^"
54 S:$P(RMPRTMP2,U,7)'="" $P(RMPRTMP2,U,7)=$P(^DIC(5,$P(RMPRTMP2,U,7),0),U,1)
55 W !,?9,$S($P(RMPRTMP2,U,2)'="":$P(RMPRTMP2,U,2),$P(RMPRTMP2,U,6)'=""&($P(RMPRTMP2,U,7)'=""):$P(RMPRTMP2,U,6)_", "_$P(RMPRTMP2,U,7)_" "_$P(RMPRTMP2,U,8),1:"")
56 W ?IOM-5-RMPRLNG,RMPR("NAME") ;"Prosthetics Service"
57 W !,?9,$S($P(RMPRTMP2,U,2)'=""&($P(RMPRTMP2,U,3)'=""):$P(RMPRTMP2,U,3),$P(RMPRTMP2,U,6)'="":$P(RMPRTMP2,U,6)_", "_$P(RMPRTMP2,U,7)_" "_$P(RMPRTMP2,U,8),1:"") W ?IOM-5-RMPRLNG,RMPR("ADD")
58 I $P(RMPRTMP2,U,2)="",$P(RMPRTMP2,U,3)="",$P(RMPRTMP2,U,4)="" W !,?IOM-5-RMPRLNG,RMPR("CITY") G DNE
59 I $P(RMPRTMP2,U,2)'=""&($P(RMPRTMP2,U,3)'="") D
60 .I $P(RMPRTMP2,U,4)'="" W !,?9,$P(RMPRTMP2,U,4),?IOM-5-RMPRLNG,RMPR("CITY") S RDN=1
61 I $P(RMPRTMP2,U,2)'=""&($P(RMPRTMP2,U,3)'="")&(($P(RMPRTMP2,U,4)'="")&($P(RMPRTMP2,U,5)'="")) D
62 .W !,?9,$P(RMPRTMP2,U,5)
63 .I $G(RDN)<1 W ?IOM-5-RMPRLNG,RMPR("CITY") S RDN=1
64 I $P(RMPRTMP2,U,2)'=""&($P(RMPRTMP2,U,3)'="") W:$P(RMPRTMP2,U,6)'=""&($P(RMPRTMP2,U,7)'="") !,?9,$P(RMPRTMP2,U,6)_", "_$P(RMPRTMP2,U,7)_" "_$P(RMPRTMP2,U,8) I $G(RDN)<1 W ?IOM-5-RMPRLNG,RMPR("CITY") S RDN=1
65 I $G(RDN)<1 W !,?IOM-5-RMPRLNG,RMPR("CITY")
66DNE K RDN S NAME=" ",SSN=" "
67 ;Vendor phone on ADP FL 10-90
68 W !!
69 I $G(DA)'>0 S NAME=" "
70DNE1 W ?9,"Vendor Phone #: "
71 I $D(DA),$G(^RMPR(665.4,DA,2)) W $P(^PRC(440,$P(^RMPR(665.4,DA,2),U,1),0),U,10)
72 I $G(DA)>0 S NAME=$P(^DPT($P(^RMPR(665.4,DA,0),U,1),0),U,1)
73 ; *82 removed patient SSN from next line
74 W ?IOM-5-$L(NAME)-9,"Veteran: ",NAME,!
75 W !!,?5,"Your firm is being considered for the following:"
76 S LINES=0,ITM=0,LEN=0
77 F Q:$G(DA)'>0 S ITM=$O(^RMPR(665.4,DA,3,ITM)) Q:ITM'>0!(LINES=5) D:LINES<5
78 .I LEN=0 W !,?6," " S LINES=LINES+1
79 .I LEN>0,LEN+$L($P(^RMPR(665.4,DA,3,ITM,0),U,1))<71 W ", "
80 .I LEN>0,LEN+$L($P(^RMPR(665.4,DA,3,ITM,0),U,1))>70 S LEN=0 W !,?6," " S LINES=LINES+1
81 .W:LINES<5 ^RMPR(665.4,DA,3,ITM,0)
82 .S LEN=LEN+2+$L($P(^RMPR(665.4,DA,3,ITM,0),U,1))
83 .I LINES>4&(ITM>0) S MORE=1,ITEM=ITM Q
84 W !!,?5,"An estimate on the above-listed item(s) is requested. "
85 W "YOUR QUOTATION "
86 W !,?5,"DOES NOT CONSTITUTE A PURCHASE ORDER."
87 W " Upon completion of the esti-"
88 W !,?5,"mate, return the original to the Veterans Affairs facility indicated"
89 W !,?5,"above and retain a copy for your files."
90 W !!,?5,"If approved, a purchase order will be prepared and forwarded to you."
91 W !!,?5,"Sincerely,"
92 I $Y+2>IOST,$E(IOST,1,2)["C-" W !! S DIR(0)="E" D ^DIR S:+Y'>0 FL=1 Q:Y'>0 W @IOF
93 W !!!!,?5,RMPR("SIG"),!,?5,RMPR("SBT")
94EST ;PRINT VENDOR'S ESTIMATE SECTION OF FL 10-90
95 S LINES=0,HEADING="VENDOR'S ESTIMATE" W !!,?IOM-$L(HEADING)\2,HEADING
96 S HEADING="(To be completed by Vendor)" W !,?IOM-$L(HEADING)\2,HEADING
97 W !,?5,$$REPEAT^XLFSTR("-",70)
98 W !,?5,"|",?12,"Article or Service"
99 W ?37,"|Quantity| Unit |Unit Cost|Total Cost|"
100 W !,?5,$$REPEAT^XLFSTR("-",70)
101 S LAPS=$Y
102 F LP=LAPS:1:47 W !,?5,"|",?37,"|",?46,"|",?53,"|",?63,"|",?74,"|" I $Y>20&($E(IOST,1,2)["C-") K DIR S DIR(0)="E" D ^DIR G:(X="^")!($D(DTOUT)) QWIT W @IOF
103 W !,?5,$$REPEAT^XLFSTR("-",70)
104 W !,?5,"| Vendor:",?42,"Contract number (if applicable) |"
105 W !,?5,"| Address:",?74,"|"
106 W !,?5,"| City:",?74,"|",!,?5,"| State:",?26,"Zip:",?74,"|"
107 W !,?5,"| Telephone:",?74,"|",!,?5,"| Date:",?37,"Signature & Title of Company Official|"
108 W !,?5,"| Note:List Terms/Discounts if Applicable",?74,"|"
109 W !,?5,$$REPEAT^XLFSTR("-",70)
110 W !,?59,"FL 10-90 ADP"
111 I $E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR
112 W @IOF D:$G(MORE)=1 MORE^RMPRFO6,EST D EXIT,^%ZISC
113QWIT Q
Note: See TracBrowser for help on using the repository browser.