RMPRUTL1 ;PHX/HPL - PROSTHETICS UTILITY SUBROUTINES ;10/31/1994
 ;;3.0;PROSTHETICS;**3,44,49,59**;Feb 09, 1996
 ;;PROSTHETICS;3.0;Apr. 17, 1995
 ;OJ - p49 rewrite of RAP to overcome letter printing line wrap problems
 ;
RAP(LINE,TB) ;WRAP A LINE IF NEEDED
 N MAX,S,NW,NXT,FIN,SL
 S MAX=IOM-(2*TB),FIN=0
 F  Q:FIN  D
 . S SL=$L(LINE)
 . I SL'>MAX W !?TB,LINE S FIN=1 Q
 . S S=$E(LINE,1,MAX),NXT=MAX
 . I $E(S,MAX)'=" " D
 . . S NW=$L(S," ")-1
 . . I NW=0 D
 . . . S NXT=MAX-1,S=$E(S,1,NXT)_"-"
 . . . Q
 . . E  D
 . . . S S=$P(S," ",1,NW),NXT=$L(S)
 . . . Q
 . . Q
 . W !?TB,S
 . F  S NXT=NXT+1 Q:NXT>SL  Q:$E(LINE,NXT)'=" "
 . I NXT>SL S FIN=1 Q
 . S LINE=$E(LINE,NXT,SL)
 . Q
 Q ""
FND ;FIND NEXT NON SPACE POSITION
 Q:'$D(LINE)  F NLP=LP:1:H S B=NLP Q:$E(LINE,B,B)'=" "
 Q
PARS(NAME) ;PARSE AN INTERNAL FORM NAME INTO A LETTER FORMAT NAME
 I NAME["," S LNAME=$P(NAME,",",1),FNAME=$P(NAME,",",2)
 E  D
 .S LNAME=NAME,PIECES=1,FNAME="",FNAME(1)="",TITLE=""
 I LNAME'[" " S LP=1,LNAME(1)=LNAME,LNAME(2)=""
 E  D
 .S LP=2,LNAME(2)=$P(LNAME," ",2),LNAME(1)=$P(LNAME," ",1)
 F LUP=1:1:LP S NAME=LNAME(LUP) D TRANS S LNAME(LUP)=RMPRNAME
 S LASTNAME=LNAME(1)_" "_LNAME(2)
 S PIECES=$S($L(FNAME," ")>1:$L(FNAME," "),1:1) S TITLE=""
 I PIECES>1&($L($P(FNAME," ",PIECES))>1) D
 .S TITLE=$P(FNAME," ",PIECES)
 .S PIECES=PIECES-1
  S FRSTNAME="" F LP=1:1:PIECES S NAME=$P(FNAME," ",LP) D TRANS S FRSTNAME=FRSTNAME_" "_RMPRNAME
 S NAME=TITLE
 I TITLE'["I" D TRANS S TITLE=RMPRNAME
 S FIXDNAME=FRSTNAME_" "_LASTNAME_" "
 Q FIXDNAME
TRANS S RMPRU="ABCDEFGHIJKLMNOPQRSTUVWXYZ",RMPRL="abcdefghijklmnopqrstuvwxyz",RMPR1=$E(NAME),RMPR2=$E(NAME,2,25),RMPRNAME=$TR(RMPR1,RMPRL,RMPRU)_$TR(RMPR2,RMPRU,RMPRL)
 Q
DCNT(AMT,PCT) ; CALCULATE A DISCOUNT WITH ROUNDING
 S DCNT=AMT*PCT S DCNT=$S(DCNT#.01=.005:DCNT+.005,DCNT#.01>.005:DCNT+(.01-(DCNT#.01)),1:DCNT-(DCNT#.01))
 Q DCNT
DISP ;Display help for DIR screens/reads.
 N RMPR90DP,RMPR90I W ! S RMPR90DP=$P(DIR(0),U,2,999) F RMPR90I=1:1:5 I $P($P(RMPR90DP,";",RMPR90I),":",1)'=""  W " ("_$P($P(RMPR90DP,";",RMPR90I),":",1)_")"_$P($P(RMPR90DP,";",RMPR90I),":",2)_" "
 Q
EXIT ;GENERIC EXIT TAG
 ; VARIABLES REQUIRED: NONE
 N RMPR,RMPRSITE D KILL^%ZISS,KVAR^VADPT,KILL^XUSCLEAN Q
 ;
DAT1(X) ; Convert FM date to displayable (mm/dd/yy) format. 
 N DATE
 S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3),1:"")
 Q DATE
 ;
DAT2(X) ;Convert FM date to display (mm/dd/yyyy) format.
 N DATE
 S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_(1700+$E(X,1,3)),1:"")
 Q DATE
 ;