BHLQRD.m

BHLQRD ; cmi/sitka/maw - BHL Outbound QRD Segment Supplement ; 

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

 ;

 ;this routine will supplement an outbound QRD segment based on the

 ;information obtained from user input (BHLIQUI)

 ;

MAIN ;-- setup the variables for the QRD segment

 D NOW^%DTC S BHLQNOW=%

 S INA("INQDTM")=BHLQNOW

 S INA("INQPRI")="I"

 S INA("INQTAG")=$G(INA("MESSID"))

 S INA("INQWHAT")="VXI"

 S INA("INQTY")=$G(INA("QTY"))

 D WHO

 Q

 ;

WHO ;-- get the necessary information to build a who string (QRD-9)

 ;support for multiples built in

 S BHLQCNT=0

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

 . S BHLQCNT=BHLQCNT+1

 . S BHLQNM=$G(INA("QNM",BHLQDA))

 . S BHLQNM=$$PN^INHUT(BHLQNM)

 . S BHLQRN=$$HRN^AUPNPAT(BHLQDA,DUZ(2))

 . S BHLQASU=$$VAL^XBDIQ1(9999999.06,DUZ(2),.12)

 . S $P(INA("INQWHO"),RS,BHLQCNT)=BHLQASU_BHLQRN_CS_BHLQNM

 Q

 ;

BHLQRD    ; cmi/sitka/maw - BHL Outbound QRD Segment Supplement ; 

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

 +2       ;

 +3       ;this routine will supplement an outbound QRD segment based on the

 +4       ;information obtained from user input (BHLIQUI)

 +5       ;

MAIN      ;-- setup the variables for the QRD segment

 +1        DO NOW^%DTC

           SET BHLQNOW=%

 +2        SET INA("INQDTM")=BHLQNOW

 +3        SET INA("INQPRI")="I"

 +4        SET INA("INQTAG")=$GET(INA("MESSID"))

 +5        SET INA("INQWHAT")="VXI"

 +6        SET INA("INQTY")=$GET(INA("QTY"))

 +7        DO WHO

 +8        QUIT 

 +9       ;

WHO       ;-- get the necessary information to build a who string (QRD-9)

 +1       ;support for multiples built in

 +2        SET BHLQCNT=0

 +3        SET BHLQDA=0

           FOR 

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

               IF 'BHLQDA

                   QUIT 

               Begin DoDot:1

 +4                SET BHLQCNT=BHLQCNT+1

 +5                SET BHLQNM=$GET(INA("QNM",BHLQDA))

 +6                SET BHLQNM=$$PN^INHUT(BHLQNM)

 +7                SET BHLQRN=$$HRN^AUPNPAT(BHLQDA,DUZ(2))

 +8                SET BHLQASU=$$VAL^XBDIQ1(9999999.06,DUZ(2),.12)

 +9                SET $PIECE(INA("INQWHO"),RS,BHLQCNT)=BHLQASU_BHLQRN_CS_BHLQNM

               End DoDot:1

 +10       QUIT 

 +11      ;