- 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 ;