RMPR9CL ;HOIFO/SPS - GUI 2319 TAB 2 LETTER LIST & DISPLAY ;9/26/02 10:09
;;3.0;PROSTHETICS;**59**;Feb 09, 1996
A1(IEN) G A2
EN(RESULTS,IEN) ;broker entry point
A2 ;
S DFN=$P($G(^RMPR(668,IEN,0)),U,2)
I DFN="" S RESULTS(0)="NOTHING TO REPORT" G EXIT
;List of Letters on File
S RMPRDFN=DFN
I '$D(^RMPR(665.4,"AH",RMPRDFN)) S RESULTS(0)="NOTHING TO REPORT" G EXIT
N RMPRBDT,DIC,RB,RI,DR,DA,RMPLET,DIQ,Y,RO
S (CNT,RMPRBDT,RI,RB,RO)=0,RMPRIN=-1,DIC=665.4,DR=".01;1;2;4;11",DIQ="RMPRLET"
F S RMPRBDT=$O(^RMPR(665.4,"AH",RMPRDFN,RMPRBDT)) Q:RMPRBDT="" D Q:RO=1
.S DA=0
.F S DA=$O(^RMPR(665.4,"AH",RMPRDFN,RMPRBDT,DA)) Q:'DA D Q:RO=1
..S RI=RI+1,RI(RI)=DA D EN^DIQ1 Q:'$D(RMPRLET)
..S RESULTS(CNT)=DA_"^"_RMPRLET(665.4,DA,.01)_"^"_$G(RMPRLET(665.4,DA,1))_"^"_$E($G(RMPRLET(665.4,DA,4)),1,15)_"^"_$G(RMPRLET(665.4,DA,2))_$G(RMPRLET(665.4,DA,11))
..S CNT=CNT+1
..K RMPRLET
Q
A3(IEN) G A4
EN1(RESULTS,IEN) ;
A4 ;Print letter, IEN=internal entrie number of file 665.4
I '$D(^RMPR(665.4,IEN)) S RESULTS(0)="NOTHING TO REPORT" G EXIT
M RMPRTMP=^RMPR(665.4,IEN,1)
K RMPRTMP(0)
S RTST=0
F S RTST=$O(RMPRTMP(RTST)) Q:RTST="" D
. I '$D(RMPRTMP(RTST,0)) Q
. S RF=$L(RMPRTMP(RTST,0),"|")
. F RP=0:1:RF I $P(RMPRTMP(RTST,0),"|",RP)["TAB" D
.. S $P(RMPRTMP(RTST,0),"|",RP)=" "
. S RMPRTMP(RTST,0)=$TR(RMPRTMP(RTST,0),"|","")
. S RMPRTMP(RTST)=RMPRTMP(RTST,0)
. K RMPRTMP(RTST,0)
M RESULTS=RMPRTMP
EXIT ;common exit point
I '$D(RESULTS) S RESULTS(0)="NOTHING TO REPORT"
K CNT,DFN,RMPRTMP,RF,RO,RP
;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR9CL 1563 printed Apr 09, 2024@21:34:23 Page 2
RMPR9CL ;HOIFO/SPS - GUI 2319 TAB 2 LETTER LIST & DISPLAY ;9/26/02 10:09
+1 ;;3.0;PROSTHETICS;**59**;Feb 09, 1996
A1(IEN) GOTO A2
EN(RESULTS,IEN) ;broker entry point
A2 ;
+1 SET DFN=$PIECE($GET(^RMPR(668,IEN,0)),U,2)
+2 IF DFN=""
SET RESULTS(0)="NOTHING TO REPORT"
GOTO EXIT
+3 ;List of Letters on File
+4 SET RMPRDFN=DFN
+5 IF '$DATA(^RMPR(665.4,"AH",RMPRDFN))
SET RESULTS(0)="NOTHING TO REPORT"
GOTO EXIT
+6 NEW RMPRBDT,DIC,RB,RI,DR,DA,RMPLET,DIQ,Y,RO
+7 SET (CNT,RMPRBDT,RI,RB,RO)=0
SET RMPRIN=-1
SET DIC=665.4
SET DR=".01;1;2;4;11"
SET DIQ="RMPRLET"
+8 FOR
SET RMPRBDT=$ORDER(^RMPR(665.4,"AH",RMPRDFN,RMPRBDT))
if RMPRBDT=""
QUIT
Begin DoDot:1
+9 SET DA=0
+10 FOR
SET DA=$ORDER(^RMPR(665.4,"AH",RMPRDFN,RMPRBDT,DA))
if 'DA
QUIT
Begin DoDot:2
+11 SET RI=RI+1
SET RI(RI)=DA
DO EN^DIQ1
if '$DATA(RMPRLET)
QUIT
+12 SET RESULTS(CNT)=DA_"^"_RMPRLET(665.4,DA,.01)_"^"_$GET(RMPRLET(665.4,DA,1))_"^"_$EXTRACT($GET(RMPRLET(665.4,DA,4)),1,15)_"^"_$GET(RMPRLET(665.4,DA,2))_$GET(RMPRLET(665.4,DA,11))
+13 SET CNT=CNT+1
+14 KILL RMPRLET
End DoDot:2
if RO=1
QUIT
End DoDot:1
if RO=1
QUIT
+15 QUIT
A3(IEN) GOTO A4
EN1(RESULTS,IEN) ;
A4 ;Print letter, IEN=internal entrie number of file 665.4
+1 IF '$DATA(^RMPR(665.4,IEN))
SET RESULTS(0)="NOTHING TO REPORT"
GOTO EXIT
+2 MERGE RMPRTMP=^RMPR(665.4,IEN,1)
+3 KILL RMPRTMP(0)
+4 SET RTST=0
+5 FOR
SET RTST=$ORDER(RMPRTMP(RTST))
if RTST=""
QUIT
Begin DoDot:1
+6 IF '$DATA(RMPRTMP(RTST,0))
QUIT
+7 SET RF=$LENGTH(RMPRTMP(RTST,0),"|")
+8 FOR RP=0:1:RF
IF $PIECE(RMPRTMP(RTST,0),"|",RP)["TAB"
Begin DoDot:2
+9 SET $PIECE(RMPRTMP(RTST,0),"|",RP)=" "
End DoDot:2
+10 SET RMPRTMP(RTST,0)=$TRANSLATE(RMPRTMP(RTST,0),"|","")
+11 SET RMPRTMP(RTST)=RMPRTMP(RTST,0)
+12 KILL RMPRTMP(RTST,0)
End DoDot:1
+13 MERGE RESULTS=RMPRTMP
EXIT ;common exit point
+1 IF '$DATA(RESULTS)
SET RESULTS(0)="NOTHING TO REPORT"
+2 KILL CNT,DFN,RMPRTMP,RF,RO,RP
+3 ;END
