BHLIN1.m

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      ;