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

PRCHJS06.m

Go to the documentation of this file. 
  1. 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
  1.  ;Per VHA Directive 6402, this routine should not be modified.
  1.  ;
  1. NTE(PRCWRK,PRCHLO,PRCER) ;Build NTE segments
  1.  ;This function builds repeating NTE segments for the 2237
  1.  ;word processing fields Special Remarks, Justification,
  1.  ;and Comments. Segments are built and added to the msg
  1.  ;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.  ;
  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 data
  1.  N PRCRSLT  ;function result
  1.  ;
  1.  ;init vars
  1.  K PRCSEG S PRCSEG="" ;the segment should start off blank
  1.  S PRCSETID=0
  1.  S PRCRSLT=1
  1.  ;
  1.  D  ;drops out of DO block on failure
  1.  . ;
  1.  . ;loop thru Special Remarks nodes and put into NTE seg
  1.  . S PRCSUB=0
  1.  . F  S PRCSUB=$O(@PRCWRK@("REMARKS",PRCSUB)) Q:'$G(PRCSUB)  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 Order
  1.  . . D SET^HLOAPI(.PRCSEG,$G(@PRCWRK@("REMARKS",PRCSUB,0)),3)
  1.  . . D SET^HLOAPI(.PRCSEG,"RR",4,1) ;RR for Request Remarks
  1.  . . ;
  1.  . . ;add segment to message being built
  1.  . . I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER) S PRCRSLT=0,PRCER="NTE remarks segment not built"
  1.  . ;
  1.  . Q:'PRCRSLT
  1.  . ;
  1.  . ;loop thru Justification nodes and put into NTE seg
  1.  . S PRCSUB=0
  1.  . F  S PRCSUB=$O(@PRCWRK@("JUSTIF",PRCSUB)) Q:'$G(PRCSUB)  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 Order
  1.  . . D SET^HLOAPI(.PRCSEG,$G(@PRCWRK@("JUSTIF",PRCSUB,0)),3)
  1.  . . D SET^HLOAPI(.PRCSEG,"RJ",4,1) ;RJ for Request Justification
  1.  . . ;
  1.  . . ;add segment to message being built
  1.  . . I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER) S PRCRSLT=0,PRCER="NTE justification segment not built"
  1.  . ;
  1.  . Q:'PRCRSLT
  1.  . ;
  1.  . ;loop thru Comments nodes and put into NTE seg
  1.  . S PRCSUB=0
  1.  . F  S PRCSUB=$O(@PRCWRK@("COMMENT",PRCSUB)) Q:'$G(PRCSUB)  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 Order
  1.  . . D SET^HLOAPI(.PRCSEG,$G(@PRCWRK@("COMMENT",PRCSUB,0)),3)
  1.  . . D SET^HLOAPI(.PRCSEG,"RC",4,1) ;RC for Request Comments
  1.  . . ;
  1.  . . ;add segment to message being built
  1.  . . I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER) S PRCRSLT=0,PRCER="NTE comments segment not built"
  1.  ;
  1.  Q PRCRSLT
  1.  ;
  1.  ;
  1. ZZ1(PRCWRK,PRCHLO,PRCER,PRCTOARY) ;Build ZZ1 segment
  1.  ;This function builds the ZZ1 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.  ; Supported ICR:
  1.  ;   #10056: Allows retrieval of ABBREVIATION (#1) field from STATE (#5)
  1.  ;           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 PRCSTATE ;state abbreviation
  1.  N PRCRSLT  ;function result
  1.  ;
  1.  ;init vars
  1.  K PRCSEG S PRCSEG="" ;the segment should start off blank
  1.  S PRCRSLT=1
  1.  ;
  1.  D SET^HLOAPI(.PRCSEG,"ZZ1",0)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDAD1")),U,2),1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDAD2")),U,2),2)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDAD3")),U,2),3)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDAD4")),U,2),4)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDCTY")),U,2),5)
  1.  ;
  1.  ;retrieve State Abbreviation from (#5) file and set into seg
  1.  S PRCSTATE=$$GET1^DIQ(5,+$G(@PRCWRK@("VENDST"))_",",1)
  1.  D SET^HLOAPI(.PRCSEG,$G(PRCSTATE),6)
  1.  ;
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDZIP")),U,2),7)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDCON")),U,2),8)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VENDPH")),U,2),9)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VACT")),U,2),10)
  1.  ;
  1.  ;add segment to message being built
  1.  I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY) D
  1.  . S PRCRSLT=0
  1.  . S PRCER="ZZ1 segment not built"
  1.  ;
  1.  Q PRCRSLT
  1.  ;
  1.  ;
  1. ZZ2(PRCWRK,PRCHLO,PRCER,PRCTOARY) ;Build ZZ2 segment
  1.  ;This function builds the ZZ2 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.  ; Supported ICR:
  1.  ;   #10056: Allows retrieval of ABBREVIATION (#1) field from STATE (#5)
  1.  ;           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 PRCSTATE ;state abbreviation
  1.  N PRCRSLT  ;function result
  1.  ;
  1.  ;init vars
  1.  K PRCSEG S PRCSEG="" ;the segment should start off blank
  1.  S PRCRSLT=1
  1.  ;
  1.  D SET^HLOAPI(.PRCSEG,"ZZ2",0)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VPAYCON")),U,2),1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VPAYPH")),U,2),2)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VPAYAD1")),U,2),3)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VPAYAD2")),U,2),4)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VPAYAD3")),U,2),5)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VPAYAD4")),U,2),6)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VPAYCTY")),U,2),7)
  1.  ;
  1.  ;retrieve State Abbreviation from (#5) file and set into seg
  1.  S PRCSTATE=$$GET1^DIQ(5,+$G(@PRCWRK@("VPAYST"))_",",1)
  1.  D SET^HLOAPI(.PRCSEG,$G(PRCSTATE),8)
  1.  ;
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VPAYZIP")),U,2),9)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VEDI")),U,1),10)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VGDV")),U,1),11)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VDUNS")),U,2),12)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VFMSNM")),U,2),13)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VFAX")),U,2),14)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VID")),U,2),15)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("VUEI")),U,2),16)
  1.  ;
  1.  ;add segment to message being built
  1.  I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY) D
  1.  . S PRCRSLT=0
  1.  . S PRCER="ZZ2 segment not built"
  1.  ;
  1.  Q PRCRSLT
  1.  ;
  1.  ;
  1. ZZ3(PRCWRK,PRCHLO,PRCER,PRCTOARY) ;Build ZZ3 segment
  1.  ;This function builds the ZZ3 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.  ;
  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 PRCRSLT=1
  1.  ;
  1.  D SET^HLOAPI(.PRCSEG,"ZZ3",0)
  1.  D SET^HLOAPI(.PRCSEG,$$FMTHL7^XLFDT($P($G(@PRCWRK@("COMMITDT")),U,1)),1)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("COMMIT")),U,2),2)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("TRANSAMT")),U,2),3)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("ACTDATA")),U,2),4)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("FCPPRJ")),U,2),5)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("ESTSHIP")),U,2),6)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("CTRLPT")),U,2),7)
  1.  D SET^HLOAPI(.PRCSEG,$P($G(@PRCWRK@("EXPEND")),U,1),8)
  1.  D SET^HLOAPI(.PRCSEG,$E($P($G(@PRCWRK@("BBFY")),U,2),1,4),9)
  1.  ;
  1.  ;add segment to message being built
  1.  I '$$ADDSEG^HLOAPI(.PRCHLO,.PRCSEG,.PRCER,.PRCTOARY) D
  1.  . S PRCRSLT=0
  1.  . S PRCER="ZZ3 segment not built"
  1.  ;
  1.  Q PRCRSLT