- 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 Mar 13, 2025@21:42:56 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
