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

PRCHAAC1.m

Go to the documentation of this file. 
  1. PRCHAAC1 ;WIFO/CR-CONT. OF IFCAP HL7 MESSAGE TO AUSTIN ;3/4/05 11:43 AM
  1.  ;;5.1;IFCAP;**79,105**;Oct 20, 2000;Build 4
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  ; This routine is called from the routine PRCHAAC.
  1.  ; Set up HL7 environment for message.
  1.  K HLA,HL,HLFS,HLCS,HLRS
  1.  N PRCAPPO,PRCPPA,PRCERR,PRCMID,PRCMSG,PRCSEG,PRCSUB,PRCPROT,PRCRSULT,PRCOPTNS
  1.  S PRCDUZ=$G(DUZ) I +PRCDUZ'>0 D EN^DDIOL("User undefined","","!!?5") Q 0  ;DUZ is system-supplied
  1.  S PRCPROT="PRC_IFCAP_01_EV_AAC"
  1.  D INIT^HLFNC2(PRCPROT,.HL)
  1.  I $G(HL) D  Q 0  ;tell user if there was an error
  1.  . S PRCMSG=0
  1.  . I $P(HL,"^",2)]"" D
  1.  .. D:'$D(ZTQUEUED) EN^DDIOL("Error: "_$P(HL,"^",2)_" occurred. Please try later.")
  1.  ;
  1.  S HLFS=$G(HL("FS"))    ;field separator
  1.  S HLCS=$E(HL("ECH"),1) ;component separator
  1.  S HLRS=$E(HL("ECH"),2) ;repetition separator
  1.  ;
  1.  ;======== MFI Segment ===========
  1.  S PRCSEG="MFI"_HLFS_"CDM"_HLFS_HLFS_"UPD"_HLFS_HLFS_HLFS_"AL"
  1.  S HLA("HLS",1)=PRCSEG
  1.  ;
  1.  ;======== MFE Segment ===========
  1.  S PRCSEG="MFE"_HLFS_"MAD"_HLFS_HLFS
  1.  S $P(PRCSEG,HLFS,5)="V"_PRCROOT_HLFS_"CE"  ;primary key value
  1.  S HLA("HLS",2)=PRCSEG
  1.  ;
  1.  ;======== CDM Segment ===========
  1.  S PRCSEG="CDM"
  1.  S $P(PRCSEG,HLFS,2)="V"_PRCROOT      ;primary key value
  1.  S $P(PRCSEG,HLFS,4)="PROCUREMENT DETAIL FROM IFCAP"
  1.  S $P(PRCSEG,HLFS,12)=PRCCN           ;contract number
  1.  S:$G(PRCAM)="" $P(PRCSEG,HLFS,13)=PRCVEN_HLCS_HLCS_PRCDB
  1.  S HLA("HLS",3)=PRCSEG
  1.  ;
  1.  ;======== PRC Segment ===========
  1.  S PRCSEG="PRC"
  1.  S $P(PRCSEG,HLFS,2)="V"_PRCROOT      ;primary key value
  1.  S:$G(PRCAM)="" $P(PRCSEG,HLFS,10)="0"_HLCS_"US"
  1.  S $P(PRCSEG,HLFS,11)=PRCAMT_HLCS_"US"
  1.  S $P(PRCSEG,HLFS,12)=$G(PRCOD)    ;effective start date = P.O. Date
  1.  S $P(PRCSEG,HLFS,13)=$G(PRCDD)    ;effective end date = delivery date
  1.  S HLA("HLS",4)=PRCSEG
  1.  ;
  1.  ;======== ZPO Segment ===========
  1.  ; Purchase order details - check if this PO has been amended and get
  1.  ; just a few fields for this segment as requested by Austin Automation
  1.  ; Center (AAC)
  1.  I $D(^PRC(442,PRCHPO,6,0)) G AMEND
  1.  S PRCSEG="ZPO"
  1.  S:$G(PRCECC)'="" $P(PRCSEG,HLFS,2)=PRCECC      ;extent competed
  1.  S:$G(PRCRNC)'="" $P(PRCSEG,HLFS,3)=PRCRNC      ;reason not competed
  1.  S $P(PRCSEG,HLFS,4)=PRCEPAC     ;EPA designated product
  1.  S:$G(PRCFSC)'="" $P(PRCSEG,HLFS,5)=PRCFSC      ;Federal Supply Class. (or PSC code)
  1.  S $P(PRCSEG,HLFS,6)=PRCPP       ;place of performance question
  1.  S $P(PRCSEG,HLFS,7)=PRCPF       ;place of performance
  1.  S $P(PRCSEG,HLFS,8)=PRCCB       ;contract bundling
  1.  S $P(PRCSEG,HLFS,9)="N"         ;government furnished eqmt.
  1.  S $P(PRCSEG,HLFS,10)=PRCPER     ;DUZ^LastName^FirstName (contr. officer)
  1.  S $P(PRCSEG,HLFS,11)=PRCMOP           ;method of processing
  1.  S $P(PRCSEG,HLFS,12)="J"              ;type of contract
  1.  S $P(PRCSEG,HLFS,13)=PRCAAD           ;alternative advertising
  1.  S $P(PRCSEG,HLFS,14)=$G(PRCDS)        ;date PO was signed
  1.  S $P(PRCSEG,HLFS,15)=PRCAT            ;award type
  1.  S $P(PRCSEG,HLFS,16)=PRCRT            ;record type
  1.  S $P(PRCSEG,HLFS,17)=PRCSPC           ;solicitation procedure
  1.  S $P(PRCSEG,HLFS,18)=PRCEPC           ;evaluated preference
  1.  S $P(PRCSEG,HLFS,19)=PRCFAC           ;funding agency code
  1.  S $P(PRCSEG,HLFS,20)="N"              ;contract funded by foreign gov.
  1.  S $P(PRCSEG,HLFS,21)=PRCFOC           ;funding agency office code
  1.  S $P(PRCSEG,HLFS,22)=PRCMY            ;multiyear (for contracts)
  1.  S $P(PRCSEG,HLFS,23)=PRCPAS           ;pre award synopsis
  1.  S $P(PRCSEG,HLFS,24)="N"              ;synopsis waiver
  1.  S $P(PRCSEG,HLFS,25)=PRCNOF           ;number of offers
  1.  S $P(PRCSEG,HLFS,26)=PRCUV_HLCS_"US"  ;ultimate contract value
  1.  S $P(PRCSEG,HLFS,27)=PRCCV_HLCS_"US"  ;current contract value
  1.  S $P(PRCSEG,HLFS,28)=PRCDES           ;description of reqmt. (line item)
  1.  S $P(PRCSEG,HLFS,29)=3600             ;agency identifier
  1.  S $P(PRCSEG,HLFS,30)=PRCBZ            ;business size
  1.  S $P(PRCSEG,HLFS,31)=PRCTSAC          ;type set aside
  1.  S $P(PRCSEG,HLFS,32)=PRCPBC           ;perf. based service contract
  1.  S $P(PRCSEG,HLFS,33)=3600             ;contracting agency code
  1.  S $P(PRCSEG,HLFS,34)=PRCOFC           ;contracting office code
  1.  S $P(PRCSEG,HLFS,35)=PRCCH            ;Clinger Cohen Act
  1.  S $P(PRCSEG,HLFS,37)=PRCUCD           ;ultimate completion date
  1.  S HLA("HLS",5)=PRCSEG
  1.  G GEN
  1.  ;
  1. AMEND ; Get ready for a short amended message
  1.  S PRCSEG="ZPO"
  1.  S $P(PRCSEG,HLFS,14)=PRCDS            ;date PO was signed
  1.  S $P(PRCSEG,HLFS,16)=PRCRT            ;record type
  1.  S $P(PRCSEG,HLFS,20)="N"              ;contract funded by foreign govt.
  1.  S $P(PRCSEG,HLFS,26)=PRCUV_HLCS_"US"  ;ultimate contract value
  1.  S $P(PRCSEG,HLFS,27)=PRCCV_HLCS_"US"  ;current contract value
  1.  S $P(PRCSEG,HLFS,29)=3600             ;agency identifier
  1.  S $P(PRCSEG,HLFS,33)=3600             ;contracting agency code
  1.  S $P(PRCSEG,HLFS,34)=PRCOFC           ;contracting office code
  1.  S $P(PRCSEG,HLFS,36)=$G(PRCMN)        ;modification number (amendment #)
  1.  S $P(PRCSEG,HLFS,38)=$G(PRCRMC)       ;reason for mod. (amend authority)
  1.  S HLA("HLS",5)=PRCSEG
  1.  ;
  1.  ; Call HL7 to build/send message and get its number (PRCMID)
  1. GEN D GENERATE^HLMA(PRCPROT,"LM",1,.PRCRSULT,"",.PRCOPTNS)
  1.  I $P(PRCRSULT,U,1)]"" S PRCMID=$P(PRCRSULT,U,1)
  1.  S PRCSUB=$S(PRCMID>0:"PRCHAAC1;"_PRCMID,1:"PRCHAAC1;"_"No MID")
  1. MAIL2 ;
  1.  S MSG(1,0)="The following Purchase Order transaction has been sent "
  1.  S MSG(2,0)="to the Austin Automation Center (AAC) to report"
  1.  S MSG(3,0)="required FPDS information. Please keep this information"
  1.  S MSG(4,0)="for two weeks for tracking purposes."
  1.  S MSG(5,0)=" "
  1.  S MSG(6,0)="Purchase Order Number: "_$E(PRCROOT,1,3)_"-"_$E(PRCROOT,4,9)
  1.  S MSG(7,0)=" "
  1.  S MSG(8,0)="The HL7 Message # is: "_PRCMID
  1.  S XMSUB="Message for PO #: "_$E(PRCROOT,1,3)_"-"_$E(PRCROOT,4,9)_" to the AAC"
  1.  ; Get approving official for a delivery order, certified invoice, etc.
  1.  I $D(^PRC(442,PRCHPO,10)) D
  1.  . I $P(^PRC(442,PRCHPO,23),U,11)="D" S PRCAPPO=$P(^PRC(442,PRCHPO,10,1,0),U,2)
  1.  . E  S PRCAPPO=$P(^PRC(442,PRCHPO,10,1,0),U,2)
  1.  ;
  1.  ; Get approving official for an order created by a purchasing agent
  1.  I $P($G(^PRC(442,PRCHPO,23)),U,11)="" D
  1.  . I '$D(^PRC(442,PRCHPO,13)) Q
  1.  . S PRC2237=$P(^PRC(442,PRCHPO,13,0),U,3)
  1.  . S PRCAPPO=$P(^PRC(442,PRCHPO,13,PRC2237,0),U,2)
  1.  ;
  1.  ; Get authorized buyer for all POs
  1.  S PRCPPA=$P(^PRC(442,PRCHPO,1),U,10)
  1.  S XMDUZ=PRCDUZ
  1.  S XMY(PRCPPA)=""
  1.  S:$G(PRCAPPO)'="" XMY(PRCAPPO)=""
  1.  S XMTEXT="MSG("
  1.  D ^XMD
  1.  ;
  1.  D LOG^PRCHAAC2 ;log record of outgoing message to the AAC
  1.  ; Keep track of any error found
  1.  I $P(PRCRSULT,U,2,3)]"",+PRCMID=0 D
  1.  . S PRCMID=$P(PRCRSULT,U,2,3)
  1.  . S PRCERR=1
  1.  . D REC^PRCHAAC2
  1.  K HLA,HL,HLFS,HLCS,HLRS
  1.  Q