BHLOBRX.m

BHLOBRX ; cmi/sitka/maw - BHL GIS OBR/OBX Segment setup ; 

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;;

 ;

 ;this routine will setup all the necessary INDA arrays for the

 ;OBR/OBX segments

 ;

MAIN ;-- this is the main routine driver

 Q:BHL("VIEN")=""

 S BHLFNUM=9000010

 F   S BHLFNUM=$O(^DIC(BHLFNUM)) Q:BHLFNUM>9000010.99  D

 . S BHLG=$G(^DIC(BHLFNUM,0,"GL"))

 . S BHLGBAD=BHLG_"""AD"",BHL(""VIEN""),BHLIEN)"

 . S BHLCNT=0

 . S BHLIEN=0 F  S BHLIEN=$O(@BHLGBAD) Q:'BHLIEN  D

 .. S BHLCNT=BHLCNT+1

 .. S INDA(BHLFNUM,BHLCNT)=BHLIEN

 Q

 ;

MSR ;-- setup variables form MSR

 K BHL("VALI"),BHL("VALN"),BHL("VALC")

 S BHL("FNUM")=9000010.01

 S BHL("VALI")=$$VALI^XBDIQ1(9000010.01,INDA,.01)

 S BHL("VALN")=$$VAL^XBDIQ1(9000010.01,INDA,.01)

 S BHL("VALC")=$S(BHL("VALI")'="":$$VAL^XBDIQ1(9999999.07,BHL("VALI"),.02),1:"")

 D REST

 Q

 ;

EYE ;-- setup variables form EYE

 K BHL("VALI"),BHL("VALN"),BHL("VALC")

 S BHL("FNUM")=9000010.04

 D REST

 Q

 ;

LAB ;-- setup variables form LAB

 K BHL("VALI"),BHL("VALN"),BHL("VALC")

 S BHL("FNUM")=9000010.09

 S BHL("VALI")=$$VALI^XBDIQ1(9000010.09,INDA,.01)

 S BHL("VALN")=$$VAL^XBDIQ1(9000010.09,INDA,.01)

 S BHL("VALC")="LAB"

 D REST

 Q

 ;

SK ;-- setup variables form SK

 K BHL("VALI"),BHL("VALN"),BHL("VALC")

 S BHL("FNUM")=9000010.12

 S BHL("VALI")=$$VALI^XBDIQ1(9000010.12,INDA,.01)

 S BHL("VALN")=$$VAL^XBDIQ1(9999999.28,INDA,.01)

 S BHL("VALC")=$$VAL^XBDIQ1(9999999.07,BHL("VALI"),.02)

 D REST

 Q

 ;

XAM ;-- setup variables form XAM

 K BHL("VALI"),BHL("VALN"),BHL("VALC")

 S BHL("FNUM")=9000010.13

 S BHL("VALI")=$$VALI^XBDIQ1(9000010.13,INDA,.01)

 S BHL("VALN")=$$VAL^XBDIQ1(9000010.13,INDA,.01)

 S BHL("VALC")=$$VAL^XBDIQ1(9999999.15,BHL("VALI"),.02)

 D REST

 Q

 ;

TRT ;-- setup variables form TRT 

 K BHL("VALI"),BHL("VALN"),BHL("VALC")

 S BHL("FNUM")=9000010.15

 S BHL("VALI")=$$VALI^XBDIQ1(9000010.15,INDA,.01)

 S BHL("VALN")=$$VAL^XBDIQ1(9000010.15,INDA,.01)

 S BHL("VALC")=$$VAL^XBDIQ1(9999999.17,BHL("VALI"),.02)

 D REST

 Q

 ;

PED ;-- setup variables form PED

 K BHL("VALI"),BHL("VALN"),BHL("VALC")

 S BHL("FNUM")=9000010.16

 S BHL("VALI")=$$VALI^XBDIQ1(9000010.16,INDA,.01)

 S BHL("VALN")=$$VAL^XBDIQ1(9000010.16,INDA,.01)

 S BHL("VALC")=$$VAL^XBDIQ1(9999999.09,BHL("VALI"),.02)

 D REST

 Q

 ;

PT ;-- setup variables form PT

 K BHL("VALI"),BHL("VALN"),BHL("VALC")

 S BHL("FNUM")=9000010.17

 S BHL("VALI")=$$VALI^XBDIQ1(9000010.17,INDA,.01)

 S BHL("VALN")=$$VAL^XBDIQ1(9000010.17,INDA,.01)

 S BHL("VALC")=$$VAL^XBDIQ1(9999999.46,BHL("VALI"),1)

 D REST

 Q

 ;

CPT ;-- setup variables form CPT

 K BHL("VALI"),BHL("VALN"),BHL("VALC")

 S BHL("FNUM")=9000010.18

 S BHL("VALI")=$$VALI^XBDIQ1(9000010.18,INDA,.01)

 S BHL("VALN")=$$VAL^XBDIQ1(9000010.18,INDA,.01)

 S BHL("VALC")=$$VAL^XBDIQ1(81,BHL("VALI"),2)

 D REST

 Q

 ;

DXP ;-- setup variables form DXP

 K BHL("VALI"),BHL("VALN"),BHL("VALC")

 S BHL("FNUM")=9000010.21

 S BHL("VALI")=$$VALI^XBDIQ1(9000010.21,INDA,.01)

 S BHL("VALN")=$$VAL^XBDIQ1(9000010.21,INDA,.01)

 S BHL("VALC")=$$VAL^XBDIQ1(9999999.68,BHL("VALI"),.01)

 D REST

 Q

 ;

RAD ;-- setup variables form RAD

 K BHL("VALI"),BHL("VALN"),BHL("VALC")

 S BHL("FNUM")=9000010.22

 S BHL("VALI")=$$VALI^XBDIQ1(9000010.22,INDA,.01)

 S BHL("VALN")=$$VAL^XBDIQ1(9000010.22,INDA,.01)

 S BHL("VALC")=$$VAL^XBDIQ1(71,BHL("VALI"),9)

 D REST

 Q

 ;

HF ;-- setup variables form HF

 K BHL("VALI"),BHL("VALN"),BHL("VALC")

 S BHL("FNUM")=9000010.23

 S BHL("VALI")=$$VALI^XBDIQ1(9000010.23,INDA,.01)

 S BHL("VALN")=$$VAL^XBDIQ1(9000010.23,INDA,.01)

 S BHL("VALC")=$$VAL^XBDIQ1(9999999.64,BHL("VALI"),.02)

 D REST

 Q

 ;

REST ;-- common variables for OBR/OBX

 S BHL("FNM")=$P($G(^DIC(BHL("FNUM"),0)),U)

 S BHL("FABB")=$E($P($G(^DIC(BHL("FNUM"),0,"GL")),"("),7,9)

 Q

 ;

BHLOBRX   ; cmi/sitka/maw - BHL GIS OBR/OBX Segment setup ; 

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;;

 +3       ;

 +4       ;this routine will setup all the necessary INDA arrays for the

 +5       ;OBR/OBX segments

 +6       ;

MAIN      ;-- this is the main routine driver

 +1        IF BHL("VIEN")=""

               QUIT 

 +2        SET BHLFNUM=9000010

 +3        FOR 

               SET BHLFNUM=$ORDER(^DIC(BHLFNUM))

               IF BHLFNUM>9000010.99

                   QUIT 

               Begin DoDot:1

 +4                SET BHLG=$GET(^DIC(BHLFNUM,0,"GL"))

 +5                SET BHLGBAD=BHLG_"""AD"",BHL(""VIEN""),BHLIEN)"

 +6                SET BHLCNT=0

 +7                SET BHLIEN=0

                   FOR 

                       SET BHLIEN=$ORDER(@BHLGBAD)

                       IF 'BHLIEN

                           QUIT 

                       Begin DoDot:2

 +8                        SET BHLCNT=BHLCNT+1

 +9                        SET INDA(BHLFNUM,BHLCNT)=BHLIEN

                       End DoDot:2

               End DoDot:1

 +10       QUIT 

 +11      ;

MSR       ;-- setup variables form MSR

 +1        KILL BHL("VALI"),BHL("VALN"),BHL("VALC")

 +2        SET BHL("FNUM")=9000010.01

 +3        SET BHL("VALI")=$$VALI^XBDIQ1(9000010.01,INDA,.01)

 +4        SET BHL("VALN")=$$VAL^XBDIQ1(9000010.01,INDA,.01)

 +5        SET BHL("VALC")=$SELECT(BHL("VALI")'="":$$VAL^XBDIQ1(9999999.07,BHL("VALI"),.02),1:"")

 +6        DO REST

 +7        QUIT 

 +8       ;

EYE       ;-- setup variables form EYE

 +1        KILL BHL("VALI"),BHL("VALN"),BHL("VALC")

 +2        SET BHL("FNUM")=9000010.04

 +3        DO REST

 +4        QUIT 

 +5       ;

LAB       ;-- setup variables form LAB

 +1        KILL BHL("VALI"),BHL("VALN"),BHL("VALC")

 +2        SET BHL("FNUM")=9000010.09

 +3        SET BHL("VALI")=$$VALI^XBDIQ1(9000010.09,INDA,.01)

 +4        SET BHL("VALN")=$$VAL^XBDIQ1(9000010.09,INDA,.01)

 +5        SET BHL("VALC")="LAB"

 +6        DO REST

 +7        QUIT 

 +8       ;

SK        ;-- setup variables form SK

 +1        KILL BHL("VALI"),BHL("VALN"),BHL("VALC")

 +2        SET BHL("FNUM")=9000010.12

 +3        SET BHL("VALI")=$$VALI^XBDIQ1(9000010.12,INDA,.01)

 +4        SET BHL("VALN")=$$VAL^XBDIQ1(9999999.28,INDA,.01)

 +5        SET BHL("VALC")=$$VAL^XBDIQ1(9999999.07,BHL("VALI"),.02)

 +6        DO REST

 +7        QUIT 

 +8       ;

XAM       ;-- setup variables form XAM

 +1        KILL BHL("VALI"),BHL("VALN"),BHL("VALC")

 +2        SET BHL("FNUM")=9000010.13

 +3        SET BHL("VALI")=$$VALI^XBDIQ1(9000010.13,INDA,.01)

 +4        SET BHL("VALN")=$$VAL^XBDIQ1(9000010.13,INDA,.01)

 +5        SET BHL("VALC")=$$VAL^XBDIQ1(9999999.15,BHL("VALI"),.02)

 +6        DO REST

 +7        QUIT 

 +8       ;

TRT       ;-- setup variables form TRT 

 +1        KILL BHL("VALI"),BHL("VALN"),BHL("VALC")

 +2        SET BHL("FNUM")=9000010.15

 +3        SET BHL("VALI")=$$VALI^XBDIQ1(9000010.15,INDA,.01)

 +4        SET BHL("VALN")=$$VAL^XBDIQ1(9000010.15,INDA,.01)

 +5        SET BHL("VALC")=$$VAL^XBDIQ1(9999999.17,BHL("VALI"),.02)

 +6        DO REST

 +7        QUIT 

 +8       ;

PED       ;-- setup variables form PED

 +1        KILL BHL("VALI"),BHL("VALN"),BHL("VALC")

 +2        SET BHL("FNUM")=9000010.16

 +3        SET BHL("VALI")=$$VALI^XBDIQ1(9000010.16,INDA,.01)

 +4        SET BHL("VALN")=$$VAL^XBDIQ1(9000010.16,INDA,.01)

 +5        SET BHL("VALC")=$$VAL^XBDIQ1(9999999.09,BHL("VALI"),.02)

 +6        DO REST

 +7        QUIT 

 +8       ;

PT        ;-- setup variables form PT

 +1        KILL BHL("VALI"),BHL("VALN"),BHL("VALC")

 +2        SET BHL("FNUM")=9000010.17

 +3        SET BHL("VALI")=$$VALI^XBDIQ1(9000010.17,INDA,.01)

 +4        SET BHL("VALN")=$$VAL^XBDIQ1(9000010.17,INDA,.01)

 +5        SET BHL("VALC")=$$VAL^XBDIQ1(9999999.46,BHL("VALI"),1)

 +6        DO REST

 +7        QUIT 

 +8       ;

CPT       ;-- setup variables form CPT

 +1        KILL BHL("VALI"),BHL("VALN"),BHL("VALC")

 +2        SET BHL("FNUM")=9000010.18

 +3        SET BHL("VALI")=$$VALI^XBDIQ1(9000010.18,INDA,.01)

 +4        SET BHL("VALN")=$$VAL^XBDIQ1(9000010.18,INDA,.01)

 +5        SET BHL("VALC")=$$VAL^XBDIQ1(81,BHL("VALI"),2)

 +6        DO REST

 +7        QUIT 

 +8       ;

DXP       ;-- setup variables form DXP

 +1        KILL BHL("VALI"),BHL("VALN"),BHL("VALC")

 +2        SET BHL("FNUM")=9000010.21

 +3        SET BHL("VALI")=$$VALI^XBDIQ1(9000010.21,INDA,.01)

 +4        SET BHL("VALN")=$$VAL^XBDIQ1(9000010.21,INDA,.01)

 +5        SET BHL("VALC")=$$VAL^XBDIQ1(9999999.68,BHL("VALI"),.01)

 +6        DO REST

 +7        QUIT 

 +8       ;

RAD       ;-- setup variables form RAD

 +1        KILL BHL("VALI"),BHL("VALN"),BHL("VALC")

 +2        SET BHL("FNUM")=9000010.22

 +3        SET BHL("VALI")=$$VALI^XBDIQ1(9000010.22,INDA,.01)

 +4        SET BHL("VALN")=$$VAL^XBDIQ1(9000010.22,INDA,.01)

 +5        SET BHL("VALC")=$$VAL^XBDIQ1(71,BHL("VALI"),9)

 +6        DO REST

 +7        QUIT 

 +8       ;

HF        ;-- setup variables form HF

 +1        KILL BHL("VALI"),BHL("VALN"),BHL("VALC")

 +2        SET BHL("FNUM")=9000010.23

 +3        SET BHL("VALI")=$$VALI^XBDIQ1(9000010.23,INDA,.01)

 +4        SET BHL("VALN")=$$VAL^XBDIQ1(9000010.23,INDA,.01)

 +5        SET BHL("VALC")=$$VAL^XBDIQ1(9999999.64,BHL("VALI"),.02)

 +6        DO REST

 +7        QUIT 

 +8       ;

REST      ;-- common variables for OBR/OBX

 +1        SET BHL("FNM")=$PIECE($GET(^DIC(BHL("FNUM"),0)),U)

 +2        SET BHL("FABB")=$EXTRACT($PIECE($GET(^DIC(BHL("FNUM"),0,"GL")),"("),7,9)

 +3        QUIT 

 +4       ;