RMPR9DM3 ;HOIFO/HNC - GUI PFFS INSURANCE MINI GRID ;9/18/02 17:01
;;3.0;PROSTHETICS;**96**;Feb 09, 1996
A1(IEN) G A2
ENR(DFN) ;entry point for roll and scroll
G ENC
EN(RESULTS,IEN) ;broker entry point
A2 ;
S DFN=$P($G(^RMPR(660,IEN,0)),U,2)
I DFN="" S RESULTS(0)="NOTHING FOUND" Q
;new code
ENC ;roll and scroll starts here
;call insurance API
S X=$$INSUR^IBBAPI(DFN,,"RBA",.RMI,"*") I $D(RMI) D
.S CNT=0
.S X="" F S X=$O(RMI("IBBAPI","INSUR",X)) Q:'X D
..S INSUR=$P(RMI("IBBAPI","INSUR",X,1),U,2)
..S SUBID=$P(RMI("IBBAPI","INSUR",X,14),U,1)
..S HOLDER=$P(RMI("IBBAPI","INSUR",X,12),U,2)
..S COB=$E($P(RMI("IBBAPI","INSUR",X,7),U,2),0,1)
..S RMPRIND=$P(RMI("IBBAPI","INSUR",X,11),U,1)
..I RMPRIND'="" S RMPRIND=$E(RMPRIND,4,5)_"/"_$E(RMPRIND,6,7)_"/"_(($E(RMPRIND,1,3))+1700)
..S INSURE=$P(RMI("IBBAPI","INSUR",X,10),U,1)
..I INSURE'="" S INSURE=$E(INSURE,4,5)_"/"_$E(INSURE,6,7)_"/"_(($E(INSURE,1,3))+1700)
..S INSURG=$P(RMI("IBBAPI","INSUR",X,8),U,1)
..S INSURGG=$$GET1^DIQ(355.3,INSURG_",",.04)
..S CNT=CNT+1
..S RESULTS(CNT)=INSUR_U_SUBID_U_INSURG_U_HOLDER_U_RMPRIND_U_INSURE_U_COB
..K INSUR,SUBID,INSURG,HOLDER,RMPRIND,INSURE,COB
;
I '$D(RESULTS) S RESULTS(1)="No Insurance Information"
;
K RMI,IEN,DFN,CNT,INSURGG,X
;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR9DM3 1291 printed Sep 23, 2025@20:09:45 Page 2
RMPR9DM3 ;HOIFO/HNC - GUI PFFS INSURANCE MINI GRID ;9/18/02 17:01
+1 ;;3.0;PROSTHETICS;**96**;Feb 09, 1996
A1(IEN) GOTO A2
ENR(DFN) ;entry point for roll and scroll
+1 GOTO ENC
EN(RESULTS,IEN) ;broker entry point
A2 ;
+1 SET DFN=$PIECE($GET(^RMPR(660,IEN,0)),U,2)
+2 IF DFN=""
SET RESULTS(0)="NOTHING FOUND"
QUIT
+3 ;new code
ENC ;roll and scroll starts here
+1 ;call insurance API
+2 SET X=$$INSUR^IBBAPI(DFN,,"RBA",.RMI,"*")
IF $DATA(RMI)
Begin DoDot:1
+3 SET CNT=0
+4 SET X=""
FOR
SET X=$ORDER(RMI("IBBAPI","INSUR",X))
if 'X
QUIT
Begin DoDot:2
+5 SET INSUR=$PIECE(RMI("IBBAPI","INSUR",X,1),U,2)
+6 SET SUBID=$PIECE(RMI("IBBAPI","INSUR",X,14),U,1)
+7 SET HOLDER=$PIECE(RMI("IBBAPI","INSUR",X,12),U,2)
+8 SET COB=$EXTRACT($PIECE(RMI("IBBAPI","INSUR",X,7),U,2),0,1)
+9 SET RMPRIND=$PIECE(RMI("IBBAPI","INSUR",X,11),U,1)
+10 IF RMPRIND'=""
SET RMPRIND=$EXTRACT(RMPRIND,4,5)_"/"_$EXTRACT(RMPRIND,6,7)_"/"_(($EXTRACT(RMPRIND,1,3))+1700)
+11 SET INSURE=$PIECE(RMI("IBBAPI","INSUR",X,10),U,1)
+12 IF INSURE'=""
SET INSURE=$EXTRACT(INSURE,4,5)_"/"_$EXTRACT(INSURE,6,7)_"/"_(($EXTRACT(INSURE,1,3))+1700)
+13 SET INSURG=$PIECE(RMI("IBBAPI","INSUR",X,8),U,1)
+14 SET INSURGG=$$GET1^DIQ(355.3,INSURG_",",.04)
+15 SET CNT=CNT+1
+16 SET RESULTS(CNT)=INSUR_U_SUBID_U_INSURG_U_HOLDER_U_RMPRIND_U_INSURE_U_COB
+17 KILL INSUR,SUBID,INSURG,HOLDER,RMPRIND,INSURE,COB
End DoDot:2
End DoDot:1
+18 ;
+19 IF '$DATA(RESULTS)
SET RESULTS(1)="No Insurance Information"
+20 ;
+21 KILL RMI,IEN,DFN,CNT,INSURGG,X
+22 ;END
