Routine: BHLQRF

BHLQRF ; cmi/sitka/maw - BHL Supplement QRF Segment ;

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

 ;This routine will supplement the QRF Segment which further

 ;refines the query statement.

MAIN ;-- this is the main routine driver

 S INA("INQWHERE")="IMMUNIZATION"

 S INA("INQWHICH")="ANY"

 S INA("INQSDTM")=$G(INA("QBDT"))

 S INA("INQEDTM")=$G(INA("QEDT"))

 D OSF

OSF ;-- build the other query subject filter

 S BHLQDA=0 F  S BHLQDA=$O(INA("QNM",BHLQDA)) Q:'BHLQDA  D

 . S BHLQSSN=$$VALI^XBDIQ1(2,BHLQDA,.09)

 . S BHLQDOB=$$DATE^INHUT($$VALI^XBDIQ1(2,BHLQDA,.03))

 . S BHLQBST=$S($$VALI^XBDIQ1(2,BHLQDA,.093):$P($G(^DIC(5,$$VALI^XBDIQ1(2,BHLQDA,.093),0)),U,2),1:"")

 . S BHLQBCN=$$VAL^XBDIQ1(9000001,BHLQDA,1105)

 . S BHLQMCN=""

 . S BHLQMMNM=$S($$VALI^XBDIQ1(2,BHLQDA,.2402):$$PN^INHUT($$VAL^XBDIQ1(2,BHLQDA,.2402)),1:"")

 . S BHLQMMN=$P($$VAL^XBDIQ1(2,BHLQDA,.2403),",")

 . S BHLQMSSN=""

 . S BHLQFNM=$S($$VALI^XBDIQ1(2,BHLQDA,.2401):$$PN^INHUT($$VAL^XBDIQ1(2,BHLQDA,.2401)),1:"")

 . S BHLQFSSN=""

 . S INA("INQOSF")=BHLQSSN_RS_BHLQDOB_RS_BHLQBST_RS_BHLQBCN

 . S INA("INQOSF")=INA("INQOSF")_RS_BHLQMCN_RS_BHLQMMNM_RS_BHLQMMN_RS

 . S INA("INQOSF")=INA("INQOSF")_BHLQMSSN_RS_BHLQFNM_RS_BHLQFSSN

BHLQRF    ; cmi/sitka/maw - BHL Supplement QRF Segment ;

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

 +2       ;

 +3       ;This routine will supplement the QRF Segment which further

 +4       ;refines the query statement.

 +5       ;

MAIN      ;-- this is the main routine driver

 +1        SET INA("INQWHERE")="IMMUNIZATION"

 +2        SET INA("INQWHICH")="ANY"

 +3        SET INA("INQSDTM")=$GET(INA("QBDT"))

 +4        SET INA("INQEDTM")=$GET(INA("QEDT"))

 +5        DO OSF

 +6        QUIT

 +7       ;

OSF       ;-- build the other query subject filter

 +1        SET BHLQDA=0

FOR

               SET BHLQDA=$ORDER(INA("QNM",BHLQDA))

               IF 'BHLQDA

                   QUIT

               Begin DoDot:1

 +2                SET BHLQSSN=$$VALI^XBDIQ1(2,BHLQDA,.09)

 +3                SET BHLQDOB=$$DATE^INHUT($$VALI^XBDIQ1(2,BHLQDA,.03))

 +4                SET BHLQBST=$SELECT($$VALI^XBDIQ1(2,BHLQDA,.093):$PIECE($GET(^DIC(5,$$VALI^XBDIQ1(2,BHLQDA,.093),0)),U,2),1:"")

 +5                SET BHLQBCN=$$VAL^XBDIQ1(9000001,BHLQDA,1105)

 +6                SET BHLQMCN=""

 +7                SET BHLQMMNM=$SELECT($$VALI^XBDIQ1(2,BHLQDA,.2402):$$PN^INHUT($$VAL^XBDIQ1(2,BHLQDA,.2402)),1:"")

 +8                SET BHLQMMN=$PIECE($$VAL^XBDIQ1(2,BHLQDA,.2403),",")

 +9                SET BHLQMSSN=""

 +10               SET BHLQFNM=$SELECT($$VALI^XBDIQ1(2,BHLQDA,.2401):$$PN^INHUT($$VAL^XBDIQ1(2,BHLQDA,.2401)),1:"")

 +11               SET BHLQFSSN=""

 +12               SET INA("INQOSF")=BHLQSSN_RS_BHLQDOB_RS_BHLQBST_RS_BHLQBCN

 +13               SET INA("INQOSF")=INA("INQOSF")_RS_BHLQMCN_RS_BHLQMMNM_RS_BHLQMMN_RS

 +14               SET INA("INQOSF")=INA("INQOSF")_BHLQMSSN_RS_BHLQFNM_RS_BHLQFSSN

               End DoDot:1

 +15       QUIT

 +16      ;

BHLQRF.m