PRCVBLD ;ISC-SF/GJW - Build fund balance notifications ; 6/6/05 1:12pm
;;5.1;IFCAP;**81**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ;
;
;=============================================================
;Format of input array (passed by name):
;
;array("1QBAL") = 1st quarter uncommited balance
;array("2QBAL") = 2nd quarter uncommited balance
;array("3QBAL") = 3rd quarter uncommited balance
;array("4QBAL") = 4th quarter uncommited balance
;array("FY") = fiscal year (2 or 4 digits)
;array("TIME") = time of transaction (FM format)
;array("FCP_NUM") = FCP number (only)
;array("STAT") = station number
;=============================================================
;
BLD1(PRCVOBJ) ;simple build (fund balance notification)
N PRCVMSG,PROTOCOL,SEG,I,NOW,FCPEXT,ANIENS
N PRCVFS,PRCVCS,PRCVRS,PRCVES,PRCVSS
N $ES,$ET S $ET="ETRAP^PRCVBLD"
S PRCVMSG=$NA(^TMP("HLS",$J)) ;accumulate message here
S PROTOCOL="PRCV_DYNAMED_22_EV_FUND_BAL_DATA"
D INIT^HLFNC2(PROTOCOL,.HL)
I $G(HL) D Q ; error occurred
.; put error handler here for init failure
.S PRCVERR=$P(HL,2)
.S $EC=",U1_HL7_SYSTEM_ERROR,"
S PRCVFS=$G(HL("FS")) ;field separator
S PRCVCS=$E(HL("ECH"),1) ;component separator
S PRCVRS=$E(HL("ECH"),2) ;repetition separator
S PRCVES=$E(HL("ECH"),3) ;encoding character
S PRCVSS=$E(HL("ECH"),4) ;subcomponent separator
S ANIENS=$G(@PRCVOBJ@("FCP_NUM"))_","_$G(@PRCVOBJ@("STAT"))_","
S FCPEXT=$P($$GET1^DIQ(420.01,ANIENS,.01)," ",1)
;MFI segment
S SEG="MFI"_PRCVFS_"420"_PRCVCS_"CP"_PRCVFS_PRCVFS_"UPD"_PRCVFS
S SEG=SEG_$$FMTHL7^XLFDT($$NOW^XLFDT)_PRCVFS_PRCVFS_"AL"
S @PRCVMSG@(1)=SEG
;MFE segment
S SEG="MFE"_PRCVFS_"MUP"_PRCVFS_PRCVFS_PRCVFS
S SEG=SEG_FCPEXT_PRCVFS_"CE"
S @PRCVMSG@(2)=SEG
;FT1 segment
S SEG="FT1"_PRCVFS_PRCVFS_PRCVFS_$$YEAR($G(@PRCVOBJ@("FY")))
S SEG=SEG_PRCVFS_$$FMTHL7^XLFDT($G(@PRCVOBJ@("TIME")))
S SEG=SEG_PRCVFS_PRCVFS_"BAL"_PRCVFS_"AVAIL_BAL"
S SEG=SEG_PRCVFS_PRCVFS_PRCVFS_PRCVFS
S SEG=SEG_+$G(@PRCVOBJ@("1QBAL"))_PRCVSS_"USD"_PRCVRS
S SEG=SEG_+$G(@PRCVOBJ@("2QBAL"))_PRCVSS_"USD"_PRCVRS
S SEG=SEG_+$G(@PRCVOBJ@("3QBAL"))_PRCVSS_"USD"_PRCVRS
S SEG=SEG_+$G(@PRCVOBJ@("4QBAL"))_PRCVSS_"USD"_PRCVFS
;Assorted HL7 noise (not directly used by this interface)
S NOW=$$FMTHL7^XLFDT($$NOW^XLFDT)
F I=1:1:8 S SEG=SEG_PRCVFS
F I=1:1:16 S SEG=SEG_PRCVCS
S SEG=SEG_NOW_PRCVSS_NOW
S SEG=SEG_PRCVFS
F I=1:1:16 S SEG=SEG_PRCVCS
S SEG=SEG_NOW_PRCVSS_NOW
F I=1:1:3 S SEG=SEG_PRCVFS
F I=1:1:16 S SEG=SEG_PRCVCS
S SEG=SEG_NOW_PRCVSS_NOW
S @PRCVMSG@(3)=SEG
Q
;
YEAR(PRCVY) ;Expand a (possibly) 2-digit year
I PRCVY'?2N Q PRCVY
Q $S(PRCVY>90:"19"_PRCVY,1:"20"_PRCVY)
;
;
ETRAP ;
D ^%ZTER
K PRCVERR ;We want this variable in the error trap
D UNWIND^%ZTER
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCVBLD 2852 printed Dec 13, 2024@02:19:57 Page 2
PRCVBLD ;ISC-SF/GJW - Build fund balance notifications ; 6/6/05 1:12pm
+1 ;;5.1;IFCAP;**81**;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ;
+1 ;
+2 ;=============================================================
+3 ;Format of input array (passed by name):
+4 ;
+5 ;array("1QBAL") = 1st quarter uncommited balance
+6 ;array("2QBAL") = 2nd quarter uncommited balance
+7 ;array("3QBAL") = 3rd quarter uncommited balance
+8 ;array("4QBAL") = 4th quarter uncommited balance
+9 ;array("FY") = fiscal year (2 or 4 digits)
+10 ;array("TIME") = time of transaction (FM format)
+11 ;array("FCP_NUM") = FCP number (only)
+12 ;array("STAT") = station number
+13 ;=============================================================
+14 ;
BLD1(PRCVOBJ) ;simple build (fund balance notification)
+1 NEW PRCVMSG,PROTOCOL,SEG,I,NOW,FCPEXT,ANIENS
+2 NEW PRCVFS,PRCVCS,PRCVRS,PRCVES,PRCVSS
+3 NEW $ESTACK,$ETRAP
SET $ETRAP="ETRAP^PRCVBLD"
+4 ;accumulate message here
SET PRCVMSG=$NAME(^TMP("HLS",$JOB))
+5 SET PROTOCOL="PRCV_DYNAMED_22_EV_FUND_BAL_DATA"
+6 DO INIT^HLFNC2(PROTOCOL,.HL)
+7 ; error occurred
IF $GET(HL)
Begin DoDot:1
+8 ; put error handler here for init failure
+9 SET PRCVERR=$PIECE(HL,2)
+10 SET $ECODE=",U1_HL7_SYSTEM_ERROR,"
End DoDot:1
QUIT
+11 ;field separator
SET PRCVFS=$GET(HL("FS"))
+12 ;component separator
SET PRCVCS=$EXTRACT(HL("ECH"),1)
+13 ;repetition separator
SET PRCVRS=$EXTRACT(HL("ECH"),2)
+14 ;encoding character
SET PRCVES=$EXTRACT(HL("ECH"),3)
+15 ;subcomponent separator
SET PRCVSS=$EXTRACT(HL("ECH"),4)
+16 SET ANIENS=$GET(@PRCVOBJ@("FCP_NUM"))_","_$GET(@PRCVOBJ@("STAT"))_","
+17 SET FCPEXT=$PIECE($$GET1^DIQ(420.01,ANIENS,.01)," ",1)
+18 ;MFI segment
+19 SET SEG="MFI"_PRCVFS_"420"_PRCVCS_"CP"_PRCVFS_PRCVFS_"UPD"_PRCVFS
+20 SET SEG=SEG_$$FMTHL7^XLFDT($$NOW^XLFDT)_PRCVFS_PRCVFS_"AL"
+21 SET @PRCVMSG@(1)=SEG
+22 ;MFE segment
+23 SET SEG="MFE"_PRCVFS_"MUP"_PRCVFS_PRCVFS_PRCVFS
+24 SET SEG=SEG_FCPEXT_PRCVFS_"CE"
+25 SET @PRCVMSG@(2)=SEG
+26 ;FT1 segment
+27 SET SEG="FT1"_PRCVFS_PRCVFS_PRCVFS_$$YEAR($GET(@PRCVOBJ@("FY")))
+28 SET SEG=SEG_PRCVFS_$$FMTHL7^XLFDT($GET(@PRCVOBJ@("TIME")))
+29 SET SEG=SEG_PRCVFS_PRCVFS_"BAL"_PRCVFS_"AVAIL_BAL"
+30 SET SEG=SEG_PRCVFS_PRCVFS_PRCVFS_PRCVFS
+31 SET SEG=SEG_+$GET(@PRCVOBJ@("1QBAL"))_PRCVSS_"USD"_PRCVRS
+32 SET SEG=SEG_+$GET(@PRCVOBJ@("2QBAL"))_PRCVSS_"USD"_PRCVRS
+33 SET SEG=SEG_+$GET(@PRCVOBJ@("3QBAL"))_PRCVSS_"USD"_PRCVRS
+34 SET SEG=SEG_+$GET(@PRCVOBJ@("4QBAL"))_PRCVSS_"USD"_PRCVFS
+35 ;Assorted HL7 noise (not directly used by this interface)
+36 SET NOW=$$FMTHL7^XLFDT($$NOW^XLFDT)
+37 FOR I=1:1:8
SET SEG=SEG_PRCVFS
+38 FOR I=1:1:16
SET SEG=SEG_PRCVCS
+39 SET SEG=SEG_NOW_PRCVSS_NOW
+40 SET SEG=SEG_PRCVFS
+41 FOR I=1:1:16
SET SEG=SEG_PRCVCS
+42 SET SEG=SEG_NOW_PRCVSS_NOW
+43 FOR I=1:1:3
SET SEG=SEG_PRCVFS
+44 FOR I=1:1:16
SET SEG=SEG_PRCVCS
+45 SET SEG=SEG_NOW_PRCVSS_NOW
+46 SET @PRCVMSG@(3)=SEG
+47 QUIT
+48 ;
YEAR(PRCVY) ;Expand a (possibly) 2-digit year
+1 IF PRCVY'?2N
QUIT PRCVY
+2 QUIT $SELECT(PRCVY>90:"19"_PRCVY,1:"20"_PRCVY)
+3 ;
+4 ;
ETRAP ;
+1 DO ^%ZTER
+2 ;We want this variable in the error trap
KILL PRCVERR
+3 DO UNWIND^%ZTER
+4 QUIT
