RMPR9DM3.m

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 ---RMPR9DM3   1291     printed  Apr 09, 2024@21:35:10                                                                                                                                                                                                    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