BHLXAC ; cmi/flag/maw - BHL Autocreate X12 fields, segs, msgs ;
;;3.01;BHL IHS Interfaces with GIS;**2**;OCT 15, 2002
;
;
;
;this routine will read in a spreadsheet of an X12 message spec
;create the fields with data locations, add the fields to the
;appropriate segment, then add the appropriate segment to the
;appropriate message.
;
MAIN ;-- this is the main routine driver
S C=","
S BHLXFNM=$$FASK
Q:$G(BHLXFNM)=""
S BHLXMSG=$E($P(BHLXFNM,U,2),4,6)
Q:BHLXMSG'?.N
S BHLXIN=$$IN
D READ($P(BHLXFNM,U),$P(BHLXFNM,U,2),BHLXMSG)
Q:$G(BHLXNF)
D EOJ
Q
;
ASK() ;-- ask the type of message
S DIR(0)="F^3:3",DIR("A")="What is the X12 message type "
D ^DIR
K DIR
I $D(DIRUT) Q ""
Q Y
;
FASK() ;-- file name
S DIR(0)="F",DIR("A")="What is the directory to load from"
D ^DIR
K DIR
I $D(DIRUT) Q ""
S BHLXDIR=Y
K Y
S DIR(0)="F",DIR("A")="What is the filename to load from"
D ^DIR
K DIR
I $D(DIRUT) Q ""
Q BHLXDIR_U_Y
;
IN() ;-- ask if this is an inbound message
S DIR(0)="Y",DIR("A")="Is this an inbound message "
D ^DIR
K DIR
I $D(DIRUT) Q ""
Q Y
;
READ(DIR,FNM,MSG) ;-- read in the file and start creating
S BHLXP="X1 IHS "_MSG
N Y
S BHLXY=$$OPEN^%ZISH(DIR,FNM,"R")
I +$G(Y) S BHLXNF=1 Q
S BHLXMI=$O(^INTHL7M("B",BHLXP,0))
I 'BHLXMI S BHLXMI=$$MADD(BHLXP)
F BHLI=1:1 U IO R BHLX:DTIME D Q:BHLX=""
. Q:BHLX=""
. S LOOP=$P(BHLX,C)
. I LOOP="" S LOOP="HF"
. S SEG=$P(BHLX,C,2)
. S FLDS=$P(BHLX,C,5)
. S RPT=$S($P(BHLX,C,6)'="":1,1:0)
. S SEQ=$P(BHLX,C,7)
. S BHLXSEG=$$SADD(BHLXP,LOOP,SEG,SEQ)
. S BHLXMG=$$MSGADD(BHLXMI,BHLXSEG,SEQ,RPT,BHLXIN)
. F BHLJ=1:1:FLDS D Q:BHLJ=""
.. Q:BHLJ=""
.. S BHLAFLD=$$FLDADD(BHLXP,LOOP,SEG,BHLJ,BHLXSEG,MSG)
.. S BHLXSEGE=$$SEGADD(BHLXSEG,BHLJ,BHLAFLD)
Q
;
SADD(XP,LP,SG,SQ) ;-- add the segment
S X=XP_" "_LP_" "_SG_" "_SQ
I $O(^INTHL7S("B",X,0)) Q $O(^INTHL7S("B",X,0))
K DD,DO
S DIC="^INTHL7S(",DIC(0)="L"
S DIC("DR")=".02///"_$E(SG,1,3)
D FILE^DICN
Q +Y
;
FLDADD(XP,LP,SG,LJ,XSG,MG) ;-- add the field
S X=XP_" "_LP_" "_SG_" "_LJ
I $O(^INTHL7F("B",X,0)) Q $O(^INTHL7F("B",X,0))
K DD,DO,DIC
S DIC(0)="AEMLQZ",DIC="^INTHL7F("
S DTL="@"_MG_LP_SG_LJ
S DIC("DR")=".02///STRING;.03///999;3///"_DTL
D FILE^DICN
Q +$G(Y)
;
MADD(MSG) ;-- add the message
K DD,DO,DIC
S DIC="^INTHL7M(",DIC(0)="L",X=MSG
S DIC("DR")=".12///X12"
D FILE^DICN
Q +Y
;
SEGADD(ASEG,ASEQ,AFLD) ;-- add the field to the segment
S X=AFLD
I $O(^INTHL7S("FIELD",AFLD,ASEG,0)) Q $O(^INTHL7S("FIELD",AFLD,ASEG,0))
K DD,DO,DIC
S DA(1)=ASEG
S DIC="^INTHL7S("_ASEG_",1,",DIC(0)="L"
S DIC("P")=$P(^DD(4010,1,0),"^",2)
S DIC("DR")=".02///"_ASEQ
D FILE^DICN
Q +$G(Y)
;
MSGADD(MMSG,MSEG,MSEQ,MRPT,IN) ;-- add the segment to the message
I $O(^INTHL7M("SEG",MSEG,MMSG,0)) Q $O(^INTHL7M("SEG",MSEG,MMSG,0))
K DD,DO,DIC
S DA(1)=MMSG
S DIC="^INTHL7M("_MMSG_",1,",DIC(0)="L"
S DIC("P")=$P(^DD(4011,1,0),"^",2)
S X=MSEG
S DIC("DR")=".02///"_MSEQ_";.03///"_MRPT
I $G(IN) S DIC("DR")=DIC("DR")_";.07///PARSE;.12///FILLER"
D FILE^DICN
Q +$G(Y)
;
EOJ ;-- kill variables and quit
D ^%ZISC
D EN^XBVK("BHL")
Q
;
BHLXAC ; cmi/flag/maw - BHL Autocreate X12 fields, segs, msgs ;
+1 ;;3.01;BHL IHS Interfaces with GIS;**2**;OCT 15, 2002
+2 ;
+3 ;
+4 ;
+5 ;this routine will read in a spreadsheet of an X12 message spec
+6 ;create the fields with data locations, add the fields to the
+7 ;appropriate segment, then add the appropriate segment to the
+8 ;appropriate message.
+9 ;
MAIN ;-- this is the main routine driver
+1 SET C=","
+2 SET BHLXFNM=$$FASK
+3 IF $GET(BHLXFNM)=""
QUIT
+4 SET BHLXMSG=$EXTRACT($PIECE(BHLXFNM,U,2),4,6)
+5 IF BHLXMSG'?.N
QUIT
+6 SET BHLXIN=$$IN
+7 DO READ($PIECE(BHLXFNM,U),$PIECE(BHLXFNM,U,2),BHLXMSG)
+8 IF $GET(BHLXNF)
QUIT
+9 DO EOJ
+10 QUIT
+11 ;
ASK() ;-- ask the type of message
+1 SET DIR(0)="F^3:3"
SET DIR("A")="What is the X12 message type "
+2 DO ^DIR
+3 KILL DIR
+4 IF $DATA(DIRUT)
QUIT ""
+5 QUIT Y
+6 ;
FASK() ;-- file name
+1 SET DIR(0)="F"
SET DIR("A")="What is the directory to load from"
+2 DO ^DIR
+3 KILL DIR
+4 IF $DATA(DIRUT)
QUIT ""
+5 SET BHLXDIR=Y
+6 KILL Y
+7 SET DIR(0)="F"
SET DIR("A")="What is the filename to load from"
+8 DO ^DIR
+9 KILL DIR
+10 IF $DATA(DIRUT)
QUIT ""
+11 QUIT BHLXDIR_U_Y
+12 ;
IN() ;-- ask if this is an inbound message
+1 SET DIR(0)="Y"
SET DIR("A")="Is this an inbound message "
+2 DO ^DIR
+3 KILL DIR
+4 IF $DATA(DIRUT)
QUIT ""
+5 QUIT Y
+6 ;
READ(DIR,FNM,MSG) ;-- read in the file and start creating
+1 SET BHLXP="X1 IHS "_MSG
+2 NEW Y
+3 SET BHLXY=$$OPEN^%ZISH(DIR,FNM,"R")
+4 IF +$GET(Y)
SET BHLXNF=1
QUIT
+5 SET BHLXMI=$ORDER(^INTHL7M("B",BHLXP,0))
+6 IF 'BHLXMI
SET BHLXMI=$$MADD(BHLXP)
+7 FOR BHLI=1:1
USE IO
READ BHLX:DTIME
Begin DoDot:1
+8 IF BHLX=""
QUIT
+9 SET LOOP=$PIECE(BHLX,C)
+10 IF LOOP=""
SET LOOP="HF"
+11 SET SEG=$PIECE(BHLX,C,2)
+12 SET FLDS=$PIECE(BHLX,C,5)
+13 SET RPT=$SELECT($PIECE(BHLX,C,6)'="":1,1:0)
+14 SET SEQ=$PIECE(BHLX,C,7)
+15 SET BHLXSEG=$$SADD(BHLXP,LOOP,SEG,SEQ)
+16 SET BHLXMG=$$MSGADD(BHLXMI,BHLXSEG,SEQ,RPT,BHLXIN)
+17 FOR BHLJ=1:1:FLDS
Begin DoDot:2
+18 IF BHLJ=""
QUIT
+19 SET BHLAFLD=$$FLDADD(BHLXP,LOOP,SEG,BHLJ,BHLXSEG,MSG)
+20 SET BHLXSEGE=$$SEGADD(BHLXSEG,BHLJ,BHLAFLD)
End DoDot:2
IF BHLJ=""
QUIT
End DoDot:1
IF BHLX=""
QUIT
+21 QUIT
+22 ;
SADD(XP,LP,SG,SQ) ;-- add the segment
+1 SET X=XP_" "_LP_" "_SG_" "_SQ
+2 IF $ORDER(^INTHL7S("B",X,0))
QUIT $ORDER(^INTHL7S("B",X,0))
+3 KILL DD,DO
+4 SET DIC="^INTHL7S("
SET DIC(0)="L"
+5 SET DIC("DR")=".02///"_$EXTRACT(SG,1,3)
+6 DO FILE^DICN
+7 QUIT +Y
+8 ;
FLDADD(XP,LP,SG,LJ,XSG,MG) ;-- add the field
+1 SET X=XP_" "_LP_" "_SG_" "_LJ
+2 IF $ORDER(^INTHL7F("B",X,0))
QUIT $ORDER(^INTHL7F("B",X,0))
+3 KILL DD,DO,DIC
+4 SET DIC(0)="AEMLQZ"
SET DIC="^INTHL7F("
+5 SET DTL="@"_MG_LP_SG_LJ
+6 SET DIC("DR")=".02///STRING;.03///999;3///"_DTL
+7 DO FILE^DICN
+8 QUIT +$GET(Y)
+9 ;
MADD(MSG) ;-- add the message
+1 KILL DD,DO,DIC
+2 SET DIC="^INTHL7M("
SET DIC(0)="L"
SET X=MSG
+3 SET DIC("DR")=".12///X12"
+4 DO FILE^DICN
+5 QUIT +Y
+6 ;
SEGADD(ASEG,ASEQ,AFLD) ;-- add the field to the segment
+1 SET X=AFLD
+2 IF $ORDER(^INTHL7S("FIELD",AFLD,ASEG,0))
QUIT $ORDER(^INTHL7S("FIELD",AFLD,ASEG,0))
+3 KILL DD,DO,DIC
+4 SET DA(1)=ASEG
+5 SET DIC="^INTHL7S("_ASEG_",1,"
SET DIC(0)="L"
+6 SET DIC("P")=$PIECE(^DD(4010,1,0),"^",2)
+7 SET DIC("DR")=".02///"_ASEQ
+8 DO FILE^DICN
+9 QUIT +$GET(Y)
+10 ;
MSGADD(MMSG,MSEG,MSEQ,MRPT,IN) ;-- add the segment to the message
+1 IF $ORDER(^INTHL7M("SEG",MSEG,MMSG,0))
QUIT $ORDER(^INTHL7M("SEG",MSEG,MMSG,0))
+2 KILL DD,DO,DIC
+3 SET DA(1)=MMSG
+4 SET DIC="^INTHL7M("_MMSG_",1,"
SET DIC(0)="L"
+5 SET DIC("P")=$PIECE(^DD(4011,1,0),"^",2)
+6 SET X=MSEG
+7 SET DIC("DR")=".02///"_MSEQ_";.03///"_MRPT
+8 IF $GET(IN)
SET DIC("DR")=DIC("DR")_";.07///PARSE;.12///FILLER"
+9 DO FILE^DICN
+10 QUIT +$GET(Y)
+11 ;
EOJ ;-- kill variables and quit
+1 DO ^%ZISC
+2 DO EN^XBVK("BHL")
+3 QUIT
+4 ;
