- 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 Feb 18, 2025@23:59:59 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