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

PRCVBLD.m

Go to the documentation of this file.
  1. PRCVBLD ;ISC-SF/GJW - Build fund balance notifications ; 6/6/05 1:12pm
  1. ;;5.1;IFCAP;**81**;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. EN ;
  1. ;
  1. ;=============================================================
  1. ;Format of input array (passed by name):
  1. ;
  1. ;array("1QBAL") = 1st quarter uncommited balance
  1. ;array("2QBAL") = 2nd quarter uncommited balance
  1. ;array("3QBAL") = 3rd quarter uncommited balance
  1. ;array("4QBAL") = 4th quarter uncommited balance
  1. ;array("FY") = fiscal year (2 or 4 digits)
  1. ;array("TIME") = time of transaction (FM format)
  1. ;array("FCP_NUM") = FCP number (only)
  1. ;array("STAT") = station number
  1. ;=============================================================
  1. ;
  1. BLD1(PRCVOBJ) ;simple build (fund balance notification)
  1. N PRCVMSG,PROTOCOL,SEG,I,NOW,FCPEXT,ANIENS
  1. N PRCVFS,PRCVCS,PRCVRS,PRCVES,PRCVSS
  1. N $ES,$ET S $ET="ETRAP^PRCVBLD"
  1. S PRCVMSG=$NA(^TMP("HLS",$J)) ;accumulate message here
  1. S PROTOCOL="PRCV_DYNAMED_22_EV_FUND_BAL_DATA"
  1. D INIT^HLFNC2(PROTOCOL,.HL)
  1. I $G(HL) D Q ; error occurred
  1. .; put error handler here for init failure
  1. .S PRCVERR=$P(HL,2)
  1. .S $EC=",U1_HL7_SYSTEM_ERROR,"
  1. S PRCVFS=$G(HL("FS")) ;field separator
  1. S PRCVCS=$E(HL("ECH"),1) ;component separator
  1. S PRCVRS=$E(HL("ECH"),2) ;repetition separator
  1. S PRCVES=$E(HL("ECH"),3) ;encoding character
  1. S PRCVSS=$E(HL("ECH"),4) ;subcomponent separator
  1. S ANIENS=$G(@PRCVOBJ@("FCP_NUM"))_","_$G(@PRCVOBJ@("STAT"))_","
  1. S FCPEXT=$P($$GET1^DIQ(420.01,ANIENS,.01)," ",1)
  1. ;MFI segment
  1. S SEG="MFI"_PRCVFS_"420"_PRCVCS_"CP"_PRCVFS_PRCVFS_"UPD"_PRCVFS
  1. S SEG=SEG_$$FMTHL7^XLFDT($$NOW^XLFDT)_PRCVFS_PRCVFS_"AL"
  1. S @PRCVMSG@(1)=SEG
  1. ;MFE segment
  1. S SEG="MFE"_PRCVFS_"MUP"_PRCVFS_PRCVFS_PRCVFS
  1. S SEG=SEG_FCPEXT_PRCVFS_"CE"
  1. S @PRCVMSG@(2)=SEG
  1. ;FT1 segment
  1. S SEG="FT1"_PRCVFS_PRCVFS_PRCVFS_$$YEAR($G(@PRCVOBJ@("FY")))
  1. S SEG=SEG_PRCVFS_$$FMTHL7^XLFDT($G(@PRCVOBJ@("TIME")))
  1. S SEG=SEG_PRCVFS_PRCVFS_"BAL"_PRCVFS_"AVAIL_BAL"
  1. S SEG=SEG_PRCVFS_PRCVFS_PRCVFS_PRCVFS
  1. S SEG=SEG_+$G(@PRCVOBJ@("1QBAL"))_PRCVSS_"USD"_PRCVRS
  1. S SEG=SEG_+$G(@PRCVOBJ@("2QBAL"))_PRCVSS_"USD"_PRCVRS
  1. S SEG=SEG_+$G(@PRCVOBJ@("3QBAL"))_PRCVSS_"USD"_PRCVRS
  1. S SEG=SEG_+$G(@PRCVOBJ@("4QBAL"))_PRCVSS_"USD"_PRCVFS
  1. ;Assorted HL7 noise (not directly used by this interface)
  1. S NOW=$$FMTHL7^XLFDT($$NOW^XLFDT)
  1. F I=1:1:8 S SEG=SEG_PRCVFS
  1. F I=1:1:16 S SEG=SEG_PRCVCS
  1. S SEG=SEG_NOW_PRCVSS_NOW
  1. S SEG=SEG_PRCVFS
  1. F I=1:1:16 S SEG=SEG_PRCVCS
  1. S SEG=SEG_NOW_PRCVSS_NOW
  1. F I=1:1:3 S SEG=SEG_PRCVFS
  1. F I=1:1:16 S SEG=SEG_PRCVCS
  1. S SEG=SEG_NOW_PRCVSS_NOW
  1. S @PRCVMSG@(3)=SEG
  1. Q
  1. ;
  1. YEAR(PRCVY) ;Expand a (possibly) 2-digit year
  1. I PRCVY'?2N Q PRCVY
  1. Q $S(PRCVY>90:"19"_PRCVY,1:"20"_PRCVY)
  1. ;
  1. ;
  1. ETRAP ;
  1. D ^%ZTER
  1. K PRCVERR ;We want this variable in the error trap
  1. D UNWIND^%ZTER
  1. Q