BHLZ01I.m

BHLZ01I ;cmi/sitka/maw - Process Inbound Z01 Event  

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

 ;

 ;

 ;this routine will process the inbound ihs drug file update

 ;

MAIN ;-- this is the main routine driver

 D ^BHLSETI

 S INA("MFAERR")="S"

 S INA("MCID")=$G(INV("MSH10"))

 S INA("KTYP")="CE"

 D MFI

 D MFE

 I BHLNDC="" S INA("MFAERR")="U" D ACK,EOJ^BHLSETI Q

 D ZFD

 D LOOK

 Q:'$L($T(@BHLMWT))

 D @BHLMWT

 D ACK

 D EOJ^BHLSETI

 Q

 ;

MFI ;-- get data out of MFI segment

 S INA("MFI")=$G(INV("MFI1"))

 Q

 ;

MFE ;-- get data out of MFE segment

 S INA("DORLE")=$G(INV("MFE1"))

 S INA("PRIMKEY")=$G(INV("MFE4"))

 S BHLMWT=$G(INA("DORLE"))

 S BHLNDCE=$P(INA("PRIMKEY"),CS)

 Q:BHLNDCE=""

 S BHLNDC=$P(BHLNDCE,"-")_$P(BHLNDCE,"-",2)_$P(BHLNDCE,"-",3)

 Q

 ;

ZFD ;-- get data out of ZFD segment

 S BHLDGN=$G(INV("ZFD1"))

 S BHLWL=$G(INV("ZFD2"))

 S BHLMXD=$G(INV("ZFD3"))

 S BHLDEAS=$G(INV("ZFD4"))

 S BHLSSIG=$G(INV("ZFD5"))

 S BHLOU=$G(INV("ZFD6"))

 S BHLPPOU=$G(INV("ZFD7"))

 S BHLDU=$G(INV("ZFD8"))

 S BHLPPDU=$G(INV("ZFD9"))

 S BHLDUPOU=$G(INV("ZFD10"))

 S BHLNF=$G(INV("ZFD11"))

 S BHLIAD=$G(INV("ZFD12"))

 S BHLMSGE=$G(INV("ZFD13"))

 S BHLCHEMO=$G(INV("ZFD14"))

 Q

 ;

LOOK ;-- look up the entry in the drug file

 S BHLDIEN=$O(^PSDRUG("ZNDC",BHLNDC,0))

 Q

 ;

MUP ;-- update the drug file or add if not existent

 I 'BHLDIEN D  Q

 . S DIC=50,DIC(0)="L",X=BHLDGN

 . S DIC("DR")="3///"_BHLDEAS_";4///"_BHLMXD_";5///"_BHLSSIG

 . S DIC("DR")=DIC("DR")_";8///"_BHLWL_";12///"_BHLOU_";12///"_BHLOU

 . S DIC("DR")=DIC("DR")_";13///"_BHLPPOU_";14.5///"_BHLDU

 . S DIC("DR")=DIC("DR")_";15///"_BHLDUPOU_";16///"_BHLPPDU

 . S DIC("DR")=DIC("DR")_";51///"_BHLNF_";100///"_BHLIAD

 . S DIC("DR")=DIC("DR")_";101///"_BHLMSGE_";202///"_BHLCHEMO

 . D FILE^DICN

 . I Y<0 S INA("MFAERR")="U"

 S DIE=50,DA=BHLDIEN

 S DR="3///"_BHLDEAS_";4///"_BHLMXD_";5///"_BHLSSIG

 S DR=DR_";8///"_BHLWL_";12///"_BHLOU_";12///"_BHLOU

 S DR=DR_";13///"_BHLPPOU_";14.5///"_BHLDU

 S DR=DR_";15///"_BHLDUPOU_";16///"_BHLPPDU

 S DR=DR_";51///"_BHLNF_";100///"_BHLIAD

 S DR=DR_";101///"_BHLMSGE_";202///"_BHLCHEMO

 D ^DIE

 I $D(Y) S INA("MFAERR")="U"

 Q

 ;

MDL ;-- delete the record (deactivate)

 D MDC

 Q

 ;

MDC ;-- deactivate the record

 I 'BHLDIEN S Y=-1 Q

 S DIE=50,DA=BHLDIEN,DR="100///"_BHLIAD

 D ^DIE

 I $D(Y) S INA("MFAERR")="U"

 Q

 ;

ACK ;-- send the acknowledgement event

 S INA("INORIGID")=$G(INV("MSH10"))

 S INA("INSTAT")=$S(INA("MFAERR")="U":"AE",1:"AA")

 S INDA=$S(BHLDIEN:BHLDIEN,1:1)

 S X="BHL ACK DRUG MASTER TABLE UPDATE",DIC=101 D EN^XQOR

 Q

 ;

BHLZ01I   ;cmi/sitka/maw - Process Inbound Z01 Event  

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

 +2       ;

 +3       ;

 +4       ;this routine will process the inbound ihs drug file update

 +5       ;

MAIN      ;-- this is the main routine driver

 +1        DO ^BHLSETI

 +2        SET INA("MFAERR")="S"

 +3        SET INA("MCID")=$GET(INV("MSH10"))

 +4        SET INA("KTYP")="CE"

 +5        DO MFI

 +6        DO MFE

 +7        IF BHLNDC=""

               SET INA("MFAERR")="U"

               DO ACK

               DO EOJ^BHLSETI

               QUIT 

 +8        DO ZFD

 +9        DO LOOK

 +10       IF '$LENGTH($TEXT(@BHLMWT))

               QUIT 

 +11       DO @BHLMWT

 +12       DO ACK

 +13       DO EOJ^BHLSETI

 +14       QUIT 

 +15      ;

MFI       ;-- get data out of MFI segment

 +1        SET INA("MFI")=$GET(INV("MFI1"))

 +2        QUIT 

 +3       ;

MFE       ;-- get data out of MFE segment

 +1        SET INA("DORLE")=$GET(INV("MFE1"))

 +2        SET INA("PRIMKEY")=$GET(INV("MFE4"))

 +3        SET BHLMWT=$GET(INA("DORLE"))

 +4        SET BHLNDCE=$PIECE(INA("PRIMKEY"),CS)

 +5        IF BHLNDCE=""

               QUIT 

 +6        SET BHLNDC=$PIECE(BHLNDCE,"-")_$PIECE(BHLNDCE,"-",2)_$PIECE(BHLNDCE,"-",3)

 +7        QUIT 

 +8       ;

ZFD       ;-- get data out of ZFD segment

 +1        SET BHLDGN=$GET(INV("ZFD1"))

 +2        SET BHLWL=$GET(INV("ZFD2"))

 +3        SET BHLMXD=$GET(INV("ZFD3"))

 +4        SET BHLDEAS=$GET(INV("ZFD4"))

 +5        SET BHLSSIG=$GET(INV("ZFD5"))

 +6        SET BHLOU=$GET(INV("ZFD6"))

 +7        SET BHLPPOU=$GET(INV("ZFD7"))

 +8        SET BHLDU=$GET(INV("ZFD8"))

 +9        SET BHLPPDU=$GET(INV("ZFD9"))

 +10       SET BHLDUPOU=$GET(INV("ZFD10"))

 +11       SET BHLNF=$GET(INV("ZFD11"))

 +12       SET BHLIAD=$GET(INV("ZFD12"))

 +13       SET BHLMSGE=$GET(INV("ZFD13"))

 +14       SET BHLCHEMO=$GET(INV("ZFD14"))

 +15       QUIT 

 +16      ;

LOOK      ;-- look up the entry in the drug file

 +1        SET BHLDIEN=$ORDER(^PSDRUG("ZNDC",BHLNDC,0))

 +2        QUIT 

 +3       ;

MUP       ;-- update the drug file or add if not existent

 +1        IF 'BHLDIEN

               Begin DoDot:1

 +2                SET DIC=50

                   SET DIC(0)="L"

                   SET X=BHLDGN

 +3                SET DIC("DR")="3///"_BHLDEAS_";4///"_BHLMXD_";5///"_BHLSSIG

 +4                SET DIC("DR")=DIC("DR")_";8///"_BHLWL_";12///"_BHLOU_";12///"_BHLOU

 +5                SET DIC("DR")=DIC("DR")_";13///"_BHLPPOU_";14.5///"_BHLDU

 +6                SET DIC("DR")=DIC("DR")_";15///"_BHLDUPOU_";16///"_BHLPPDU

 +7                SET DIC("DR")=DIC("DR")_";51///"_BHLNF_";100///"_BHLIAD

 +8                SET DIC("DR")=DIC("DR")_";101///"_BHLMSGE_";202///"_BHLCHEMO

 +9                DO FILE^DICN

 +10               IF Y<0

                       SET INA("MFAERR")="U"

               End DoDot:1

               QUIT 

 +11       SET DIE=50

           SET DA=BHLDIEN

 +12       SET DR="3///"_BHLDEAS_";4///"_BHLMXD_";5///"_BHLSSIG

 +13       SET DR=DR_";8///"_BHLWL_";12///"_BHLOU_";12///"_BHLOU

 +14       SET DR=DR_";13///"_BHLPPOU_";14.5///"_BHLDU

 +15       SET DR=DR_";15///"_BHLDUPOU_";16///"_BHLPPDU

 +16       SET DR=DR_";51///"_BHLNF_";100///"_BHLIAD

 +17       SET DR=DR_";101///"_BHLMSGE_";202///"_BHLCHEMO

 +18       DO ^DIE

 +19       IF $DATA(Y)

               SET INA("MFAERR")="U"

 +20       QUIT 

 +21      ;

MDL       ;-- delete the record (deactivate)

 +1        DO MDC

 +2        QUIT 

 +3       ;

MDC       ;-- deactivate the record

 +1        IF 'BHLDIEN

               SET Y=-1

               QUIT 

 +2        SET DIE=50

           SET DA=BHLDIEN

           SET DR="100///"_BHLIAD

 +3        DO ^DIE

 +4        IF $DATA(Y)

               SET INA("MFAERR")="U"

 +5        QUIT 

 +6       ;

ACK       ;-- send the acknowledgement event

 +1        SET INA("INORIGID")=$GET(INV("MSH10"))

 +2        SET INA("INSTAT")=$SELECT(INA("MFAERR")="U":"AE",1:"AA")

 +3        SET INDA=$SELECT(BHLDIEN:BHLDIEN,1:1)

 +4        SET X="BHL ACK DRUG MASTER TABLE UPDATE"

           SET DIC=101

           DO EN^XQOR

 +5        QUIT 

 +6       ;