27 lines
1.4 KiB
Mathematica
27 lines
1.4 KiB
Mathematica
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
|