source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR9DM3.m@ 1042

Last change on this file since 1042 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
RevLine 
[613]1RMPR9DM3 ;HOIFO/HNC - GUI PFFS INSURANCE MINI GRID ;9/18/02 17:01
2 ;;3.0;PROSTHETICS;**96**;Feb 09, 1996
3A1(IEN) G A2
4ENR(DFN) ;entry point for roll and scroll
5 G ENC
6EN(RESULTS,IEN) ;broker entry point
7A2 ;
8 S DFN=$P($G(^RMPR(660,IEN,0)),U,2)
9 I DFN="" S RESULTS(0)="NOTHING FOUND" Q
10 ;new code
11ENC ;roll and scroll starts here
12 ;call insurance API
13 S X=$$INSUR^IBBAPI(DFN,,"RBA",.RMI,"*") I $D(RMI) D
14 .S CNT=0
15 .S X="" F S X=$O(RMI("IBBAPI","INSUR",X)) Q:'X D
16 ..S INSUR=$P(RMI("IBBAPI","INSUR",X,1),U,2)
17 ..S SUBID=$P(RMI("IBBAPI","INSUR",X,14),U,1)
18 ..S HOLDER=$P(RMI("IBBAPI","INSUR",X,12),U,2)
19 ..S COB=$E($P(RMI("IBBAPI","INSUR",X,7),U,2),0,1)
20 ..S RMPRIND=$P(RMI("IBBAPI","INSUR",X,11),U,1)
21 ..I RMPRIND'="" S RMPRIND=$E(RMPRIND,4,5)_"/"_$E(RMPRIND,6,7)_"/"_(($E(RMPRIND,1,3))+1700)
22 ..S INSURE=$P(RMI("IBBAPI","INSUR",X,10),U,1)
23 ..I INSURE'="" S INSURE=$E(INSURE,4,5)_"/"_$E(INSURE,6,7)_"/"_(($E(INSURE,1,3))+1700)
24 ..S INSURG=$P(RMI("IBBAPI","INSUR",X,8),U,1)
25 ..S INSURGG=$$GET1^DIQ(355.3,INSURG_",",.04)
26 ..S CNT=CNT+1
27 ..S RESULTS(CNT)=INSUR_U_SUBID_U_INSURG_U_HOLDER_U_RMPRIND_U_INSURE_U_COB
28 ..K INSUR,SUBID,INSURG,HOLDER,RMPRIND,INSURE,COB
29 ;
30 I '$D(RESULTS) S RESULTS(1)="No Insurance Information"
31 ;
32 K RMI,IEN,DFN,CNT,INSURGG,X
33 ;END
Note: See TracBrowser for help on using the repository browser.