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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRUTL3 1453 printed Nov 22, 2024@17:48:02 Page 2
RMPRUTL3 ;PHX/HPL-UTILITY FOR USE WITH PROS LETTERS ;8/29/1994
+1 ;;3.0;PROSTHETICS;;Feb 09, 1996
EN2(PATIENTD) ;;PRSNT BCKWRDS LIST FOR SELCT OF PROS LETTER
+1 NEW X,Y,RMPRG
+2 SET RMPR9ZRO=0
KILL RMPRHPL
+3 WRITE @IOF
WRITE !!!," "
KILL ^TMP($JOB,"RMPR","AA")
+4 SET RMPRBB=0
SET RMPRG=7
KILL DA
+5 FOR
SET RMPRBB=RMPRBB+1
SET ENTRY=" "
SET RMPR9ZRO=$ORDER(^TMP($JOB,"RMPR",RMPR9ZRO))
Begin DoDot:1
+6 if RMPR9ZRO'>0
QUIT
if $Y#RMPRG=0
READ !,"Press 'RETURN' to continue, or enter a number: ",ENTRY:60
+7 if $GET(ENTRY)="^"
QUIT
if $GET(ENTRY)=""
WRITE !!,""
if $GET(ENTRY)=""
KILL ENTRY
if $GET(ENTRY)>0&($GET(ENTRY)<RMPRBB+1)
GOTO GOTENT
Begin DoDot:2
+8 SET RMPRG=12
+9 WRITE !,RMPRBB
SET ^TMP($JOB,"RMPR","AA",RMPRBB)=^TMP($JOB,"RMPR",RMPR9ZRO)
WRITE ?4,$PIECE(^DPT(PATIENTD,0),U,1)
+10 if $GET(RMPR9ZRO)'>0
QUIT
WRITE ?35,$PIECE(^RMPR(665.2,$PIECE(^RMPR(665.4,^TMP($JOB,"RMPR",RMPR9ZRO),0),U,2),0),U,1)
+11 ;_$P($G(^RMPR(665.4,^TMP($J,"RMPR",RMPR9ZRO),5)),U,1)
WRITE ?60,$$FMTE^XLFDT($PIECE(^RMPR(665.4,^TMP($JOB,"RMPR",RMPR9ZRO),0),U,3),"2P")
End DoDot:2
End DoDot:1
+12 READ !,"Select LETTER: ",ENTRY:DTIME
IF $GET(ENTRY)'>0!($GET(ENTRY)>RMPRBB)
QUIT ""
GOTENT SET DA=^TMP($JOB,"RMPR","AA",ENTRY)
+1 SET RMPR9ZRO=DA
+2 QUIT RMPR9ZRO
GETPAT(DA) ;GET PATIENT
+1 SET DIC="^DPT("
SET DIC(0)="AEQM"
SET DIC("A")="Select PATIENT: "
DO ^DIC
SET DA=+Y
+2 QUIT DA
BAC(PATIENTD) ;SET UP A TEMPORARY BACKWARD STRING IN THE LETTER FILE
+1 NEW RMPRLP,RMPRIEN,RMPRNO
+2 KILL ^TMP("RMPR",$JOB)
if $GET(PATIENTD)=""
QUIT
+3 SET RMPRIEN=0
SET RMPRLP=0
FOR
SET RMPRLP=RMPRLP+1
SET RMPRNO=$PIECE(^RMPR(665.4,0),U,3)+999
SET RMPRIEN=$ORDER(^RMPR(665.4,"B",PATIENTD,RMPRIEN))
if RMPRIEN'>0
QUIT
SET ^TMP($JOB,"RMPR",(RMPRNO-RMPRIEN))=RMPRIEN
+4 QUIT
