BHLXAC.m

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       ;