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