RMPRUTL3 ;PHX/HPL-UTILITY FOR USE WITH PROS LETTERS ;8/29/1994
 ;;3.0;PROSTHETICS;;Feb 09, 1996
EN2(PATIENTD) ;;PRSNT BCKWRDS LIST FOR SELCT OF PROS LETTER
 N X,Y,RMPRG
 S RMPR9ZRO=0 K RMPRHPL
 W @IOF W !!!," " K ^TMP($J,"RMPR","AA")
 S RMPRBB=0,RMPRG=7 K DA
 F  S RMPRBB=RMPRBB+1,ENTRY=" ",RMPR9ZRO=$O(^TMP($J,"RMPR",RMPR9ZRO)) D
 .Q:RMPR9ZRO'>0  R:$Y#RMPRG=0 !,"Press 'RETURN' to continue, or enter a number: ",ENTRY:60
 .Q:$G(ENTRY)="^"  W:$G(ENTRY)="" !!,"" K:$G(ENTRY)="" ENTRY G:$G(ENTRY)>0&($G(ENTRY)<RMPRBB+1) GOTENT D
 ..S RMPRG=12
 ..W !,RMPRBB S ^TMP($J,"RMPR","AA",RMPRBB)=^TMP($J,"RMPR",RMPR9ZRO) W ?4,$P(^DPT(PATIENTD,0),U,1)
 ..Q:$G(RMPR9ZRO)'>0  W ?35,$P(^RMPR(665.2,$P(^RMPR(665.4,^TMP($J,"RMPR",RMPR9ZRO),0),U,2),0),U,1)
 ..W ?60,$$FMTE^XLFDT($P(^RMPR(665.4,^TMP($J,"RMPR",RMPR9ZRO),0),U,3),"2P") ;_$P($G(^RMPR(665.4,^TMP($J,"RMPR",RMPR9ZRO),5)),U,1)
 R !,"Select LETTER: ",ENTRY:DTIME I $G(ENTRY)'>0!($G(ENTRY)>RMPRBB) Q ""
GOTENT S DA=^TMP($J,"RMPR","AA",ENTRY)
 S RMPR9ZRO=DA
 Q RMPR9ZRO
GETPAT(DA) ;GET PATIENT
 S DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select PATIENT: " D ^DIC S DA=+Y
 Q DA
BAC(PATIENTD) ;SET UP A TEMPORARY BACKWARD STRING IN THE LETTER FILE
 N RMPRLP,RMPRIEN,RMPRNO
 K ^TMP("RMPR",$J) Q:$G(PATIENTD)=""
 S RMPRIEN=0,RMPRLP=0 F  S RMPRLP=RMPRLP+1,RMPRNO=$P(^RMPR(665.4,0),U,3)+999 S RMPRIEN=$O(^RMPR(665.4,"B",PATIENTD,RMPRIEN)) Q:RMPRIEN'>0  S ^TMP($J,"RMPR",(RMPRNO-RMPRIEN))=RMPRIEN
 Q