BHLNK1I ; cmi/sitka/maw - BHL Process Inbound NK1 Segment ;
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;
;this routine will file the inbound NK1 segment
;
MAIN ;-- this is the main routine driver
D PROCESS,EOJ
Q
;
PROCESS ;-- let's go through and setup the data by relationship type
S BHLDA=0 F S BHLDA=$O(@BHLTMP@(BHLDA)) Q:BHLDA="" D
. S BHLCR=$P($G(@BHLTMP@(BHLDA,7)),CS,2)
. Q:BHLCR=""
. S BHLNM=$G(@BHLTMP@(BHLDA,2))
. Q:BHLNM=""
. S BHLREL=$P($G(@BHLTMP@(BHLDA,3)),CS,2)
. Q:BHLREL=""
. S BHLST1=$P($G(@BHLTMP@(BHLDA,4)),CS)
. S BHLST2=$P($G(@BHLTMP@(BHLDA,4)),CS,2)
. S BHLCTY=$P($G(@BHLTMP@(BHLDA,4)),CS,3)
. S BHLST=$P($G(@BHLTMP@(BHLDA,4)),CS,4)
. S BHLST=$S(BHLST'="":$O(^DIC(5,"C",BHLST,0)),1:"")
. S BHLZIP=$P($G(@BHLTMP@(BHLDA,4)),CS,5)
. S BHLPH=$G(@BHLTMP@(BHLDA,5))
. I BHLCR="SELF" D
.. S BHLCR="SELF"
.. S BHLEN=$G(@BHLTMP@(BHLDA,13))
.. S BHLES=$G(@BHLTMP@(BHLDA,34))
. I BHLCR="SPOUSE" D
.. S BHLEN=$G(@BHLTMP@(BHLDA,13))
. I BHLCR="EMERGENCY CONTACT" S BHLCR="EC"
. I BHLCR="NEXT OF KIN" S BHLCR="NOK"
. Q:'$L($T(@BHLCR))
. D @BHLCR
Q
;
EC ;-- file emergency contact
S BHLX=BHLPAT
S BHLFL=2,BHLFLD=.331,BHLVAL=BHLNM X BHLDIE
;S BHLFLD=.332,BHLVAL=BHLREL X BHLDIE ;gets triggered from 9000001
S BHLFLD=.333,BHLVAL=BHLST1 X BHLDIE
S BHLFLD=.334,BHLVAL=BHLST2 X BHLDIE
S BHLFLD=.336,BHLVAL=BHLCTY X BHLDIE
S BHLFLD=.337,BHLVAL=BHLST X BHLDIE
S BHLFLD=.338,BHLVAL=BHLZIP X BHLDIE
S BHLFLD=.339,BHLVAL=BHLPH X BHLDIE
S BHLFL=9000001,BHLFLD=3102,BHLVAL=BHLREL X BHLDIE
Q
;
NOK ;-- file next of kin
S BHLFL=2,BHLFLD=.211,BHLVAL=BHLNM,BHLX=BHLPAT X BHLDIE
;S BHLFLD=.212,BHLVAL=BHLREL X BHLDIE ;gets triggered from 9000001
S BHLFLD=.213,BHLVAL=BHLST1 X BHLDIE
S BHLFLD=.214,BHLVAL=BHLST2 X BHLDIE
S BHLFLD=.216,BHLVAL=BHLCTY X BHLDIE
S BHLFLD=.217,BHLVAL=BHLST X BHLDIE
S BHLFLD=.218,BHLVAL=BHLZIP X BHLDIE
S BHLFLD=.219,BHLVAL=BHLPH X BHLDIE
S BHLFL=9000001,BHLFLD=2802,BHLVAL=BHLREL X BHLDIE
Q
;
SELF ;-- file self
S BHLFL=9000001,BHLFLD=.19,BHLVAL=BHLEN,BHLX=BHLPAT X BHLDIE
S BHLFLD=.21,BHLVAL=BHLES X BHLDIE
Q
;
SPOUSE ;-- file spouse
S BHLFL=9000001,BHLFLD=.22,BHLVAL=BHLEN,BHLX=BHLPAT X BHLDIE
Q
;
EOJ ;-- kill variables and quit
K @BHLTMP
K BHLDA,BHLNM,BHLCR,BHLREL,BHLST1,BHLST2,BHLCTY,BHLST,BHLZIP,BHLPH
K BHLEN,BHLES,BHLFL,BHLFLD,BHLVAL,BHLX
Q
;
BHLNK1I ; cmi/sitka/maw - BHL Process Inbound NK1 Segment ;
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;
+3 ;this routine will file the inbound NK1 segment
+4 ;
MAIN ;-- this is the main routine driver
+1 DO PROCESS
DO EOJ
+2 QUIT
+3 ;
PROCESS ;-- let's go through and setup the data by relationship type
+1 SET BHLDA=0
FOR
SET BHLDA=$ORDER(@BHLTMP@(BHLDA))
IF BHLDA=""
QUIT
Begin DoDot:1
+2 SET BHLCR=$PIECE($GET(@BHLTMP@(BHLDA,7)),CS,2)
+3 IF BHLCR=""
QUIT
+4 SET BHLNM=$GET(@BHLTMP@(BHLDA,2))
+5 IF BHLNM=""
QUIT
+6 SET BHLREL=$PIECE($GET(@BHLTMP@(BHLDA,3)),CS,2)
+7 IF BHLREL=""
QUIT
+8 SET BHLST1=$PIECE($GET(@BHLTMP@(BHLDA,4)),CS)
+9 SET BHLST2=$PIECE($GET(@BHLTMP@(BHLDA,4)),CS,2)
+10 SET BHLCTY=$PIECE($GET(@BHLTMP@(BHLDA,4)),CS,3)
+11 SET BHLST=$PIECE($GET(@BHLTMP@(BHLDA,4)),CS,4)
+12 SET BHLST=$SELECT(BHLST'="":$ORDER(^DIC(5,"C",BHLST,0)),1:"")
+13 SET BHLZIP=$PIECE($GET(@BHLTMP@(BHLDA,4)),CS,5)
+14 SET BHLPH=$GET(@BHLTMP@(BHLDA,5))
+15 IF BHLCR="SELF"
Begin DoDot:2
+16 SET BHLCR="SELF"
+17 SET BHLEN=$GET(@BHLTMP@(BHLDA,13))
+18 SET BHLES=$GET(@BHLTMP@(BHLDA,34))
End DoDot:2
+19 IF BHLCR="SPOUSE"
Begin DoDot:2
+20 SET BHLEN=$GET(@BHLTMP@(BHLDA,13))
End DoDot:2
+21 IF BHLCR="EMERGENCY CONTACT"
SET BHLCR="EC"
+22 IF BHLCR="NEXT OF KIN"
SET BHLCR="NOK"
+23 IF '$LENGTH($TEXT(@BHLCR))
QUIT
+24 DO @BHLCR
End DoDot:1
+25 QUIT
+26 ;
EC ;-- file emergency contact
+1 SET BHLX=BHLPAT
+2 SET BHLFL=2
SET BHLFLD=.331
SET BHLVAL=BHLNM
XECUTE BHLDIE
+3 ;S BHLFLD=.332,BHLVAL=BHLREL X BHLDIE ;gets triggered from 9000001
+4 SET BHLFLD=.333
SET BHLVAL=BHLST1
XECUTE BHLDIE
+5 SET BHLFLD=.334
SET BHLVAL=BHLST2
XECUTE BHLDIE
+6 SET BHLFLD=.336
SET BHLVAL=BHLCTY
XECUTE BHLDIE
+7 SET BHLFLD=.337
SET BHLVAL=BHLST
XECUTE BHLDIE
+8 SET BHLFLD=.338
SET BHLVAL=BHLZIP
XECUTE BHLDIE
+9 SET BHLFLD=.339
SET BHLVAL=BHLPH
XECUTE BHLDIE
+10 SET BHLFL=9000001
SET BHLFLD=3102
SET BHLVAL=BHLREL
XECUTE BHLDIE
+11 QUIT
+12 ;
NOK ;-- file next of kin
+1 SET BHLFL=2
SET BHLFLD=.211
SET BHLVAL=BHLNM
SET BHLX=BHLPAT
XECUTE BHLDIE
+2 ;S BHLFLD=.212,BHLVAL=BHLREL X BHLDIE ;gets triggered from 9000001
+3 SET BHLFLD=.213
SET BHLVAL=BHLST1
XECUTE BHLDIE
+4 SET BHLFLD=.214
SET BHLVAL=BHLST2
XECUTE BHLDIE
+5 SET BHLFLD=.216
SET BHLVAL=BHLCTY
XECUTE BHLDIE
+6 SET BHLFLD=.217
SET BHLVAL=BHLST
XECUTE BHLDIE
+7 SET BHLFLD=.218
SET BHLVAL=BHLZIP
XECUTE BHLDIE
+8 SET BHLFLD=.219
SET BHLVAL=BHLPH
XECUTE BHLDIE
+9 SET BHLFL=9000001
SET BHLFLD=2802
SET BHLVAL=BHLREL
XECUTE BHLDIE
+10 QUIT
+11 ;
SELF ;-- file self
+1 SET BHLFL=9000001
SET BHLFLD=.19
SET BHLVAL=BHLEN
SET BHLX=BHLPAT
XECUTE BHLDIE
+2 SET BHLFLD=.21
SET BHLVAL=BHLES
XECUTE BHLDIE
+3 QUIT
+4 ;
SPOUSE ;-- file spouse
+1 SET BHLFL=9000001
SET BHLFLD=.22
SET BHLVAL=BHLEN
SET BHLX=BHLPAT
XECUTE BHLDIE
+2 QUIT
+3 ;
EOJ ;-- kill variables and quit
+1 KILL @BHLTMP
+2 KILL BHLDA,BHLNM,BHLCR,BHLREL,BHLST1,BHLST2,BHLCTY,BHLST,BHLZIP,BHLPH
+3 KILL BHLEN,BHLES,BHLFL,BHLFLD,BHLVAL,BHLX
+4 QUIT
+5 ;
