Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BHLIN1

BHLIN1.m

Go to the documentation of this file.
  1. BHLIN1 ; cmi/sitka/maw - BHL GIS IN1 Supplement ;
  1. ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1. ;;
  1. ;
  1. ;this routine will supplement GIS IN1 segments
  1. ;
  1. INS ;-- setup insurance arrays
  1. K INDA(9000003.1),INDA(9000004),INDA(9000003),INDA(9000005)
  1. I '$G(BHL("VDT")) S BHL("VDT")=DT
  1. I $$MCR^AUPNPAT(INDA,BHL("VDT")) D
  1. . S BHLRCNT=0
  1. . S BHLEDA=0 F S BHLEDA=$O(^AUPNMCR(INDA,11,BHLEDA)) Q:'BHLEDA D
  1. .. S BHLED=$P($G(^AUPNMCR(INDA,11,BHLEDA,0)),U)
  1. .. S BHLEXD=$P($G(^AUPNMCR(INDA,11,BHLEDA,0)),U,2)
  1. .. Q:BHLED=""
  1. .. I BHLEXD="" S BHLEXD=9999999
  1. .. Q:BHLED>BHL("VDT")
  1. .. Q:BHLEXD<BHL("VDT")
  1. .. S BHLRCNT=BHLRCNT+1
  1. .. S INDA(9000003.11,BHLEDA)=""
  1. I $$PI^AUPNPAT(INDA,BHL("VDT")) D INDA^BHLIN1PI
  1. I $$MCD^AUPNPAT(INDA,BHL("VDT")) D
  1. . S BHLRCNT=0
  1. . S BHLDA=0 F S BHLDA=$O(^AUPNMCD("B",INDA,BHLDA)) Q:'BHLDA D
  1. .. S BHLEDA=0 F S BHLEDA=$O(^AUPNMCD(BHLDA,11,BHLEDA)) Q:'BHLEDA D
  1. ... S BHLED=$P($G(^AUPNMCD(BHLDA,11,BHLEDA,0)),U)
  1. ... S BHLEXD=$P($G(^AUPNMCD(BHLDA,11,BHLEDA,0)),U,2)
  1. ... Q:BHLED=""
  1. ... I BHLEXD="" S BHLEXD=9999999
  1. ... Q:BHLED>BHL("VDT")
  1. ... Q:BHLEXD<BHL("VDT")
  1. ... S BHLRCNT=BHLRCNT+1
  1. ... S INDA(9000004,BHLRCNT)=BHLDA
  1. ... S INDA(9000004.11,BHLEDA)=""
  1. D RR
  1. Q
  1. ;
  1. RR ;-- get railroad insurance ien if eligible
  1. Q:'$O(^AUPNRRE("B",INDA,0))
  1. N BHLDA,BHLED,BHLEXD
  1. S INDA(9000005,1)=INDA
  1. S BHLDA=0 F S BHLDA=$O(^AUPNRRE(INDA,11,BHLDA)) Q:'BHLDA D
  1. . S BHLED=$P($G(^AUPNRRE(INDA,11,BHLDA,0)),U)
  1. . S BHLEXD=$P($G(^AUPNRRE(INDA,11,BHLDA,0)),U,2)
  1. . Q:BHLED=""
  1. . I BHLEXD="" S BHLEXD=9999999
  1. . Q:BHLED>BHL("VDT")
  1. . Q:BHLEXD<BHL("VDT")
  1. . S INDA(9000005.11,BHLDA)=""
  1. Q
  1. ;