RMPRFO3 ;PHX/HPL-PRINT FL 10-90 ADP LETTER ; 12/2/03 1:14pm
;;3.0;PROSTHETICS;**82**;Feb 09, 1996
;VARIABLES REQUIRED: DFN - DFN OF PATIENT ASSOCIATED WITH THE FL 10-90
; RMPRFA - LETTER TYPE IN ENGLISH (e.g.: FL 10-90)
; 07/21/2004 KAM Patch RMPR*3*82 - Remove Patient SSN from Letter
VEN ;Enter the Vendor and items
I '$D(RMPR("SIG")) D DIV4^RMPRSIT Q:$D(X)
K DIC S DIC="^RMPR(665.4,",DIC(0)="L",X=DFN,DLAYGO=665.4
D FILE^DICN
S DA=+Y,ITM=DA,$P(^RMPR(665.4,DA,0),U,2)=RMPRFA
S $P(^RMPR(665.4,DA,0),U,4)=DUZ
S $P(^RMPR(665.4,DA,4),U,1)=RMPR("SIG"),$P(^(4),U,2)=RMPR("SBT")
S $P(^RMPR(665.4,DA,5),U,1)=DT
K DIK S DIK="^RMPR(665.4," D IX1^DIK
S ITMFLG=0
S DIE="^RMPR(665.4,",DR="[RMPR FL 10-90 ADP]"
D ^DIE,PRNT1,EXIT
Q
EXIT ;KILL VARIABLES AND EXIT ROUTINE
K DIE,LP,LINES,LEN,LAPS,ITEM,HEADING,MORE,RMPRTMP1,RMPRTMP2
K RMPRLNG,RMPRADD,RMPRCIT
K DA,DIC,DIR,DR,ITM,ITMFLG,NAME,NOIT,RMPR1,RMPR2,RMPRDATE
K RMPRDEL,RMPRFA,RMPRIN,RMPRL,RMPRTY,RMPRU
Q
PRNT1 ;
S %ZIS="MQ" D ^%ZIS G:POP EXIT
K IOP I $E(IOST,1,2)["C-" G ENT
I $D(IO("Q")) D G EXIT
.S ZTSAVE("DA")="",ZTSAVE("DFN")="",ZTSAVE("RMPR(")=""
.S ZTSAVE("DATE(")="",ZTSAVE("RMPRSITE")=""
.S ZTIO=ION,ZTRTN="ENT^RMPRFO3",ZTDESC="PRINT PROSTHETICS FL 10-90"
.D ^%ZTLOAD K ZTDESC,ZTIO,ZTRTN,ZTSAVE
;
ENT ;ENTRY POINT FOR ACTUAL PRINTING
;If DA is not set then a skeleton ADP FL 10-90 letter is being printed.
I $G(DA)>0&('$D(RMPR)) D DIV4^RMPRSIT Q:$D(X)
ENTR ;
U IO
S MORE=0,HEADING="REQUEST FOR QUOTATION"
W !!,?IOM-$L(HEADING)\2,HEADING
S HEADING="Date: "_$$FMTE^XLFDT(DT,"D")
W !,?IOM-$L(HEADING)\2,HEADING
W !!,?5,"TO: "
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)
S RMPRCIT=RMPR("CITY")
S RMPRADD=$L(RMPR("ADD"))
S RMPRLNG=$S(RMPRCIT>RMPRADD:RMPRCIT,1:RMPRADD)
S RMPRLNG=$S(RMPRLNG>$L(RMPR("ADD")):RMPRLNG,1:$L(RMPR("ADD")))
S RMPRLNG=$S(RMPRLNG>$L(RMPR("NAME")):RMPRLNG,1:$L(RMPR("NAME")))
W ?IOM-5-RMPRLNG-6,"FROM: Prosthetics Service" ;,RMPR("NAME")
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)
I $G(DA)'>0 S RMPRTMP2="^^^^^^^^^"
I $G(DA)>0 I '$D(^RMPR(665.4,DA,2)) S RMPRTMP2="^^^^^^^^^"
S:$P(RMPRTMP2,U,7)'="" $P(RMPRTMP2,U,7)=$P(^DIC(5,$P(RMPRTMP2,U,7),0),U,1)
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:"")
W ?IOM-5-RMPRLNG,RMPR("NAME") ;"Prosthetics Service"
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")
I $P(RMPRTMP2,U,2)="",$P(RMPRTMP2,U,3)="",$P(RMPRTMP2,U,4)="" W !,?IOM-5-RMPRLNG,RMPR("CITY") G DNE
I $P(RMPRTMP2,U,2)'=""&($P(RMPRTMP2,U,3)'="") D
.I $P(RMPRTMP2,U,4)'="" W !,?9,$P(RMPRTMP2,U,4),?IOM-5-RMPRLNG,RMPR("CITY") S RDN=1
I $P(RMPRTMP2,U,2)'=""&($P(RMPRTMP2,U,3)'="")&(($P(RMPRTMP2,U,4)'="")&($P(RMPRTMP2,U,5)'="")) D
.W !,?9,$P(RMPRTMP2,U,5)
.I $G(RDN)<1 W ?IOM-5-RMPRLNG,RMPR("CITY") S RDN=1
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
I $G(RDN)<1 W !,?IOM-5-RMPRLNG,RMPR("CITY")
DNE K RDN S NAME=" ",SSN=" "
;Vendor phone on ADP FL 10-90
W !!
I $G(DA)'>0 S NAME=" "
DNE1 W ?9,"Vendor Phone #: "
I $D(DA),$G(^RMPR(665.4,DA,2)) W $P(^PRC(440,$P(^RMPR(665.4,DA,2),U,1),0),U,10)
I $G(DA)>0 S NAME=$P(^DPT($P(^RMPR(665.4,DA,0),U,1),0),U,1)
; *82 removed patient SSN from next line
W ?IOM-5-$L(NAME)-9,"Veteran: ",NAME,!
W !!,?5,"Your firm is being considered for the following:"
S LINES=0,ITM=0,LEN=0
F Q:$G(DA)'>0 S ITM=$O(^RMPR(665.4,DA,3,ITM)) Q:ITM'>0!(LINES=5) D:LINES<5
.I LEN=0 W !,?6," " S LINES=LINES+1
.I LEN>0,LEN+$L($P(^RMPR(665.4,DA,3,ITM,0),U,1))<71 W ", "
.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
.W:LINES<5 ^RMPR(665.4,DA,3,ITM,0)
.S LEN=LEN+2+$L($P(^RMPR(665.4,DA,3,ITM,0),U,1))
.I LINES>4&(ITM>0) S MORE=1,ITEM=ITM Q
W !!,?5,"An estimate on the above-listed item(s) is requested. "
W "YOUR QUOTATION "
W !,?5,"DOES NOT CONSTITUTE A PURCHASE ORDER."
W " Upon completion of the esti-"
W !,?5,"mate, return the original to the Veterans Affairs facility indicated"
W !,?5,"above and retain a copy for your files."
W !!,?5,"If approved, a purchase order will be prepared and forwarded to you."
W !!,?5,"Sincerely,"
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
W !!!!,?5,RMPR("SIG"),!,?5,RMPR("SBT")
EST ;PRINT VENDOR'S ESTIMATE SECTION OF FL 10-90
S LINES=0,HEADING="VENDOR'S ESTIMATE" W !!,?IOM-$L(HEADING)\2,HEADING
S HEADING="(To be completed by Vendor)" W !,?IOM-$L(HEADING)\2,HEADING
W !,?5,$$REPEAT^XLFSTR("-",70)
W !,?5,"|",?12,"Article or Service"
W ?37,"|Quantity| Unit |Unit Cost|Total Cost|"
W !,?5,$$REPEAT^XLFSTR("-",70)
S LAPS=$Y
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
W !,?5,$$REPEAT^XLFSTR("-",70)
W !,?5,"| Vendor:",?42,"Contract number (if applicable) |"
W !,?5,"| Address:",?74,"|"
W !,?5,"| City:",?74,"|",!,?5,"| State:",?26,"Zip:",?74,"|"
W !,?5,"| Telephone:",?74,"|",!,?5,"| Date:",?37,"Signature & Title of Company Official|"
W !,?5,"| Note:List Terms/Discounts if Applicable",?74,"|"
W !,?5,$$REPEAT^XLFSTR("-",70)
W !,?59,"FL 10-90 ADP"
I $E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR
W @IOF D:$G(MORE)=1 MORE^RMPRFO6,EST D EXIT,^%ZISC
QWIT Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRFO3 5890 printed Dec 13, 2024@02:34:45 Page 2
RMPRFO3 ;PHX/HPL-PRINT FL 10-90 ADP LETTER ; 12/2/03 1:14pm
+1 ;;3.0;PROSTHETICS;**82**;Feb 09, 1996
+2 ;VARIABLES REQUIRED: DFN - DFN OF PATIENT ASSOCIATED WITH THE FL 10-90
+3 ; RMPRFA - LETTER TYPE IN ENGLISH (e.g.: FL 10-90)
+4 ; 07/21/2004 KAM Patch RMPR*3*82 - Remove Patient SSN from Letter
VEN ;Enter the Vendor and items
+1 IF '$DATA(RMPR("SIG"))
DO DIV4^RMPRSIT
if $DATA(X)
QUIT
+2 KILL DIC
SET DIC="^RMPR(665.4,"
SET DIC(0)="L"
SET X=DFN
SET DLAYGO=665.4
+3 DO FILE^DICN
+4 SET DA=+Y
SET ITM=DA
SET $PIECE(^RMPR(665.4,DA,0),U,2)=RMPRFA
+5 SET $PIECE(^RMPR(665.4,DA,0),U,4)=DUZ
+6 SET $PIECE(^RMPR(665.4,DA,4),U,1)=RMPR("SIG")
SET $PIECE(^(4),U,2)=RMPR("SBT")
+7 SET $PIECE(^RMPR(665.4,DA,5),U,1)=DT
+8 KILL DIK
SET DIK="^RMPR(665.4,"
DO IX1^DIK
+9 SET ITMFLG=0
+10 SET DIE="^RMPR(665.4,"
SET DR="[RMPR FL 10-90 ADP]"
+11 DO ^DIE
DO PRNT1
DO EXIT
+12 QUIT
EXIT ;KILL VARIABLES AND EXIT ROUTINE
+1 KILL DIE,LP,LINES,LEN,LAPS,ITEM,HEADING,MORE,RMPRTMP1,RMPRTMP2
+2 KILL RMPRLNG,RMPRADD,RMPRCIT
+3 KILL DA,DIC,DIR,DR,ITM,ITMFLG,NAME,NOIT,RMPR1,RMPR2,RMPRDATE
+4 KILL RMPRDEL,RMPRFA,RMPRIN,RMPRL,RMPRTY,RMPRU
+5 QUIT
PRNT1 ;
+1 SET %ZIS="MQ"
DO ^%ZIS
if POP
GOTO EXIT
+2 KILL IOP
IF $EXTRACT(IOST,1,2)["C-"
GOTO ENT
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 SET ZTSAVE("DA")=""
SET ZTSAVE("DFN")=""
SET ZTSAVE("RMPR(")=""
+5 SET ZTSAVE("DATE(")=""
SET ZTSAVE("RMPRSITE")=""
+6 SET ZTIO=ION
SET ZTRTN="ENT^RMPRFO3"
SET ZTDESC="PRINT PROSTHETICS FL 10-90"
+7 DO ^%ZTLOAD
KILL ZTDESC,ZTIO,ZTRTN,ZTSAVE
End DoDot:1
GOTO EXIT
+8 ;
ENT ;ENTRY POINT FOR ACTUAL PRINTING
+1 ;If DA is not set then a skeleton ADP FL 10-90 letter is being printed.
+2 IF $GET(DA)>0&('$DATA(RMPR))
DO DIV4^RMPRSIT
if $DATA(X)
QUIT
ENTR ;
+1 USE IO
+2 SET MORE=0
SET HEADING="REQUEST FOR QUOTATION"
+3 WRITE !!,?IOM-$LENGTH(HEADING)\2,HEADING
+4 SET HEADING="Date: "_$$FMTE^XLFDT(DT,"D")
+5 WRITE !,?IOM-$LENGTH(HEADING)\2,HEADING
+6 WRITE !!,?5,"TO: "
+7 IF $GET(DA)>0
IF $DATA(^RMPR(665.4,DA,2))
if ($PIECE(^RMPR(665.4,DA,2),U,1)'="")
WRITE $PIECE(^PRC(440,$PIECE(^RMPR(665.4,DA,2),U,1),0),U,1)
+8 SET RMPRCIT=RMPR("CITY")
+9 SET RMPRADD=$LENGTH(RMPR("ADD"))
+10 SET RMPRLNG=$SELECT(RMPRCIT>RMPRADD:RMPRCIT,1:RMPRADD)
+11 SET RMPRLNG=$SELECT(RMPRLNG>$LENGTH(RMPR("ADD")):RMPRLNG,1:$LENGTH(RMPR("ADD")))
+12 SET RMPRLNG=$SELECT(RMPRLNG>$LENGTH(RMPR("NAME")):RMPRLNG,1:$LENGTH(RMPR("NAME")))
+13 ;,RMPR("NAME")
WRITE ?IOM-5-RMPRLNG-6,"FROM: Prosthetics Service"
+14 IF $GET(DA)>0
IF $DATA(^RMPR(665.4,DA,2))
if ($PIECE(^RMPR(665.4,DA,2),U,1)'="")
SET RMPRTMP1=$PIECE(^RMPR(665.4,DA,2),U,1)
SET RMPRTMP2=^PRC(440,RMPRTMP1,0)
+15 IF $GET(DA)'>0
SET RMPRTMP2="^^^^^^^^^"
+16 IF $GET(DA)>0
IF '$DATA(^RMPR(665.4,DA,2))
SET RMPRTMP2="^^^^^^^^^"
+17 if $PIECE(RMPRTMP2,U,7)'=""
SET $PIECE(RMPRTMP2,U,7)=$PIECE(^DIC(5,$PIECE(RMPRTMP2,U,7),0),U,1)
+18 WRITE !,?9,$SELECT($PIECE(RMPRTMP2,U,2)'="":$PIECE(RMPRTMP2,U,2),$PIECE(RMPRTMP2,U,6)'=""&($PIECE(RMPRTMP2,U,7)'=""):$PIECE(RMPRTMP2,U,6)_", "_$PIECE(RMPRTMP2,U,7)_" "_$PIECE(RMPRTMP2,U,8),1:"")
+19 ;"Prosthetics Service"
WRITE ?IOM-5-RMPRLNG,RMPR("NAME")
+20 WRITE !,?9,$SELECT($PIECE(RMPRTMP2,U,2)'=""&($PIECE(RMPRTMP2,U,3)'=""):$PIECE(RMPRTMP2,U,3),$PIECE(RMPRTMP2,U,6)'="":$PIECE(RMPRTMP2,U,6)_", "_$PIECE(RMPRTMP2,U,7)_" "_$PIECE(RMPRTMP2,U,8),1:"")
WRITE ?IOM-5-RMPRLNG,RMPR("ADD")
+21 IF $PIECE(RMPRTMP2,U,2)=""
IF $PIECE(RMPRTMP2,U,3)=""
IF $PIECE(RMPRTMP2,U,4)=""
WRITE !,?IOM-5-RMPRLNG,RMPR("CITY")
GOTO DNE
+22 IF $PIECE(RMPRTMP2,U,2)'=""&($PIECE(RMPRTMP2,U,3)'="")
Begin DoDot:1
+23 IF $PIECE(RMPRTMP2,U,4)'=""
WRITE !,?9,$PIECE(RMPRTMP2,U,4),?IOM-5-RMPRLNG,RMPR("CITY")
SET RDN=1
End DoDot:1
+24 IF $PIECE(RMPRTMP2,U,2)'=""&($PIECE(RMPRTMP2,U,3)'="")&(($PIECE(RMPRTMP2,U,4)'="")&($PIECE(RMPRTMP2,U,5)'=""))
Begin DoDot:1
+25 WRITE !,?9,$PIECE(RMPRTMP2,U,5)
+26 IF $GET(RDN)<1
WRITE ?IOM-5-RMPRLNG,RMPR("CITY")
SET RDN=1
End DoDot:1
+27 IF $PIECE(RMPRTMP2,U,2)'=""&($PIECE(RMPRTMP2,U,3)'="")
if $PIECE(RMPRTMP2,U,6)'=""&($PIECE(RMPRTMP2,U,7)'="")
WRITE !,?9,$PIECE(RMPRTMP2,U,6)_", "_$PIECE(RMPRTMP2,U,7)_" "_$PIECE(RMPRTMP2,U,8)
IF $GET(RDN)<1
WRITE ?IOM-5-RMPRLNG,RMPR("CITY")
SET RDN=1
+28 IF $GET(RDN)<1
WRITE !,?IOM-5-RMPRLNG,RMPR("CITY")
DNE KILL RDN
SET NAME=" "
SET SSN=" "
+1 ;Vendor phone on ADP FL 10-90
+2 WRITE !!
+3 IF $GET(DA)'>0
SET NAME=" "
DNE1 WRITE ?9,"Vendor Phone #: "
+1 IF $DATA(DA)
IF $GET(^RMPR(665.4,DA,2))
WRITE $PIECE(^PRC(440,$PIECE(^RMPR(665.4,DA,2),U,1),0),U,10)
+2 IF $GET(DA)>0
SET NAME=$PIECE(^DPT($PIECE(^RMPR(665.4,DA,0),U,1),0),U,1)
+3 ; *82 removed patient SSN from next line
+4 WRITE ?IOM-5-$LENGTH(NAME)-9,"Veteran: ",NAME,!
+5 WRITE !!,?5,"Your firm is being considered for the following:"
+6 SET LINES=0
SET ITM=0
SET LEN=0
+7 FOR
if $GET(DA)'>0
QUIT
SET ITM=$ORDER(^RMPR(665.4,DA,3,ITM))
if ITM'>0!(LINES=5)
QUIT
if LINES<5
Begin DoDot:1
+8 IF LEN=0
WRITE !,?6," "
SET LINES=LINES+1
+9 IF LEN>0
IF LEN+$LENGTH($PIECE(^RMPR(665.4,DA,3,ITM,0),U,1))<71
WRITE ", "
+10 IF LEN>0
IF LEN+$LENGTH($PIECE(^RMPR(665.4,DA,3,ITM,0),U,1))>70
SET LEN=0
WRITE !,?6," "
SET LINES=LINES+1
+11 if LINES<5
WRITE ^RMPR(665.4,DA,3,ITM,0)
+12 SET LEN=LEN+2+$LENGTH($PIECE(^RMPR(665.4,DA,3,ITM,0),U,1))
+13 IF LINES>4&(ITM>0)
SET MORE=1
SET ITEM=ITM
QUIT
End DoDot:1
+14 WRITE !!,?5,"An estimate on the above-listed item(s) is requested. "
+15 WRITE "YOUR QUOTATION "
+16 WRITE !,?5,"DOES NOT CONSTITUTE A PURCHASE ORDER."
+17 WRITE " Upon completion of the esti-"
+18 WRITE !,?5,"mate, return the original to the Veterans Affairs facility indicated"
+19 WRITE !,?5,"above and retain a copy for your files."
+20 WRITE !!,?5,"If approved, a purchase order will be prepared and forwarded to you."
+21 WRITE !!,?5,"Sincerely,"
+22 IF $Y+2>IOST
IF $EXTRACT(IOST,1,2)["C-"
WRITE !!
SET DIR(0)="E"
DO ^DIR
if +Y'>0
SET FL=1
if Y'>0
QUIT
WRITE @IOF
+23 WRITE !!!!,?5,RMPR("SIG"),!,?5,RMPR("SBT")
EST ;PRINT VENDOR'S ESTIMATE SECTION OF FL 10-90
+1 SET LINES=0
SET HEADING="VENDOR'S ESTIMATE"
WRITE !!,?IOM-$LENGTH(HEADING)\2,HEADING
+2 SET HEADING="(To be completed by Vendor)"
WRITE !,?IOM-$LENGTH(HEADING)\2,HEADING
+3 WRITE !,?5,$$REPEAT^XLFSTR("-",70)
+4 WRITE !,?5,"|",?12,"Article or Service"
+5 WRITE ?37,"|Quantity| Unit |Unit Cost|Total Cost|"
+6 WRITE !,?5,$$REPEAT^XLFSTR("-",70)
+7 SET LAPS=$Y
+8 FOR LP=LAPS:1:47
WRITE !,?5,"|",?37,"|",?46,"|",?53,"|",?63,"|",?74,"|"
IF $Y>20&($EXTRACT(IOST,1,2)["C-")
KILL DIR
SET DIR(0)="E"
DO ^DIR
if (X="^")!($DATA(DTOUT))
GOTO QWIT
WRITE @IOF
+9 WRITE !,?5,$$REPEAT^XLFSTR("-",70)
+10 WRITE !,?5,"| Vendor:",?42,"Contract number (if applicable) |"
+11 WRITE !,?5,"| Address:",?74,"|"
+12 WRITE !,?5,"| City:",?74,"|",!,?5,"| State:",?26,"Zip:",?74,"|"
+13 WRITE !,?5,"| Telephone:",?74,"|",!,?5,"| Date:",?37,"Signature & Title of Company Official|"
+14 WRITE !,?5,"| Note:List Terms/Discounts if Applicable",?74,"|"
+15 WRITE !,?5,$$REPEAT^XLFSTR("-",70)
+16 WRITE !,?59,"FL 10-90 ADP"
+17 IF $EXTRACT(IOST,1,2)["C-"
SET DIR(0)="E"
DO ^DIR
+18 WRITE @IOF
if $GET(MORE)=1
DO MORE^RMPRFO6
DO EST
DO EXIT
DO ^%ZISC
QWIT QUIT
