BHLRXAI.m

BHLRXAI ; cmi/sitka/maw - BHL File Inbound RXA Segment ; 

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

 ;

 ;this routine will file the inbound RXA segment it is called from

 ;VIMM^BHLORCI

 ;

 Q

 ;

VIMM ;EP - v immunization

 N BHLR

 S BHLR="RXA"

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

 Q:BHLIMM=""

 S BHLIMMI=$O(^AUTTIMM("B",BHLIMM,0))

 K BHLMTCH

 S BHLIDA=0 F  S BHLIDA=$O(^AUPNVIMM("AD",BHLVSIT,BHLIDA)) Q:BHLIDA=""!($D(BHLIMME))  D

 . I $P(^AUPNVIMM(BHLIDA,0),U)=BHLIMMI S BHLMTCH=1 Q

 Q:$D(BHLMTCH)

 S BHLLOT=$G(@BHLTMP@(BHLDA,15))

 S APCDALVR("APCDTIMM")=BHLIMM

 S APCDALVR("APCDTLOT")=BHLLOT

 Q

 ;

BHLRXAI   ; cmi/sitka/maw - BHL File Inbound RXA Segment ; 

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

 +2       ;

 +3       ;this routine will file the inbound RXA segment it is called from

 +4       ;VIMM^BHLORCI

 +5       ;

 +6        QUIT 

 +7       ;

VIMM      ;EP - v immunization

 +1        NEW BHLR

 +2        SET BHLR="RXA"

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

 +4        IF BHLIMM=""

               QUIT 

 +5        SET BHLIMMI=$ORDER(^AUTTIMM("B",BHLIMM,0))

 +6        KILL BHLMTCH

 +7        SET BHLIDA=0

           FOR 

               SET BHLIDA=$ORDER(^AUPNVIMM("AD",BHLVSIT,BHLIDA))

               IF BHLIDA=""!($DATA(BHLIMME))

                   QUIT 

               Begin DoDot:1

 +8                IF $PIECE(^AUPNVIMM(BHLIDA,0),U)=BHLIMMI

                       SET BHLMTCH=1

                       QUIT 

               End DoDot:1

 +9        IF $DATA(BHLMTCH)

               QUIT 

 +10       SET BHLLOT=$GET(@BHLTMP@(BHLDA,15))

 +11       SET APCDALVR("APCDTIMM")=BHLIMM

 +12       SET APCDALVR("APCDTLOT")=BHLLOT

 +13       QUIT 

 +14      ;