BHLRXDI.m

BHLRXDI ; cmi/sitka/maw - BHL File Inbound RXD Segment ; 

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

 ;

 ;this routine will file the inbound RXD Segment, it is called from

 ;VMED^BHLORCI

 ;

 Q

 ;

VMED ;EP - get v medication data

 N BHLR

 S BHLR="RXD"

 S BHLMED=$P($G(@BHLTMP@(BHLDA,2)),CS,2)

 Q:BHLMED=""

 S BHLMEDI=$O(^PSDRUG("B",BHLMED,0))

 K BHLMTCH

 S BHLMDA=0 F  S BHLMDA=$O(^AUPNVMED("AD",BHLVSIT,BHLMDA)) Q:BHLMDA=""!($D(BHLMEDE))  D

 . I $P(^AUPNVMED(BHLMDA,0),U)=BHLMEDI S BHLMTCH=1 Q

 Q:$D(BHLMTCH)

 S BHLDTD=$G(@BHLTMP@(BHLDA,3))

 S BHLNTD=$P($G(@BHLTMP@(BHLDA,2)),CS,5)

 S BHLRXN=$G(@BHLTMP@(BHLDA,7))

 S APCDALVR("APCDTRX")=BHLMED

 S APCDALVR("APCDTCDT")=BHLDTD

 S APCDALVR("APCDTNTD")=BHLNTD

 S APCDALVR("APCDTEXK")=BHLRXN

 Q

 ;

BHLRXDI   ; cmi/sitka/maw - BHL File Inbound RXD Segment ; 

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

 +2       ;

 +3       ;this routine will file the inbound RXD Segment, it is called from

 +4       ;VMED^BHLORCI

 +5       ;

 +6        QUIT 

 +7       ;

VMED      ;EP - get v medication data

 +1        NEW BHLR

 +2        SET BHLR="RXD"

 +3        SET BHLMED=$PIECE($GET(@BHLTMP@(BHLDA,2)),CS,2)

 +4        IF BHLMED=""

               QUIT 

 +5        SET BHLMEDI=$ORDER(^PSDRUG("B",BHLMED,0))

 +6        KILL BHLMTCH

 +7        SET BHLMDA=0

           FOR 

               SET BHLMDA=$ORDER(^AUPNVMED("AD",BHLVSIT,BHLMDA))

               IF BHLMDA=""!($DATA(BHLMEDE))

                   QUIT 

               Begin DoDot:1

 +8                IF $PIECE(^AUPNVMED(BHLMDA,0),U)=BHLMEDI

                       SET BHLMTCH=1

                       QUIT 

               End DoDot:1

 +9        IF $DATA(BHLMTCH)

               QUIT 

 +10       SET BHLDTD=$GET(@BHLTMP@(BHLDA,3))

 +11       SET BHLNTD=$PIECE($GET(@BHLTMP@(BHLDA,2)),CS,5)

 +12       SET BHLRXN=$GET(@BHLTMP@(BHLDA,7))

 +13       SET APCDALVR("APCDTRX")=BHLMED

 +14       SET APCDALVR("APCDTCDT")=BHLDTD

 +15       SET APCDALVR("APCDTNTD")=BHLNTD

 +16       SET APCDALVR("APCDTEXK")=BHLRXN

 +17       QUIT 

 +18      ;