- RMPRFO6 ;PHX/HPL-PRINT FL 10-90 ADP LETTER ;11/01/1994
- ;;3.0;PROSTHETICS;**82,130**;Feb 09, 1996;Build 7
- ; 07/21/2004 KAM RMPR*3*82 - Remove Patient SSN from Letter
- MORE ;PRINT ADDITIONAL PAGE(S) OF FL 10-90 ADP IF NEEDED
- Q:MORE=0&(ITEM'>0) S LINES=0,MORE=0,HEADING="CONTINUATION OF 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)
- W ?IOM-5-RMPRLNG-6,"FROM: ",RMPR("NAME")
- W !,?IOM-5-RMPRLNG,RMPR("ADD"),!,?IOM-5-RMPRLNG,RMPR("CITY")
- ; *82 removed patient SSN from next line
- W !!,?IOM-5-$L(NAME)-9,"Veteran: ",NAME,!
- W !!,?5,"CONTINUATION OF ITEM LIST:"
- Q:$G(ITEM)'>0 S LINES=0,LEN=0 W !,?6," ",^RMPR(665.4,DA,3,ITEM,0) S LEN=$L($P(^RMPR(665.4,DA,3,ITEM,0),U,1))+2
- F S ITEM=$O(^RMPR(665.4,DA,3,ITEM)) Q:ITEM'>0!(LINES>11) D:LINES<12
- .I LEN=0 W !,?6," " S LINES=LINES+1
- .I LEN>0,LEN+$L($P(^RMPR(665.4,DA,3,ITEM,0),U,1))<71 W ", "
- .I LEN>0,LEN+$L($P(^RMPR(665.4,DA,3,ITEM,0),U,1))>70 S LEN=0 W !,?6," " S LINES=LINES+1
- .W:LINES<12 ^RMPR(665.4,DA,3,ITEM,0) S LEN=LEN+2+$L($P(^RMPR(665.4,DA,3,ITEM,0),U,1))
- .I LINES>11&(ITEM>0) S MORE=1 D MORE
- I LINES<12&(LINES>0&(MORE=0)) S MORE=0 Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRFO6 1333 printed Mar 13, 2025@21:39:41 Page 2
- RMPRFO6 ;PHX/HPL-PRINT FL 10-90 ADP LETTER ;11/01/1994
- +1 ;;3.0;PROSTHETICS;**82,130**;Feb 09, 1996;Build 7
- +2 ; 07/21/2004 KAM RMPR*3*82 - Remove Patient SSN from Letter
- MORE ;PRINT ADDITIONAL PAGE(S) OF FL 10-90 ADP IF NEEDED
- +1 if MORE=0&(ITEM'>0)
- QUIT
- SET LINES=0
- SET MORE=0
- SET HEADING="CONTINUATION OF REQUEST FOR QUOTATION"
- WRITE !!!,?IOM-$LENGTH(HEADING)\2,HEADING
- +2 SET HEADING="Date: "_$$FMTE^XLFDT(DT,"D")
- WRITE !,?IOM-$LENGTH(HEADING)\2,HEADING
- +3 WRITE !!,?5,"TO: "
- +4 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)
- +5 WRITE ?IOM-5-RMPRLNG-6,"FROM: ",RMPR("NAME")
- +6 WRITE !,?IOM-5-RMPRLNG,RMPR("ADD"),!,?IOM-5-RMPRLNG,RMPR("CITY")
- +7 ; *82 removed patient SSN from next line
- +8 WRITE !!,?IOM-5-$LENGTH(NAME)-9,"Veteran: ",NAME,!
- +9 WRITE !!,?5,"CONTINUATION OF ITEM LIST:"
- +10 if $GET(ITEM)'>0
- QUIT
- SET LINES=0
- SET LEN=0
- WRITE !,?6," ",^RMPR(665.4,DA,3,ITEM,0)
- SET LEN=$LENGTH($PIECE(^RMPR(665.4,DA,3,ITEM,0),U,1))+2
- +11 FOR
- SET ITEM=$ORDER(^RMPR(665.4,DA,3,ITEM))
- if ITEM'>0!(LINES>11)
- QUIT
- if LINES<12
- Begin DoDot:1
- +12 IF LEN=0
- WRITE !,?6," "
- SET LINES=LINES+1
- +13 IF LEN>0
- IF LEN+$LENGTH($PIECE(^RMPR(665.4,DA,3,ITEM,0),U,1))<71
- WRITE ", "
- +14 IF LEN>0
- IF LEN+$LENGTH($PIECE(^RMPR(665.4,DA,3,ITEM,0),U,1))>70
- SET LEN=0
- WRITE !,?6," "
- SET LINES=LINES+1
- +15 if LINES<12
- WRITE ^RMPR(665.4,DA,3,ITEM,0)
- SET LEN=LEN+2+$LENGTH($PIECE(^RMPR(665.4,DA,3,ITEM,0),U,1))
- +16 IF LINES>11&(ITEM>0)
- SET MORE=1
- DO MORE
- End DoDot:1
- +17 IF LINES<12&(LINES>0&(MORE=0))
- SET MORE=0
- QUIT
