PRCHJS05 ;OI&T/KCL - IFCAP/ECMS INTERFACE 2237 SEND SEG BUILDERS;6/12/12
;;5.1;IFCAP;**167,174**;Oct 20, 2000;Build 23
;Per VHA Directive 2004-38, this routine should not be modified.
;
ORC(PRCWRK,PRCHLO,PRCER,PRCTOARY) ;Build ORC segment
;This function builds the ORC segment and adds it
;to the msg being built using HLO APIs. Any data
;manipulation or conversions are performed as needed.
;
; Supported ICR:
; #10060: Allows retrieval of NAME (#.01) field from
; NEW PERSON (#200) file using FM read.
;
; Input:
; PRCWRK - (required) name of work global containing 2237 data elements
; PRCHLO - (required) HLO workspace used to build message, pass by ref
;
; Output:
; Function value - returns 1 on success, 0 on failure
; PRCER - (optional) on failure, an error message is returned, pass by ref
; PRCTOARY - (optional, pass by ref) returns the built segment in this format:
; PRCTOARY(1)
;
N PRCSEG ;contains the segment's data
N PRCNAME ;input array for $$HLNAME^XLFNAME
N PRCNCOMP ;name components in HL7 format
N PRCRSLT ;function result
;
;init vars
K PRCSEG S PRCSEG="" ;the segment should start off blank
S PRCNAME("FIELD")=.01
S PRCNAME("FILE")=200
S PRCRSLT=1
;
D SET^HLOAPI(.PRCSEG,"ORC",0)
D SET^HLOAPI(.PRCSEG,"NW",1) ;new order/service
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("TRANUM")),U,2),2,1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("PRI")),U,1),5)
D SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($P($G(@PRCWRK@("RQSTDT")),U,1)),9,1)
;
;get Accountable Officer name components
S PRCNAME("IENS")=$P($G(@PRCWRK@("AO")),U,1)_","
S PRCNCOMP=$$HLNAME^XLFNAME(.PRCNAME)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("AO")),U,1),11,1) ;duz
D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,1),11,2,1) ;last
D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,2),11,3) ;first
D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,3),11,4) ;middle
D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,4),11,5) ;suffix
;
D SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($P($G(@PRCWRK@("AOESIG")),U,1)),11,19,1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("AOTITLE")),U,2),11,21)
;
;get Requestor name components
S PRCNAME("IENS")=$P($G(@PRCWRK@("REQ")),U,1)_","
S PRCNCOMP=$$HLNAME^XLFNAME(.PRCNAME)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("REQ")),U,1),12,1) ;duz
D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,1),12,2,1) ;last
D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,2),12,3) ;first
D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,3),12,4) ;middle
D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,4),12,5) ;suffix
;
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("REQTITLE")),U,2),12,21)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("INVPT")),U,2),17,1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("INVABREV")),U,2),17,2)
;
;get Approving Official name components
S PRCNAME("IENS")=$P($G(@PRCWRK@("APOF")),U,1)_","
S PRCNCOMP=$$HLNAME^XLFNAME(.PRCNAME)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("APOF")),U,1),19,1) ;duz
D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,1),19,2,1) ;last
D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,2),19,3) ;first
D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,3),19,4) ;middle
D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,4),19,5) ;suffix
;
D SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($P($G(@PRCWRK@("ESIGDT")),U,1)),19,19,1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("APOFTIT")),U,2),19,21)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("RQSRV")),U,2),21,1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("STANUM")),U,2),21,3)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("SUBSTA")),U,2),21,8,2)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("DELIVTO")),U,2),22,1,1)
D SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($P($G(@PRCWRK@("DTREQ")),U,1)),27,1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("FRMTYP")),U,1),29,1)
;
;add segment to message being built
I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY) D
. S PRCRSLT=0
. S PRCER="ORC segment not built"
;
Q PRCRSLT
;
;
TQ1(PRCWRK,PRCHLO,PRCLINE,PRCER) ;Build TQ1 segment
;This function builds a TQ1 segment for each delivery
;schedule associated with a line item and adds it to
;the msg being built using HLO APIs. Any data manipulation
;or conversions are performed as needed.
;
; Input:
; PRCWRK - (required) name of work global containing 2237 data elements
; PRCHLO - (required) HLO workspace used to build message, pass by ref
; PRCLINE - (required) line item number
;
; Output:
; Function value - returns 1 on success, 0 on failure
; PRCER - (optional) on failure, an error message is returned, pass by ref
;
N PRCSEG ;contains the segment's data
N PRCSUB ;array subscript
N PRCRSLT ;function result
;
;init vars
K PRCSEG S PRCSEG="" ;the segment should start off blank
S PRCLINE=+$G(PRCLINE)
S PRCSUB=0
S PRCRSLT=0
;
I PRCLINE'>0 S PRCER="TQ1 segment not built - no line item passed" Q PRCRSLT
I '$O(@PRCWRK@(PRCLINE,PRCSUB)) S PRCER="TQ1 segment not built - no delivery schedule for item" Q PRCRSLT
;
S PRCRSLT=1
;
;loop thru delivery schedules for the line item
F S PRCSUB=$O(@PRCWRK@(PRCLINE,PRCSUB)) Q:('$G(PRCSUB)!('PRCRSLT)) D
. D SET^HLOAPI(.PRCSEG,"TQ1",0)
. D SET^HLOAPI(.PRCSEG,PRCSUB,1) ;Delivery Schedule #
. D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,PRCSUB,"DELQTY")),U,2),2,1)
. D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"UNITNM")),U,2),2,2,1)
. D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"UNITFNM")),U,2),2,2,2)
. D SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($P($G(@PRCWRK@(PRCLINE,PRCSUB,"DELDT")),U)),7,1)
. D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,PRCSUB,"DELLOC")),U,2),10)
. D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,PRCSUB,"DELREF")),U,2),11)
. ;
. ;add segment to message being built
. I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER) D
. . S PRCRSLT=0
. . S PRCER="TQ1 segment not built"
;
Q PRCRSLT
;
;
RQD(PRCWRK,PRCHLO,PRCLINE,PRCER,PRCTOARY) ;Build RQD segment
;This function builds the RQD segment and adds it to the
;msg being built using HLO APIs. Any data manipulation
;or conversions are performed as needed.
;
; Input:
; PRCWRK - (required) name of work global containing 2237 data elements
; PRCHLO - (required) HLO workspace used to build message, pass by ref
; PRCLINE - (required) line item number
;
; Output:
; Function value - returns 1 on success, 0 on failure
; PRCER - (optional) on failure, an error message is returned, pass by ref
; PRCTOARY - (optional, pass by ref) returns the built segment in this format:
; PRCTOARY(1)
;
N PRCSEG ;contains the segment's data
N PRCRSLT ;function result
;
;init vars
K PRCSEG S PRCSEG="" ;the segment should start off blank
S PRCLINE=+$G(PRCLINE)
S PRCRSLT=0
;
I PRCLINE'>0 S PRCER="RQD segment not built - no line item passed" Q PRCRSLT
I +$G(@PRCWRK@(PRCLINE,"ITLINE"))'>0 S PRCER="RQD segment not built - line item not found" Q PRCRSLT
;
S PRCRSLT=1
;
D SET^HLOAPI(.PRCSEG,"RQD",0)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"ITLINE")),U,2),1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"ITMFN")),U,2),2,1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMNSN")),U,2),2,4)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMFSC")),U,2),2,5)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"ITSTOCK")),U,2),3,1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"ITQTY")),U,2),5)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"UNITNM")),U,2),6,1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"UNITFNM")),U,2),6,2)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMPKGM")),U,2),6,4)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("COSTCTR")),U,2),7)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"ITBOC")),U,2),8)
;
;add segment to message being built
I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY) D
. S PRCRSLT=0
. S PRCER="RQD segment not built"
;
Q PRCRSLT
;
;
RQ1(PRCWRK,PRCHLO,PRCLINE,PRCER,PRCTOARY) ;Build RQ1 segment
;This function builds the RQ1 segment and adds it to the
;msg being built using HLO APIs. Any data manipulation
;or conversions are performed as needed.
;
; Input:
; PRCWRK - (required) name of work global containing 2237 data elements
; PRCHLO - (required) HLO workspace used to build message, pass by ref
; PRCLINE - (required) line item number
;
; Output:
; Function value - returns 1 on success, 0 on failure
; PRCER - (optional) on failure, an error message is returned, pass by ref
; PRCTOARY - (optional, pass by ref) returns the built segment in this format:
; PRCTOARY(1)
;
N PRCSEG ;contains the segment's data
N PRCRSLT ;function result
;
;init vars
K PRCSEG S PRCSEG="" ;the segment should start off blank
S PRCLINE=+$G(PRCLINE)
S PRCRSLT=0
;
I PRCLINE'>0 S PRCER="RQ1 segment not built - no line item passed" Q PRCRSLT
I +$G(@PRCWRK@(PRCLINE,"ITLINE"))'>0 S PRCER="RQ1 segment not built - line item not found" Q PRCRSLT
;
S PRCRSLT=1
;
D SET^HLOAPI(.PRCSEG,"RQ1",0)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"ITCOST")),U,2),1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMMFG")),U,2),2,1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDPT")),U),4,1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDNM")),U,2),4,2)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMCTRCT")),U,2),4,4)
D SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($P($G(@PRCWRK@(PRCLINE,"IMEXPDT")),U,1)),4,5)
;
;add segment to message being built
I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY) D
. S PRCRSLT=0
. S PRCER="RQ1 segment not built"
;
Q PRCRSLT
;
;
ZA1(PRCWRK,PRCHLO,PRCLINE,PRCER,PRCTOARY) ;Build ZA1 segment
;This function builds the ZA1 segment and adds it to the
;msg being built using HLO APIs. Any data manipulation
;or conversions are performed as needed.
;
; Input:
; PRCWRK - (required) name of work global containing 2237 data elements
; PRCHLO - (required) HLO workspace used to build message, pass by ref
; PRCLINE - (required) line item number
;
; Output:
; Function value - returns 1 on success, 0 on failure
; PRCER - (optional) on failure, an error message is returned, pass by ref
; PRCTOARY - (optional, pass by ref) returns the built segment in this format:
; PRCTOARY(1)
;
N PRCSEG ;contains the segment's data
N PRCRSLT ;function result
;
K PRCSEG S PRCSEG="" ;the segment should start off blank
S PRCLINE=+$G(PRCLINE)
S PRCRSLT=0
;
I PRCLINE'>0 S PRCER="ZA1 segment not built - no line item passed" Q PRCRSLT
I +$G(@PRCWRK@(PRCLINE,"ITLINE"))'>0 S PRCER="ZA1 segment not built - line item not found" Q PRCRSLT
;
S PRCRSLT=1
;
D SET^HLOAPI(.PRCSEG,"ZA1",0)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMNDC")),U,2),1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMFOOD")),U,1),2)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMNIF")),U,2),3)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMMIN")),U,2),4)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMMAX")),U,2),5)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMREQ")),U,2),6)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMUCF")),U,2),7)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"ITDMID")),U,2),8)
;
;add segment to message being built
I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY) D
. S PRCRSLT=0
. S PRCER="ZA1 segment not built"
;
Q PRCRSLT
;
;
NTEITEM(PRCWRK,PRCHLO,PRCLINE,PRCER) ;Build NTE segments for item description
;This function builds repeating NTE segments for the
;description of the item being ordered and adds it
;to the msg being built using HLO APIs.
;
; Input:
; PRCWRK - (required) name of work global containing 2237 data elements
; PRCHLO - (required) HLO workspace used to build message, pass by ref
; PRCLINE - (required) line item number
;
; Output:
; Function value - returns 1 on success, 0 on failure
; PRCER - (optional) on failure, an error message is returned, pass by ref
;
N PRCSETID ;segment set id
N PRCSUB ;array subscript
N PRCSEG ;contains the segment's data
N PRCRSLT ;function result
;
;init vars
K PRCSEG S PRCSEG="" ;the segment should start off blank
S PRCLINE=+$G(PRCLINE)
S PRCRSLT=0
;
I PRCLINE'>0 S PRCER="NTE item segment not built - no line item passed" Q PRCRSLT
I +$G(@PRCWRK@(PRCLINE,"ITLINE"))'>0 S PRCER="NTE item segment not built - line item not found" Q PRCRSLT
;
S PRCRSLT=1
;
;loop thru Description nodes for the Line Item
S (PRCSUB,PRCSETID)=0
F S PRCSUB=$O(@PRCWRK@(PRCLINE,"ITDESC",PRCSUB)) Q:'$G(PRCSUB)!('PRCRSLT) D
. S PRCSETID=PRCSETID+1
. D SET^HLOAPI(.PRCSEG,"NTE",0)
. D SET^HLOAPI(.PRCSEG,PRCSETID,1)
. D SET^HLOAPI(.PRCSEG,"P",2) ;P for Placer (Orderer)
. D SET^HLOAPI(.PRCSEG,$G(@PRCWRK@(PRCLINE,"ITDESC",PRCSUB,0)),3)
. D SET^HLOAPI(.PRCSEG,"LD",4,1) ;LD for Line Item Description
. ;
. ;add segment to message being built
. I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER) D
. . S PRCRSLT=0
. . S PRCER="NTE segment not built"
;
Q PRCRSLT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHJS05 13106 printed Dec 13, 2024@02:08:17 Page 2
PRCHJS05 ;OI&T/KCL - IFCAP/ECMS INTERFACE 2237 SEND SEG BUILDERS;6/12/12
+1 ;;5.1;IFCAP;**167,174**;Oct 20, 2000;Build 23
+2 ;Per VHA Directive 2004-38, this routine should not be modified.
+3 ;
ORC(PRCWRK,PRCHLO,PRCER,PRCTOARY) ;Build ORC segment
+1 ;This function builds the ORC segment and adds it
+2 ;to the msg being built using HLO APIs. Any data
+3 ;manipulation or conversions are performed as needed.
+4 ;
+5 ; Supported ICR:
+6 ; #10060: Allows retrieval of NAME (#.01) field from
+7 ; NEW PERSON (#200) file using FM read.
+8 ;
+9 ; Input:
+10 ; PRCWRK - (required) name of work global containing 2237 data elements
+11 ; PRCHLO - (required) HLO workspace used to build message, pass by ref
+12 ;
+13 ; Output:
+14 ; Function value - returns 1 on success, 0 on failure
+15 ; PRCER - (optional) on failure, an error message is returned, pass by ref
+16 ; PRCTOARY - (optional, pass by ref) returns the built segment in this format:
+17 ; PRCTOARY(1)
+18 ;
+19 ;contains the segment's data
NEW PRCSEG
+20 ;input array for $$HLNAME^XLFNAME
NEW PRCNAME
+21 ;name components in HL7 format
NEW PRCNCOMP
+22 ;function result
NEW PRCRSLT
+23 ;
+24 ;init vars
+25 ;the segment should start off blank
KILL PRCSEG
SET PRCSEG=""
+26 SET PRCNAME("FIELD")=.01
+27 SET PRCNAME("FILE")=200
+28 SET PRCRSLT=1
+29 ;
+30 DO SET^HLOAPI(.PRCSEG,"ORC",0)
+31 ;new order/service
DO SET^HLOAPI(.PRCSEG,"NW",1)
+32 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("TRANUM")),U,2),2,1)
+33 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("PRI")),U,1),5)
+34 DO SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($PIECE($GET(@PRCWRK@("RQSTDT")),U,1)),9,1)
+35 ;
+36 ;get Accountable Officer name components
+37 SET PRCNAME("IENS")=$PIECE($GET(@PRCWRK@("AO")),U,1)_","
+38 SET PRCNCOMP=$$HLNAME^XLFNAME(.PRCNAME)
+39 ;duz
DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("AO")),U,1),11,1)
+40 ;last
DO SET^HLOAPI(.PRCSEG,$PIECE($GET(PRCNCOMP),U,1),11,2,1)
+41 ;first
DO SET^HLOAPI(.PRCSEG,$PIECE($GET(PRCNCOMP),U,2),11,3)
+42 ;middle
DO SET^HLOAPI(.PRCSEG,$PIECE($GET(PRCNCOMP),U,3),11,4)
+43 ;suffix
DO SET^HLOAPI(.PRCSEG,$PIECE($GET(PRCNCOMP),U,4),11,5)
+44 ;
+45 DO SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($PIECE($GET(@PRCWRK@("AOESIG")),U,1)),11,19,1)
+46 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("AOTITLE")),U,2),11,21)
+47 ;
+48 ;get Requestor name components
+49 SET PRCNAME("IENS")=$PIECE($GET(@PRCWRK@("REQ")),U,1)_","
+50 SET PRCNCOMP=$$HLNAME^XLFNAME(.PRCNAME)
+51 ;duz
DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("REQ")),U,1),12,1)
+52 ;last
DO SET^HLOAPI(.PRCSEG,$PIECE($GET(PRCNCOMP),U,1),12,2,1)
+53 ;first
DO SET^HLOAPI(.PRCSEG,$PIECE($GET(PRCNCOMP),U,2),12,3)
+54 ;middle
DO SET^HLOAPI(.PRCSEG,$PIECE($GET(PRCNCOMP),U,3),12,4)
+55 ;suffix
DO SET^HLOAPI(.PRCSEG,$PIECE($GET(PRCNCOMP),U,4),12,5)
+56 ;
+57 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("REQTITLE")),U,2),12,21)
+58 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("INVPT")),U,2),17,1)
+59 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("INVABREV")),U,2),17,2)
+60 ;
+61 ;get Approving Official name components
+62 SET PRCNAME("IENS")=$PIECE($GET(@PRCWRK@("APOF")),U,1)_","
+63 SET PRCNCOMP=$$HLNAME^XLFNAME(.PRCNAME)
+64 ;duz
DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("APOF")),U,1),19,1)
+65 ;last
DO SET^HLOAPI(.PRCSEG,$PIECE($GET(PRCNCOMP),U,1),19,2,1)
+66 ;first
DO SET^HLOAPI(.PRCSEG,$PIECE($GET(PRCNCOMP),U,2),19,3)
+67 ;middle
DO SET^HLOAPI(.PRCSEG,$PIECE($GET(PRCNCOMP),U,3),19,4)
+68 ;suffix
DO SET^HLOAPI(.PRCSEG,$PIECE($GET(PRCNCOMP),U,4),19,5)
+69 ;
+70 DO SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($PIECE($GET(@PRCWRK@("ESIGDT")),U,1)),19,19,1)
+71 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("APOFTIT")),U,2),19,21)
+72 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("RQSRV")),U,2),21,1)
+73 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("STANUM")),U,2),21,3)
+74 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("SUBSTA")),U,2),21,8,2)
+75 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("DELIVTO")),U,2),22,1,1)
+76 DO SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($PIECE($GET(@PRCWRK@("DTREQ")),U,1)),27,1)
+77 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("FRMTYP")),U,1),29,1)
+78 ;
+79 ;add segment to message being built
+80 IF '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY)
Begin DoDot:1
+81 SET PRCRSLT=0
+82 SET PRCER="ORC segment not built"
End DoDot:1
+83 ;
+84 QUIT PRCRSLT
+85 ;
+86 ;
TQ1(PRCWRK,PRCHLO,PRCLINE,PRCER) ;Build TQ1 segment
+1 ;This function builds a TQ1 segment for each delivery
+2 ;schedule associated with a line item and adds it to
+3 ;the msg being built using HLO APIs. Any data manipulation
+4 ;or conversions are performed as needed.
+5 ;
+6 ; Input:
+7 ; PRCWRK - (required) name of work global containing 2237 data elements
+8 ; PRCHLO - (required) HLO workspace used to build message, pass by ref
+9 ; PRCLINE - (required) line item number
+10 ;
+11 ; Output:
+12 ; Function value - returns 1 on success, 0 on failure
+13 ; PRCER - (optional) on failure, an error message is returned, pass by ref
+14 ;
+15 ;contains the segment's data
NEW PRCSEG
+16 ;array subscript
NEW PRCSUB
+17 ;function result
NEW PRCRSLT
+18 ;
+19 ;init vars
+20 ;the segment should start off blank
KILL PRCSEG
SET PRCSEG=""
+21 SET PRCLINE=+$GET(PRCLINE)
+22 SET PRCSUB=0
+23 SET PRCRSLT=0
+24 ;
+25 IF PRCLINE'>0
SET PRCER="TQ1 segment not built - no line item passed"
QUIT PRCRSLT
+26 IF '$ORDER(@PRCWRK@(PRCLINE,PRCSUB))
SET PRCER="TQ1 segment not built - no delivery schedule for item"
QUIT PRCRSLT
+27 ;
+28 SET PRCRSLT=1
+29 ;
+30 ;loop thru delivery schedules for the line item
+31 FOR
SET PRCSUB=$ORDER(@PRCWRK@(PRCLINE,PRCSUB))
if ('$GET(PRCSUB)!('PRCRSLT))
QUIT
Begin DoDot:1
+32 DO SET^HLOAPI(.PRCSEG,"TQ1",0)
+33 ;Delivery Schedule #
DO SET^HLOAPI(.PRCSEG,PRCSUB,1)
+34 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,PRCSUB,"DELQTY")),U,2),2,1)
+35 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"UNITNM")),U,2),2,2,1)
+36 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"UNITFNM")),U,2),2,2,2)
+37 DO SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($PIECE($GET(@PRCWRK@(PRCLINE,PRCSUB,"DELDT")),U)),7,1)
+38 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,PRCSUB,"DELLOC")),U,2),10)
+39 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,PRCSUB,"DELREF")),U,2),11)
+40 ;
+41 ;add segment to message being built
+42 IF '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER)
Begin DoDot:2
+43 SET PRCRSLT=0
+44 SET PRCER="TQ1 segment not built"
End DoDot:2
End DoDot:1
+45 ;
+46 QUIT PRCRSLT
+47 ;
+48 ;
RQD(PRCWRK,PRCHLO,PRCLINE,PRCER,PRCTOARY) ;Build RQD segment
+1 ;This function builds the RQD segment and adds it to the
+2 ;msg being built using HLO APIs. Any data manipulation
+3 ;or conversions are performed as needed.
+4 ;
+5 ; Input:
+6 ; PRCWRK - (required) name of work global containing 2237 data elements
+7 ; PRCHLO - (required) HLO workspace used to build message, pass by ref
+8 ; PRCLINE - (required) line item number
+9 ;
+10 ; Output:
+11 ; Function value - returns 1 on success, 0 on failure
+12 ; PRCER - (optional) on failure, an error message is returned, pass by ref
+13 ; PRCTOARY - (optional, pass by ref) returns the built segment in this format:
+14 ; PRCTOARY(1)
+15 ;
+16 ;contains the segment's data
NEW PRCSEG
+17 ;function result
NEW PRCRSLT
+18 ;
+19 ;init vars
+20 ;the segment should start off blank
KILL PRCSEG
SET PRCSEG=""
+21 SET PRCLINE=+$GET(PRCLINE)
+22 SET PRCRSLT=0
+23 ;
+24 IF PRCLINE'>0
SET PRCER="RQD segment not built - no line item passed"
QUIT PRCRSLT
+25 IF +$GET(@PRCWRK@(PRCLINE,"ITLINE"))'>0
SET PRCER="RQD segment not built - line item not found"
QUIT PRCRSLT
+26 ;
+27 SET PRCRSLT=1
+28 ;
+29 DO SET^HLOAPI(.PRCSEG,"RQD",0)
+30 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"ITLINE")),U,2),1)
+31 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"ITMFN")),U,2),2,1)
+32 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"IMNSN")),U,2),2,4)
+33 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"IMFSC")),U,2),2,5)
+34 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"ITSTOCK")),U,2),3,1)
+35 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"ITQTY")),U,2),5)
+36 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"UNITNM")),U,2),6,1)
+37 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"UNITFNM")),U,2),6,2)
+38 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"IMPKGM")),U,2),6,4)
+39 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("COSTCTR")),U,2),7)
+40 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"ITBOC")),U,2),8)
+41 ;
+42 ;add segment to message being built
+43 IF '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY)
Begin DoDot:1
+44 SET PRCRSLT=0
+45 SET PRCER="RQD segment not built"
End DoDot:1
+46 ;
+47 QUIT PRCRSLT
+48 ;
+49 ;
RQ1(PRCWRK,PRCHLO,PRCLINE,PRCER,PRCTOARY) ;Build RQ1 segment
+1 ;This function builds the RQ1 segment and adds it to the
+2 ;msg being built using HLO APIs. Any data manipulation
+3 ;or conversions are performed as needed.
+4 ;
+5 ; Input:
+6 ; PRCWRK - (required) name of work global containing 2237 data elements
+7 ; PRCHLO - (required) HLO workspace used to build message, pass by ref
+8 ; PRCLINE - (required) line item number
+9 ;
+10 ; Output:
+11 ; Function value - returns 1 on success, 0 on failure
+12 ; PRCER - (optional) on failure, an error message is returned, pass by ref
+13 ; PRCTOARY - (optional, pass by ref) returns the built segment in this format:
+14 ; PRCTOARY(1)
+15 ;
+16 ;contains the segment's data
NEW PRCSEG
+17 ;function result
NEW PRCRSLT
+18 ;
+19 ;init vars
+20 ;the segment should start off blank
KILL PRCSEG
SET PRCSEG=""
+21 SET PRCLINE=+$GET(PRCLINE)
+22 SET PRCRSLT=0
+23 ;
+24 IF PRCLINE'>0
SET PRCER="RQ1 segment not built - no line item passed"
QUIT PRCRSLT
+25 IF +$GET(@PRCWRK@(PRCLINE,"ITLINE"))'>0
SET PRCER="RQ1 segment not built - line item not found"
QUIT PRCRSLT
+26 ;
+27 SET PRCRSLT=1
+28 ;
+29 DO SET^HLOAPI(.PRCSEG,"RQ1",0)
+30 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"ITCOST")),U,2),1)
+31 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"IMMFG")),U,2),2,1)
+32 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VENDPT")),U),4,1)
+33 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VENDNM")),U,2),4,2)
+34 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"IMCTRCT")),U,2),4,4)
+35 DO SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($PIECE($GET(@PRCWRK@(PRCLINE,"IMEXPDT")),U,1)),4,5)
+36 ;
+37 ;add segment to message being built
+38 IF '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY)
Begin DoDot:1
+39 SET PRCRSLT=0
+40 SET PRCER="RQ1 segment not built"
End DoDot:1
+41 ;
+42 QUIT PRCRSLT
+43 ;
+44 ;
ZA1(PRCWRK,PRCHLO,PRCLINE,PRCER,PRCTOARY) ;Build ZA1 segment
+1 ;This function builds the ZA1 segment and adds it to the
+2 ;msg being built using HLO APIs. Any data manipulation
+3 ;or conversions are performed as needed.
+4 ;
+5 ; Input:
+6 ; PRCWRK - (required) name of work global containing 2237 data elements
+7 ; PRCHLO - (required) HLO workspace used to build message, pass by ref
+8 ; PRCLINE - (required) line item number
+9 ;
+10 ; Output:
+11 ; Function value - returns 1 on success, 0 on failure
+12 ; PRCER - (optional) on failure, an error message is returned, pass by ref
+13 ; PRCTOARY - (optional, pass by ref) returns the built segment in this format:
+14 ; PRCTOARY(1)
+15 ;
+16 ;contains the segment's data
NEW PRCSEG
+17 ;function result
NEW PRCRSLT
+18 ;
+19 ;the segment should start off blank
KILL PRCSEG
SET PRCSEG=""
+20 SET PRCLINE=+$GET(PRCLINE)
+21 SET PRCRSLT=0
+22 ;
+23 IF PRCLINE'>0
SET PRCER="ZA1 segment not built - no line item passed"
QUIT PRCRSLT
+24 IF +$GET(@PRCWRK@(PRCLINE,"ITLINE"))'>0
SET PRCER="ZA1 segment not built - line item not found"
QUIT PRCRSLT
+25 ;
+26 SET PRCRSLT=1
+27 ;
+28 DO SET^HLOAPI(.PRCSEG,"ZA1",0)
+29 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"IMNDC")),U,2),1)
+30 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"IMFOOD")),U,1),2)
+31 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"IMNIF")),U,2),3)
+32 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"IMMIN")),U,2),4)
+33 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"IMMAX")),U,2),5)
+34 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"IMREQ")),U,2),6)
+35 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"IMUCF")),U,2),7)
+36 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@(PRCLINE,"ITDMID")),U,2),8)
+37 ;
+38 ;add segment to message being built
+39 IF '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY)
Begin DoDot:1
+40 SET PRCRSLT=0
+41 SET PRCER="ZA1 segment not built"
End DoDot:1
+42 ;
+43 QUIT PRCRSLT
+44 ;
+45 ;
NTEITEM(PRCWRK,PRCHLO,PRCLINE,PRCER) ;Build NTE segments for item description
+1 ;This function builds repeating NTE segments for the
+2 ;description of the item being ordered and adds it
+3 ;to the msg being built using HLO APIs.
+4 ;
+5 ; Input:
+6 ; PRCWRK - (required) name of work global containing 2237 data elements
+7 ; PRCHLO - (required) HLO workspace used to build message, pass by ref
+8 ; PRCLINE - (required) line item number
+9 ;
+10 ; Output:
+11 ; Function value - returns 1 on success, 0 on failure
+12 ; PRCER - (optional) on failure, an error message is returned, pass by ref
+13 ;
+14 ;segment set id
NEW PRCSETID
+15 ;array subscript
NEW PRCSUB
+16 ;contains the segment's data
NEW PRCSEG
+17 ;function result
NEW PRCRSLT
+18 ;
+19 ;init vars
+20 ;the segment should start off blank
KILL PRCSEG
SET PRCSEG=""
+21 SET PRCLINE=+$GET(PRCLINE)
+22 SET PRCRSLT=0
+23 ;
+24 IF PRCLINE'>0
SET PRCER="NTE item segment not built - no line item passed"
QUIT PRCRSLT
+25 IF +$GET(@PRCWRK@(PRCLINE,"ITLINE"))'>0
SET PRCER="NTE item segment not built - line item not found"
QUIT PRCRSLT
+26 ;
+27 SET PRCRSLT=1
+28 ;
+29 ;loop thru Description nodes for the Line Item
+30 SET (PRCSUB,PRCSETID)=0
+31 FOR
SET PRCSUB=$ORDER(@PRCWRK@(PRCLINE,"ITDESC",PRCSUB))
if '$GET(PRCSUB)!('PRCRSLT)
QUIT
Begin DoDot:1
+32 SET PRCSETID=PRCSETID+1
+33 DO SET^HLOAPI(.PRCSEG,"NTE",0)
+34 DO SET^HLOAPI(.PRCSEG,PRCSETID,1)
+35 ;P for Placer (Orderer)
DO SET^HLOAPI(.PRCSEG,"P",2)
+36 DO SET^HLOAPI(.PRCSEG,$GET(@PRCWRK@(PRCLINE,"ITDESC",PRCSUB,0)),3)
+37 ;LD for Line Item Description
DO SET^HLOAPI(.PRCSEG,"LD",4,1)
+38 ;
+39 ;add segment to message being built
+40 IF '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER)
Begin DoDot:2
+41 SET PRCRSLT=0
+42 SET PRCER="NTE segment not built"
End DoDot:2
End DoDot:1
+43 ;
+44 QUIT PRCRSLT
