Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCHJS05

PRCHJS05.m

Go to the documentation of this file. 
  1. 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
  1.  ;Per VHA Directive 2004-38, this routine should not be modified.
  1.  ;
  1. ORC(PRCWRK,PRCHLO,PRCER,PRCTOARY) ;Build ORC segment
  1.  ;This function builds the ORC segment and adds it
  1.  ;to the msg being built using HLO APIs. Any data
  1.  ;manipulation or conversions are performed as needed.
  1.  ;
  1.  ; Supported ICR:
  1.  ;   #10060: Allows retrieval of NAME (#.01) field from
  1.  ;           NEW PERSON (#200) file using FM read.
  1.  ;
  1.  ;  Input:
  1.  ;    PRCWRK - (required) name of work global containing 2237 data elements
  1.  ;    PRCHLO - (required) HLO workspace used to build message, pass by ref
  1.  ;
  1.  ; Output:
  1.  ;   Function value - returns 1 on success, 0 on failure
  1.  ;            PRCER - (optional) on failure, an error message is returned, pass by ref
  1.  ;         PRCTOARY - (optional, pass by ref) returns the built segment in this format:
  1.  ;                       PRCTOARY(1)
  1.  ;
  1.  N PRCSEG   ;contains the segment's data
  1.  N PRCNAME  ;input array for $$HLNAME^XLFNAME
  1.  N PRCNCOMP ;name components in HL7 format
  1.  N PRCRSLT  ;function result
  1.  ;
  1.  ;init vars
  1.  K PRCSEG S PRCSEG="" ;the segment should start off blank
  1.  S PRCNAME("FIELD")=.01
  1.  S PRCNAME("FILE")=200
  1.  S PRCRSLT=1
  1.  ;
  1.  D SET^HLOAPI(.PRCSEG,"ORC",0)
  1.  D SET^HLOAPI(.PRCSEG,"NW",1) ;new order/service
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("TRANUM")),U,2),2,1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("PRI")),U,1),5)
  1.  D SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($P($G(@PRCWRK@("RQSTDT")),U,1)),9,1)
  1.  ;
  1.  ;get Accountable Officer name components
  1.  S PRCNAME("IENS")=$P($G(@PRCWRK@("AO")),U,1)_","
  1.  S PRCNCOMP=$$HLNAME^XLFNAME(.PRCNAME)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("AO")),U,1),11,1) ;duz
  1.  D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,1),11,2,1) ;last
  1.  D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,2),11,3) ;first
  1.  D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,3),11,4) ;middle
  1.  D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,4),11,5) ;suffix
  1.  ;
  1.  D SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($P($G(@PRCWRK@("AOESIG")),U,1)),11,19,1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("AOTITLE")),U,2),11,21)
  1.  ;
  1.  ;get Requestor name components
  1.  S PRCNAME("IENS")=$P($G(@PRCWRK@("REQ")),U,1)_","
  1.  S PRCNCOMP=$$HLNAME^XLFNAME(.PRCNAME)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("REQ")),U,1),12,1) ;duz
  1.  D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,1),12,2,1) ;last
  1.  D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,2),12,3) ;first
  1.  D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,3),12,4) ;middle
  1.  D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,4),12,5) ;suffix 
  1.  ;
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("REQTITLE")),U,2),12,21)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("INVPT")),U,2),17,1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("INVABREV")),U,2),17,2)
  1.  ;
  1.  ;get Approving Official name components
  1.  S PRCNAME("IENS")=$P($G(@PRCWRK@("APOF")),U,1)_","
  1.  S PRCNCOMP=$$HLNAME^XLFNAME(.PRCNAME)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("APOF")),U,1),19,1) ;duz
  1.  D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,1),19,2,1) ;last
  1.  D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,2),19,3) ;first
  1.  D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,3),19,4) ;middle
  1.  D SET^HLOAPI(.PRCSEG,$P($G(PRCNCOMP),U,4),19,5) ;suffix
  1.  ;
  1.  D SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($P($G(@PRCWRK@("ESIGDT")),U,1)),19,19,1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("APOFTIT")),U,2),19,21)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("RQSRV")),U,2),21,1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("STANUM")),U,2),21,3)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("SUBSTA")),U,2),21,8,2)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("DELIVTO")),U,2),22,1,1)
  1.  D SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($P($G(@PRCWRK@("DTREQ")),U,1)),27,1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("FRMTYP")),U,1),29,1)
  1.  ;
  1.  ;add segment to message being built
  1.  I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY) D
  1.  . S PRCRSLT=0
  1.  . S PRCER="ORC segment not built"
  1.  ;
  1.  Q PRCRSLT
  1.  ;
  1.  ;
  1. TQ1(PRCWRK,PRCHLO,PRCLINE,PRCER) ;Build TQ1 segment
  1.  ;This function builds a TQ1 segment for each delivery
  1.  ;schedule associated with a line item and adds it to
  1.  ;the msg being built using HLO APIs. Any data manipulation
  1.  ;or conversions are performed as needed.
  1.  ;
  1.  ;  Input:
  1.  ;    PRCWRK - (required) name of work global containing 2237 data elements
  1.  ;    PRCHLO - (required) HLO workspace used to build message, pass by ref
  1.  ;   PRCLINE - (required) line item number
  1.  ;
  1.  ; Output:
  1.  ;   Function value - returns 1 on success, 0 on failure
  1.  ;            PRCER - (optional) on failure, an error message is returned, pass by ref
  1.  ;
  1.  N PRCSEG  ;contains the segment's data
  1.  N PRCSUB  ;array subscript
  1.  N PRCRSLT ;function result
  1.  ;
  1.  ;init vars
  1.  K PRCSEG S PRCSEG="" ;the segment should start off blank
  1.  S PRCLINE=+$G(PRCLINE)
  1.  S PRCSUB=0
  1.  S PRCRSLT=0
  1.  ;
  1.  I PRCLINE'>0 S PRCER="TQ1 segment not built - no line item passed" Q PRCRSLT
  1.  I '$O(@PRCWRK@(PRCLINE,PRCSUB)) S PRCER="TQ1 segment not built - no delivery schedule for item" Q PRCRSLT
  1.  ;
  1.  S PRCRSLT=1
  1.  ;
  1.  ;loop thru delivery schedules for the line item
  1.  F  S PRCSUB=$O(@PRCWRK@(PRCLINE,PRCSUB)) Q:('$G(PRCSUB)!('PRCRSLT))  D
  1.  . D SET^HLOAPI(.PRCSEG,"TQ1",0)
  1.  . D SET^HLOAPI(.PRCSEG,PRCSUB,1) ;Delivery Schedule #
  1.  . D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,PRCSUB,"DELQTY")),U,2),2,1)
  1.  . D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"UNITNM")),U,2),2,2,1)
  1.  . D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"UNITFNM")),U,2),2,2,2)
  1.  . D SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($P($G(@PRCWRK@(PRCLINE,PRCSUB,"DELDT")),U)),7,1)
  1.  . D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,PRCSUB,"DELLOC")),U,2),10)
  1.  . D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,PRCSUB,"DELREF")),U,2),11)
  1.  . ;
  1.  . ;add segment to message being built
  1.  . I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER) D
  1.  . . S PRCRSLT=0
  1.  . . S PRCER="TQ1 segment not built"
  1.  ;
  1.  Q PRCRSLT
  1.  ;
  1.  ;
  1. RQD(PRCWRK,PRCHLO,PRCLINE,PRCER,PRCTOARY) ;Build RQD segment
  1.  ;This function builds the RQD segment and adds it to the
  1.  ;msg being built using HLO APIs. Any data manipulation
  1.  ;or conversions are performed as needed.
  1.  ;
  1.  ;  Input:
  1.  ;    PRCWRK - (required) name of work global containing 2237 data elements
  1.  ;    PRCHLO - (required) HLO workspace used to build message, pass by ref
  1.  ;   PRCLINE - (required) line item number
  1.  ;
  1.  ; Output:
  1.  ;   Function value - returns 1 on success, 0 on failure
  1.  ;            PRCER - (optional) on failure, an error message is returned, pass by ref
  1.  ;         PRCTOARY - (optional, pass by ref) returns the built segment in this format:
  1.  ;                       PRCTOARY(1)
  1.  ;
  1.  N PRCSEG  ;contains the segment's data
  1.  N PRCRSLT ;function result
  1.  ;
  1.  ;init vars
  1.  K PRCSEG S PRCSEG="" ;the segment should start off blank
  1.  S PRCLINE=+$G(PRCLINE)
  1.  S PRCRSLT=0
  1.  ;
  1.  I PRCLINE'>0 S PRCER="RQD segment not built - no line item passed" Q PRCRSLT
  1.  I +$G(@PRCWRK@(PRCLINE,"ITLINE"))'>0 S PRCER="RQD segment not built - line item not found" Q PRCRSLT
  1.  ;
  1.  S PRCRSLT=1
  1.  ;
  1.  D SET^HLOAPI(.PRCSEG,"RQD",0)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"ITLINE")),U,2),1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"ITMFN")),U,2),2,1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMNSN")),U,2),2,4)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMFSC")),U,2),2,5)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"ITSTOCK")),U,2),3,1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"ITQTY")),U,2),5)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"UNITNM")),U,2),6,1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"UNITFNM")),U,2),6,2)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMPKGM")),U,2),6,4)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("COSTCTR")),U,2),7)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"ITBOC")),U,2),8)
  1.  ;
  1.  ;add segment to message being built
  1.  I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY) D
  1.  . S PRCRSLT=0
  1.  . S PRCER="RQD segment not built"
  1.  ;
  1.  Q PRCRSLT
  1.  ;
  1.  ;
  1. RQ1(PRCWRK,PRCHLO,PRCLINE,PRCER,PRCTOARY) ;Build RQ1 segment
  1.  ;This function builds the RQ1 segment and adds it to the
  1.  ;msg being built using HLO APIs. Any data manipulation
  1.  ;or conversions are performed as needed.
  1.  ;
  1.  ;  Input:
  1.  ;    PRCWRK - (required) name of work global containing 2237 data elements
  1.  ;    PRCHLO - (required) HLO workspace used to build message, pass by ref
  1.  ;   PRCLINE - (required) line item number
  1.  ;
  1.  ; Output:
  1.  ;   Function value - returns 1 on success, 0 on failure
  1.  ;            PRCER - (optional) on failure, an error message is returned, pass by ref
  1.  ;         PRCTOARY - (optional, pass by ref) returns the built segment in this format:
  1.  ;                       PRCTOARY(1)
  1.  ;
  1.  N PRCSEG  ;contains the segment's data
  1.  N PRCRSLT ;function result
  1.  ;
  1.  ;init vars
  1.  K PRCSEG S PRCSEG="" ;the segment should start off blank
  1.  S PRCLINE=+$G(PRCLINE)
  1.  S PRCRSLT=0
  1.  ;
  1.  I PRCLINE'>0 S PRCER="RQ1 segment not built - no line item passed" Q PRCRSLT
  1.  I +$G(@PRCWRK@(PRCLINE,"ITLINE"))'>0 S PRCER="RQ1 segment not built - line item not found" Q PRCRSLT
  1.  ;
  1.  S PRCRSLT=1
  1.  ;
  1.  D SET^HLOAPI(.PRCSEG,"RQ1",0)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"ITCOST")),U,2),1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMMFG")),U,2),2,1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDPT")),U),4,1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDNM")),U,2),4,2)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMCTRCT")),U,2),4,4)
  1.  D SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($P($G(@PRCWRK@(PRCLINE,"IMEXPDT")),U,1)),4,5)
  1.  ;
  1.  ;add segment to message being built
  1.  I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY) D
  1.  . S PRCRSLT=0
  1.  . S PRCER="RQ1 segment not built"
  1.  ;
  1.  Q PRCRSLT
  1.  ;
  1.  ;
  1. ZA1(PRCWRK,PRCHLO,PRCLINE,PRCER,PRCTOARY) ;Build ZA1 segment
  1.  ;This function builds the ZA1 segment and adds it to the
  1.  ;msg being built using HLO APIs. Any data manipulation
  1.  ;or conversions are performed as needed.
  1.  ;
  1.  ;  Input:
  1.  ;    PRCWRK - (required) name of work global containing 2237 data elements
  1.  ;    PRCHLO - (required) HLO workspace used to build message, pass by ref
  1.  ;   PRCLINE - (required) line item number
  1.  ;
  1.  ; Output:
  1.  ;   Function value - returns 1 on success, 0 on failure
  1.  ;            PRCER - (optional) on failure, an error message is returned, pass by ref
  1.  ;         PRCTOARY - (optional, pass by ref) returns the built segment in this format:
  1.  ;                       PRCTOARY(1)
  1.  ;
  1.  N PRCSEG  ;contains the segment's data
  1.  N PRCRSLT ;function result
  1.  ;
  1.  K PRCSEG S PRCSEG="" ;the segment should start off blank
  1.  S PRCLINE=+$G(PRCLINE)
  1.  S PRCRSLT=0
  1.  ;
  1.  I PRCLINE'>0 S PRCER="ZA1 segment not built - no line item passed" Q PRCRSLT
  1.  I +$G(@PRCWRK@(PRCLINE,"ITLINE"))'>0 S PRCER="ZA1 segment not built - line item not found" Q PRCRSLT
  1.  ;
  1.  S PRCRSLT=1
  1.  ;
  1.  D SET^HLOAPI(.PRCSEG,"ZA1",0)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMNDC")),U,2),1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMFOOD")),U,1),2)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMNIF")),U,2),3)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMMIN")),U,2),4)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMMAX")),U,2),5)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMREQ")),U,2),6)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"IMUCF")),U,2),7)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@(PRCLINE,"ITDMID")),U,2),8)
  1.  ;
  1.  ;add segment to message being built
  1.  I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY) D
  1.  . S PRCRSLT=0
  1.  . S PRCER="ZA1 segment not built"
  1.  ;
  1.  Q PRCRSLT
  1.  ;
  1.  ;
  1. NTEITEM(PRCWRK,PRCHLO,PRCLINE,PRCER) ;Build NTE segments for item description
  1.  ;This function builds repeating NTE segments for the
  1.  ;description of the item being ordered and adds it
  1.  ;to the msg being built using HLO APIs.
  1.  ;
  1.  ;  Input:
  1.  ;    PRCWRK - (required) name of work global containing 2237 data elements
  1.  ;    PRCHLO - (required) HLO workspace used to build message, pass by ref
  1.  ;   PRCLINE - (required) line item number
  1.  ;
  1.  ; Output:
  1.  ;   Function value - returns 1 on success, 0 on failure
  1.  ;            PRCER - (optional) on failure, an error message is returned, pass by ref
  1.  ;
  1.  N PRCSETID ;segment set id
  1.  N PRCSUB   ;array subscript
  1.  N PRCSEG   ;contains the segment's data
  1.  N PRCRSLT  ;function result
  1.  ;
  1.  ;init vars
  1.  K PRCSEG S PRCSEG="" ;the segment should start off blank
  1.  S PRCLINE=+$G(PRCLINE)
  1.  S PRCRSLT=0
  1.  ;
  1.  I PRCLINE'>0 S PRCER="NTE item segment not built - no line item passed" Q PRCRSLT
  1.  I +$G(@PRCWRK@(PRCLINE,"ITLINE"))'>0 S PRCER="NTE item segment not built - line item not found" Q PRCRSLT
  1.  ;
  1.  S PRCRSLT=1
  1.  ;
  1.  ;loop thru Description nodes for the Line Item
  1.  S (PRCSUB,PRCSETID)=0
  1.  F  S PRCSUB=$O(@PRCWRK@(PRCLINE,"ITDESC",PRCSUB)) Q:'$G(PRCSUB)!('PRCRSLT)  D
  1.  . S PRCSETID=PRCSETID+1
  1.  . D SET^HLOAPI(.PRCSEG,"NTE",0)
  1.  . D SET^HLOAPI(.PRCSEG,PRCSETID,1)
  1.  . D SET^HLOAPI(.PRCSEG,"P",2) ;P for Placer (Orderer) 
  1.  . D SET^HLOAPI(.PRCSEG,$G(@PRCWRK@(PRCLINE,"ITDESC",PRCSUB,0)),3)
  1.  . D SET^HLOAPI(.PRCSEG,"LD",4,1) ;LD for Line Item Description
  1.  . ;
  1.  . ;add segment to message being built
  1.  . I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER) D
  1.  . . S PRCRSLT=0
  1.  . . S PRCER="NTE segment not built"
  1.  ;
  1.  Q PRCRSLT