- BHLIN1 ; cmi/sitka/maw - BHL GIS IN1 Supplement ;
- ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- ;;
- ;
- ;this routine will supplement GIS IN1 segments
- ;
- INS ;-- setup insurance arrays
- K INDA(9000003.1),INDA(9000004),INDA(9000003),INDA(9000005)
- I '$G(BHL("VDT")) S BHL("VDT")=DT
- I $$MCR^AUPNPAT(INDA,BHL("VDT")) D
- . S BHLRCNT=0
- . S BHLEDA=0 F S BHLEDA=$O(^AUPNMCR(INDA,11,BHLEDA)) Q:'BHLEDA D
- .. S BHLED=$P($G(^AUPNMCR(INDA,11,BHLEDA,0)),U)
- .. S BHLEXD=$P($G(^AUPNMCR(INDA,11,BHLEDA,0)),U,2)
- .. Q:BHLED=""
- .. I BHLEXD="" S BHLEXD=9999999
- .. Q:BHLED>BHL("VDT")
- .. Q:BHLEXD<BHL("VDT")
- .. S BHLRCNT=BHLRCNT+1
- .. S INDA(9000003.11,BHLEDA)=""
- I $$PI^AUPNPAT(INDA,BHL("VDT")) D INDA^BHLIN1PI
- I $$MCD^AUPNPAT(INDA,BHL("VDT")) D
- . S BHLRCNT=0
- . S BHLDA=0 F S BHLDA=$O(^AUPNMCD("B",INDA,BHLDA)) Q:'BHLDA D
- .. S BHLEDA=0 F S BHLEDA=$O(^AUPNMCD(BHLDA,11,BHLEDA)) Q:'BHLEDA D
- ... S BHLED=$P($G(^AUPNMCD(BHLDA,11,BHLEDA,0)),U)
- ... S BHLEXD=$P($G(^AUPNMCD(BHLDA,11,BHLEDA,0)),U,2)
- ... Q:BHLED=""
- ... I BHLEXD="" S BHLEXD=9999999
- ... Q:BHLED>BHL("VDT")
- ... Q:BHLEXD<BHL("VDT")
- ... S BHLRCNT=BHLRCNT+1
- ... S INDA(9000004,BHLRCNT)=BHLDA
- ... S INDA(9000004.11,BHLEDA)=""
- D RR
- Q
- ;
- RR ;-- get railroad insurance ien if eligible
- Q:'$O(^AUPNRRE("B",INDA,0))
- N BHLDA,BHLED,BHLEXD
- S INDA(9000005,1)=INDA
- S BHLDA=0 F S BHLDA=$O(^AUPNRRE(INDA,11,BHLDA)) Q:'BHLDA D
- . S BHLED=$P($G(^AUPNRRE(INDA,11,BHLDA,0)),U)
- . S BHLEXD=$P($G(^AUPNRRE(INDA,11,BHLDA,0)),U,2)
- . Q:BHLED=""
- . I BHLEXD="" S BHLEXD=9999999
- . Q:BHLED>BHL("VDT")
- . Q:BHLEXD<BHL("VDT")
- . S INDA(9000005.11,BHLDA)=""
- Q
- ;
- BHLIN1 ; cmi/sitka/maw - BHL GIS IN1 Supplement ;
- +1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- +2 ;;
- +3 ;
- +4 ;this routine will supplement GIS IN1 segments
- +5 ;
- INS ;-- setup insurance arrays
- +1 KILL INDA(9000003.1),INDA(9000004),INDA(9000003),INDA(9000005)
- +2 IF '$GET(BHL("VDT"))
- SET BHL("VDT")=DT
- +3 IF $$MCR^AUPNPAT(INDA,BHL("VDT"))
- Begin DoDot:1
- +4 SET BHLRCNT=0
- +5 SET BHLEDA=0
- FOR
- SET BHLEDA=$ORDER(^AUPNMCR(INDA,11,BHLEDA))
- IF 'BHLEDA
- QUIT
- Begin DoDot:2
- +6 SET BHLED=$PIECE($GET(^AUPNMCR(INDA,11,BHLEDA,0)),U)
- +7 SET BHLEXD=$PIECE($GET(^AUPNMCR(INDA,11,BHLEDA,0)),U,2)
- +8 IF BHLED=""
- QUIT
- +9 IF BHLEXD=""
- SET BHLEXD=9999999
- +10 IF BHLED>BHL("VDT")
- QUIT
- +11 IF BHLEXD<BHL("VDT")
- QUIT
- +12 SET BHLRCNT=BHLRCNT+1
- +13 SET INDA(9000003.11,BHLEDA)=""
- End DoDot:2
- End DoDot:1
- +14 IF $$PI^AUPNPAT(INDA,BHL("VDT"))
- DO INDA^BHLIN1PI
- +15 IF $$MCD^AUPNPAT(INDA,BHL("VDT"))
- Begin DoDot:1
- +16 SET BHLRCNT=0
- +17 SET BHLDA=0
- FOR
- SET BHLDA=$ORDER(^AUPNMCD("B",INDA,BHLDA))
- IF 'BHLDA
- QUIT
- Begin DoDot:2
- +18 SET BHLEDA=0
- FOR
- SET BHLEDA=$ORDER(^AUPNMCD(BHLDA,11,BHLEDA))
- IF 'BHLEDA
- QUIT
- Begin DoDot:3
- +19 SET BHLED=$PIECE($GET(^AUPNMCD(BHLDA,11,BHLEDA,0)),U)
- +20 SET BHLEXD=$PIECE($GET(^AUPNMCD(BHLDA,11,BHLEDA,0)),U,2)
- +21 IF BHLED=""
- QUIT
- +22 IF BHLEXD=""
- SET BHLEXD=9999999
- +23 IF BHLED>BHL("VDT")
- QUIT
- +24 IF BHLEXD<BHL("VDT")
- QUIT
- +25 SET BHLRCNT=BHLRCNT+1
- +26 SET INDA(9000004,BHLRCNT)=BHLDA
- +27 SET INDA(9000004.11,BHLEDA)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +28 DO RR
- +29 QUIT
- +30 ;
- RR ;-- get railroad insurance ien if eligible
- +1 IF '$ORDER(^AUPNRRE("B",INDA,0))
- QUIT
- +2 NEW BHLDA,BHLED,BHLEXD
- +3 SET INDA(9000005,1)=INDA
- +4 SET BHLDA=0
- FOR
- SET BHLDA=$ORDER(^AUPNRRE(INDA,11,BHLDA))
- IF 'BHLDA
- QUIT
- Begin DoDot:1
- +5 SET BHLED=$PIECE($GET(^AUPNRRE(INDA,11,BHLDA,0)),U)
- +6 SET BHLEXD=$PIECE($GET(^AUPNRRE(INDA,11,BHLDA,0)),U,2)
- +7 IF BHLED=""
- QUIT
- +8 IF BHLEXD=""
- SET BHLEXD=9999999
- +9 IF BHLED>BHL("VDT")
- QUIT
- +10 IF BHLEXD<BHL("VDT")
- QUIT
- +11 SET INDA(9000005.11,BHLDA)=""
- End DoDot:1
- +12 QUIT
- +13 ;