PRCHJS06 ;OI&T/KCL - IFCAP/ECMS INTERFACE 2237 SEND SEG BUILDERS CONT.;6/12/12 ;1/26/22 12:36
;;5.1;IFCAP;**167,227**;Oct 20, 2000;Build 1
;Per VHA Directive 6402, this routine should not be modified.
;
NTE(PRCWRK,PRCHLO,PRCER) ;Build NTE segments
;This function builds repeating NTE segments for the 2237
;word processing fields Special Remarks, Justification,
;and Comments. Segments are built and added 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
;
; 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 data
N PRCRSLT ;function result
;
;init vars
K PRCSEG S PRCSEG="" ;the segment should start off blank
S PRCSETID=0
S PRCRSLT=1
;
D ;drops out of DO block on failure
. ;
. ;loop thru Special Remarks nodes and put into NTE seg
. S PRCSUB=0
. F S PRCSUB=$O(@PRCWRK@("REMARKS",PRCSUB)) Q:'$G(PRCSUB) 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 Order
. . D SET^HLOAPI(.PRCSEG,$G(@PRCWRK@("REMARKS",PRCSUB,0)),3)
. . D SET^HLOAPI(.PRCSEG,"RR",4,1) ;RR for Request Remarks
. . ;
. . ;add segment to message being built
. . I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER) S PRCRSLT=0,PRCER="NTE remarks segment not built"
. ;
. Q:'PRCRSLT
. ;
. ;loop thru Justification nodes and put into NTE seg
. S PRCSUB=0
. F S PRCSUB=$O(@PRCWRK@("JUSTIF",PRCSUB)) Q:'$G(PRCSUB) 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 Order
. . D SET^HLOAPI(.PRCSEG,$G(@PRCWRK@("JUSTIF",PRCSUB,0)),3)
. . D SET^HLOAPI(.PRCSEG,"RJ",4,1) ;RJ for Request Justification
. . ;
. . ;add segment to message being built
. . I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER) S PRCRSLT=0,PRCER="NTE justification segment not built"
. ;
. Q:'PRCRSLT
. ;
. ;loop thru Comments nodes and put into NTE seg
. S PRCSUB=0
. F S PRCSUB=$O(@PRCWRK@("COMMENT",PRCSUB)) Q:'$G(PRCSUB) 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 Order
. . D SET^HLOAPI(.PRCSEG,$G(@PRCWRK@("COMMENT",PRCSUB,0)),3)
. . D SET^HLOAPI(.PRCSEG,"RC",4,1) ;RC for Request Comments
. . ;
. . ;add segment to message being built
. . I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER) S PRCRSLT=0,PRCER="NTE comments segment not built"
;
Q PRCRSLT
;
;
ZZ1(PRCWRK,PRCHLO,PRCER,PRCTOARY) ;Build ZZ1 segment
;This function builds the ZZ1 segment and adds it to the
;msg being built using HLO APIs. Any data manipulation
;or conversions are performed as needed.
;
; Supported ICR:
; #10056: Allows retrieval of ABBREVIATION (#1) field from STATE (#5)
; 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 PRCSTATE ;state abbreviation
N PRCRSLT ;function result
;
;init vars
K PRCSEG S PRCSEG="" ;the segment should start off blank
S PRCRSLT=1
;
D SET^HLOAPI(.PRCSEG,"ZZ1",0)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDAD1")),U,2),1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDAD2")),U,2),2)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDAD3")),U,2),3)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDAD4")),U,2),4)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDCTY")),U,2),5)
;
;retrieve State Abbreviation from (#5) file and set into seg
S PRCSTATE=$$GET1^DIQ(5,+$G(@PRCWRK@("VENDST"))_",",1)
D SET^HLOAPI(.PRCSEG,$G(PRCSTATE),6)
;
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDZIP")),U,2),7)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDCON")),U,2),8)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDPH")),U,2),9)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VACT")),U,2),10)
;
;add segment to message being built
I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY) D
. S PRCRSLT=0
. S PRCER="ZZ1 segment not built"
;
Q PRCRSLT
;
;
ZZ2(PRCWRK,PRCHLO,PRCER,PRCTOARY) ;Build ZZ2 segment
;This function builds the ZZ2 segment and adds it to the
;msg being built using HLO APIs. Any data manipulation
;or conversions are performed as needed.
;
; Supported ICR:
; #10056: Allows retrieval of ABBREVIATION (#1) field from STATE (#5)
; 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 PRCSTATE ;state abbreviation
N PRCRSLT ;function result
;
;init vars
K PRCSEG S PRCSEG="" ;the segment should start off blank
S PRCRSLT=1
;
D SET^HLOAPI(.PRCSEG,"ZZ2",0)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VPAYCON")),U,2),1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VPAYPH")),U,2),2)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VPAYAD1")),U,2),3)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VPAYAD2")),U,2),4)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VPAYAD3")),U,2),5)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VPAYAD4")),U,2),6)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VPAYCTY")),U,2),7)
;
;retrieve State Abbreviation from (#5) file and set into seg
S PRCSTATE=$$GET1^DIQ(5,+$G(@PRCWRK@("VPAYST"))_",",1)
D SET^HLOAPI(.PRCSEG,$G(PRCSTATE),8)
;
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VPAYZIP")),U,2),9)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VEDI")),U,1),10)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VGDV")),U,1),11)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VDUNS")),U,2),12)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VFMSNM")),U,2),13)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VFAX")),U,2),14)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VID")),U,2),15)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VUEI")),U,2),16)
;
;add segment to message being built
I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY) D
. S PRCRSLT=0
. S PRCER="ZZ2 segment not built"
;
Q PRCRSLT
;
;
ZZ3(PRCWRK,PRCHLO,PRCER,PRCTOARY) ;Build ZZ3 segment
;This function builds the ZZ3 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
;
; 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 PRCRSLT=1
;
D SET^HLOAPI(.PRCSEG,"ZZ3",0)
D SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($P($G(@PRCWRK@("COMMITDT")),U,1)),1)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("COMMIT")),U,2),2)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("TRANSAMT")),U,2),3)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("ACTDATA")),U,2),4)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("FCPPRJ")),U,2),5)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("ESTSHIP")),U,2),6)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("CTRLPT")),U,2),7)
D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("EXPEND")),U,1),8)
D SET^HLOAPI(.PRCSEG,$E($P($G(@PRCWRK@("BBFY")),U,2),1,4),9)
;
;add segment to message being built
I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY) D
. S PRCRSLT=0
. S PRCER="ZZ3 segment not built"
;
Q PRCRSLT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHJS06 8568 printed Apr 09, 2024@21:07:18 Page 2
PRCHJS06 ;OI&T/KCL - IFCAP/ECMS INTERFACE 2237 SEND SEG BUILDERS CONT.;6/12/12 ;1/26/22 12:36
+1 ;;5.1;IFCAP;**167,227**;Oct 20, 2000;Build 1
+2 ;Per VHA Directive 6402, this routine should not be modified.
+3 ;
NTE(PRCWRK,PRCHLO,PRCER) ;Build NTE segments
+1 ;This function builds repeating NTE segments for the 2237
+2 ;word processing fields Special Remarks, Justification,
+3 ;and Comments. Segments are built and added to the msg
+4 ;being built using HLO APIs.
+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 ;
+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 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 PRCSETID=0
+22 SET PRCRSLT=1
+23 ;
+24 ;drops out of DO block on failure
Begin DoDot:1
+25 ;
+26 ;loop thru Special Remarks nodes and put into NTE seg
+27 SET PRCSUB=0
+28 FOR
SET PRCSUB=$ORDER(@PRCWRK@("REMARKS",PRCSUB))
if '$GET(PRCSUB)
QUIT
Begin DoDot:2
+29 SET PRCSETID=PRCSETID+1
+30 DO SET^HLOAPI(.PRCSEG,"NTE",0)
+31 DO SET^HLOAPI(.PRCSEG,PRCSETID,1)
+32 ;P for Placer Order
DO SET^HLOAPI(.PRCSEG,"P",2)
+33 DO SET^HLOAPI(.PRCSEG,$GET(@PRCWRK@("REMARKS",PRCSUB,0)),3)
+34 ;RR for Request Remarks
DO SET^HLOAPI(.PRCSEG,"RR",4,1)
+35 ;
+36 ;add segment to message being built
+37 IF '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER)
SET PRCRSLT=0
SET PRCER="NTE remarks segment not built"
End DoDot:2
+38 ;
+39 if 'PRCRSLT
QUIT
+40 ;
+41 ;loop thru Justification nodes and put into NTE seg
+42 SET PRCSUB=0
+43 FOR
SET PRCSUB=$ORDER(@PRCWRK@("JUSTIF",PRCSUB))
if '$GET(PRCSUB)
QUIT
Begin DoDot:2
+44 SET PRCSETID=PRCSETID+1
+45 DO SET^HLOAPI(.PRCSEG,"NTE",0)
+46 DO SET^HLOAPI(.PRCSEG,PRCSETID,1)
+47 ;P for Placer Order
DO SET^HLOAPI(.PRCSEG,"P",2)
+48 DO SET^HLOAPI(.PRCSEG,$GET(@PRCWRK@("JUSTIF",PRCSUB,0)),3)
+49 ;RJ for Request Justification
DO SET^HLOAPI(.PRCSEG,"RJ",4,1)
+50 ;
+51 ;add segment to message being built
+52 IF '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER)
SET PRCRSLT=0
SET PRCER="NTE justification segment not built"
End DoDot:2
+53 ;
+54 if 'PRCRSLT
QUIT
+55 ;
+56 ;loop thru Comments nodes and put into NTE seg
+57 SET PRCSUB=0
+58 FOR
SET PRCSUB=$ORDER(@PRCWRK@("COMMENT",PRCSUB))
if '$GET(PRCSUB)
QUIT
Begin DoDot:2
+59 SET PRCSETID=PRCSETID+1
+60 DO SET^HLOAPI(.PRCSEG,"NTE",0)
+61 DO SET^HLOAPI(.PRCSEG,PRCSETID,1)
+62 ;P for Placer Order
DO SET^HLOAPI(.PRCSEG,"P",2)
+63 DO SET^HLOAPI(.PRCSEG,$GET(@PRCWRK@("COMMENT",PRCSUB,0)),3)
+64 ;RC for Request Comments
DO SET^HLOAPI(.PRCSEG,"RC",4,1)
+65 ;
+66 ;add segment to message being built
+67 IF '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER)
SET PRCRSLT=0
SET PRCER="NTE comments segment not built"
End DoDot:2
End DoDot:1
+68 ;
+69 QUIT PRCRSLT
+70 ;
+71 ;
ZZ1(PRCWRK,PRCHLO,PRCER,PRCTOARY) ;Build ZZ1 segment
+1 ;This function builds the ZZ1 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 ; Supported ICR:
+6 ; #10056: Allows retrieval of ABBREVIATION (#1) field from STATE (#5)
+7 ; 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 ;state abbreviation
NEW PRCSTATE
+21 ;function result
NEW PRCRSLT
+22 ;
+23 ;init vars
+24 ;the segment should start off blank
KILL PRCSEG
SET PRCSEG=""
+25 SET PRCRSLT=1
+26 ;
+27 DO SET^HLOAPI(.PRCSEG,"ZZ1",0)
+28 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VENDAD1")),U,2),1)
+29 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VENDAD2")),U,2),2)
+30 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VENDAD3")),U,2),3)
+31 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VENDAD4")),U,2),4)
+32 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VENDCTY")),U,2),5)
+33 ;
+34 ;retrieve State Abbreviation from (#5) file and set into seg
+35 SET PRCSTATE=$$GET1^DIQ(5,+$GET(@PRCWRK@("VENDST"))_",",1)
+36 DO SET^HLOAPI(.PRCSEG,$GET(PRCSTATE),6)
+37 ;
+38 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VENDZIP")),U,2),7)
+39 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VENDCON")),U,2),8)
+40 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VENDPH")),U,2),9)
+41 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VACT")),U,2),10)
+42 ;
+43 ;add segment to message being built
+44 IF '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY)
Begin DoDot:1
+45 SET PRCRSLT=0
+46 SET PRCER="ZZ1 segment not built"
End DoDot:1
+47 ;
+48 QUIT PRCRSLT
+49 ;
+50 ;
ZZ2(PRCWRK,PRCHLO,PRCER,PRCTOARY) ;Build ZZ2 segment
+1 ;This function builds the ZZ2 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 ; Supported ICR:
+6 ; #10056: Allows retrieval of ABBREVIATION (#1) field from STATE (#5)
+7 ; 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 ;state abbreviation
NEW PRCSTATE
+21 ;function result
NEW PRCRSLT
+22 ;
+23 ;init vars
+24 ;the segment should start off blank
KILL PRCSEG
SET PRCSEG=""
+25 SET PRCRSLT=1
+26 ;
+27 DO SET^HLOAPI(.PRCSEG,"ZZ2",0)
+28 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VPAYCON")),U,2),1)
+29 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VPAYPH")),U,2),2)
+30 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VPAYAD1")),U,2),3)
+31 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VPAYAD2")),U,2),4)
+32 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VPAYAD3")),U,2),5)
+33 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VPAYAD4")),U,2),6)
+34 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VPAYCTY")),U,2),7)
+35 ;
+36 ;retrieve State Abbreviation from (#5) file and set into seg
+37 SET PRCSTATE=$$GET1^DIQ(5,+$GET(@PRCWRK@("VPAYST"))_",",1)
+38 DO SET^HLOAPI(.PRCSEG,$GET(PRCSTATE),8)
+39 ;
+40 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VPAYZIP")),U,2),9)
+41 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VEDI")),U,1),10)
+42 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VGDV")),U,1),11)
+43 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VDUNS")),U,2),12)
+44 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VFMSNM")),U,2),13)
+45 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VFAX")),U,2),14)
+46 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VID")),U,2),15)
+47 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("VUEI")),U,2),16)
+48 ;
+49 ;add segment to message being built
+50 IF '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY)
Begin DoDot:1
+51 SET PRCRSLT=0
+52 SET PRCER="ZZ2 segment not built"
End DoDot:1
+53 ;
+54 QUIT PRCRSLT
+55 ;
+56 ;
ZZ3(PRCWRK,PRCHLO,PRCER,PRCTOARY) ;Build ZZ3 segment
+1 ;This function builds the ZZ3 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 ;
+9 ; Output:
+10 ; Function value - returns 1 on success, 0 on failure
+11 ; PRCER - (optional) on failure, an error message is returned, pass by ref
+12 ; PRCTOARY - (optional, pass by ref) returns the built segment in this format:
+13 ; PRCTOARY(1)
+14 ;
+15 ;contains the segment's data
NEW PRCSEG
+16 ;function result
NEW PRCRSLT
+17 ;
+18 ;init vars
+19 ;the segment should start off blank
KILL PRCSEG
SET PRCSEG=""
+20 SET PRCRSLT=1
+21 ;
+22 DO SET^HLOAPI(.PRCSEG,"ZZ3",0)
+23 DO SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($PIECE($GET(@PRCWRK@("COMMITDT")),U,1)),1)
+24 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("COMMIT")),U,2),2)
+25 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("TRANSAMT")),U,2),3)
+26 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("ACTDATA")),U,2),4)
+27 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("FCPPRJ")),U,2),5)
+28 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("ESTSHIP")),U,2),6)
+29 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("CTRLPT")),U,2),7)
+30 DO SET^HLOAPI(.PRCSEG,$PIECE($GET(@PRCWRK@("EXPEND")),U,1),8)
+31 DO SET^HLOAPI(.PRCSEG,$EXTRACT($PIECE($GET(@PRCWRK@("BBFY")),U,2),1,4),9)
+32 ;
+33 ;add segment to message being built
+34 IF '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY)
Begin DoDot:1
+35 SET PRCRSLT=0
+36 SET PRCER="ZZ3 segment not built"
End DoDot:1
+37 ;
+38 QUIT PRCRSLT
