BHLERR.m

BHLERR ; cmi/flag/maw - BHL HL7 Error Processing ; 

 ;;3.01;BHL IHS Interfaces with GIS;**2**;OCT 15, 2002

 ;

 ;this routine will handle error processing for HL7 messages

 ;

TRAP ;-- file the error

 I BHLERCD="GEN" D

 . S BHLGERR="Error filing field "_$$BHLFLD(BHLEFL,BHLFLD)_" in file "_$$BHLFL(BHLEFL)

 S BHLERIEN=$O(^BHLEM("B",BHLERCD,0))

 Q:'$G(BHLERIEN)

 S BHLERT=$S(BHLERCD="GEN":BHLGERR,1:$G(^BHLEM(BHLERIEN,1)))

 I $P(^BHLEM(BHLERIEN,0),U,2)="W" S BHLERR("WARNING")=BHLERT

 I $P(^BHLEM(BHLERIEN,0),U,2)="F" S BHLERR("FATAL")=BHLERT

 S BHLVAL=$S($G(BHLVAL):$P(BHLVAL,CS),1:"NO DATA VALUE")

 D ERR

 K BHLERCD,BHLERT

 Q

 ;

ERR ;-- this acutally files the error

 Q:'$G(BHLUIF)

 K DD,DO

 D NOW^%DTC S Y=% X ^DD("DD") S BHLNOW=Y

 S DIC="^BHLERR(",DIC(0)="L"

 S DIC("DR")=".02///"_$G(BHLRAP)_";.03///"_$G(BHPSAP)

 S DIC("DR")=DIC("DR")_";.04///"_$G(BHLRAF)_";.05///"_$G(BHLSAF)

 S DIC("DR")=DIC("DR")_";.06///"_$G(BHLRTN)_";.07///"_$G(BHLNOW)

 S DIC("DR")=DIC("DR")_";.08////"_$G(BHLERIEN)_";.09///"_$G(BHLERT)

 S DIC("DR")=DIC("DR")_";1///"_$G(BHLVAL)

 S X=BHLUIF

 D FILE^DICN

 Q

 ;

BHLFLD(BHLDIE,BHLDR)         ;get field name

 S BHLFNM=$P(^DD(BHLDIE,BHLDR,0),U)

 Q BHLFNM

 ;

BHLFL(BHLDIE)      ;get file name

 S BHLFLNM=$O(^DD(BHLDIE,0,"NM",0))

 Q BHLFLNM

 ;

BHLERR    ; cmi/flag/maw - BHL HL7 Error Processing ; 

 +1       ;;3.01;BHL IHS Interfaces with GIS;**2**;OCT 15, 2002

 +2       ;

 +3       ;this routine will handle error processing for HL7 messages

 +4       ;

TRAP      ;-- file the error

 +1        IF BHLERCD="GEN"

               Begin DoDot:1

 +2                SET BHLGERR="Error filing field "_$$BHLFLD(BHLEFL,BHLFLD)_" in file "_$$BHLFL(BHLEFL)

               End DoDot:1

 +3        SET BHLERIEN=$ORDER(^BHLEM("B",BHLERCD,0))

 +4        IF '$GET(BHLERIEN)

               QUIT 

 +5        SET BHLERT=$SELECT(BHLERCD="GEN":BHLGERR,1:$GET(^BHLEM(BHLERIEN,1)))

 +6        IF $PIECE(^BHLEM(BHLERIEN,0),U,2)="W"

               SET BHLERR("WARNING")=BHLERT

 +7        IF $PIECE(^BHLEM(BHLERIEN,0),U,2)="F"

               SET BHLERR("FATAL")=BHLERT

 +8        SET BHLVAL=$SELECT($GET(BHLVAL):$PIECE(BHLVAL,CS),1:"NO DATA VALUE")

 +9        DO ERR

 +10       KILL BHLERCD,BHLERT

 +11       QUIT 

 +12      ;

ERR       ;-- this acutally files the error

 +1        IF '$GET(BHLUIF)

               QUIT 

 +2        KILL DD,DO

 +3        DO NOW^%DTC

           SET Y=%

           XECUTE ^DD("DD")

           SET BHLNOW=Y

 +4        SET DIC="^BHLERR("

           SET DIC(0)="L"

 +5        SET DIC("DR")=".02///"_$GET(BHLRAP)_";.03///"_$GET(BHPSAP)

 +6        SET DIC("DR")=DIC("DR")_";.04///"_$GET(BHLRAF)_";.05///"_$GET(BHLSAF)

 +7        SET DIC("DR")=DIC("DR")_";.06///"_$GET(BHLRTN)_";.07///"_$GET(BHLNOW)

 +8        SET DIC("DR")=DIC("DR")_";.08////"_$GET(BHLERIEN)_";.09///"_$GET(BHLERT)

 +9        SET DIC("DR")=DIC("DR")_";1///"_$GET(BHLVAL)

 +10       SET X=BHLUIF

 +11       DO FILE^DICN

 +12       QUIT 

 +13      ;

BHLFLD(BHLDIE,BHLDR) ;get field name

 +1        SET BHLFNM=$PIECE(^DD(BHLDIE,BHLDR,0),U)

 +2        QUIT BHLFNM

 +3       ;

BHLFL(BHLDIE) ;get file name

 +1        SET BHLFLNM=$ORDER(^DD(BHLDIE,0,"NM",0))

 +2        QUIT BHLFLNM

 +3       ;