| 1 | PRCVBLD ;ISC-SF/GJW - Build fund balance notifications ; 6/6/05 1:12pm
|
|---|
| 2 | ;;5.1;IFCAP;**81**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ;
|
|---|
| 6 | ;
|
|---|
| 7 | ;=============================================================
|
|---|
| 8 | ;Format of input array (passed by name):
|
|---|
| 9 | ;
|
|---|
| 10 | ;array("1QBAL") = 1st quarter uncommited balance
|
|---|
| 11 | ;array("2QBAL") = 2nd quarter uncommited balance
|
|---|
| 12 | ;array("3QBAL") = 3rd quarter uncommited balance
|
|---|
| 13 | ;array("4QBAL") = 4th quarter uncommited balance
|
|---|
| 14 | ;array("FY") = fiscal year (2 or 4 digits)
|
|---|
| 15 | ;array("TIME") = time of transaction (FM format)
|
|---|
| 16 | ;array("FCP_NUM") = FCP number (only)
|
|---|
| 17 | ;array("STAT") = station number
|
|---|
| 18 | ;=============================================================
|
|---|
| 19 | ;
|
|---|
| 20 | BLD1(PRCVOBJ) ;simple build (fund balance notification)
|
|---|
| 21 | N PRCVMSG,PROTOCOL,SEG,I,NOW,FCPEXT,ANIENS
|
|---|
| 22 | N PRCVFS,PRCVCS,PRCVRS,PRCVES,PRCVSS
|
|---|
| 23 | N $ES,$ET S $ET="ETRAP^PRCVBLD"
|
|---|
| 24 | S PRCVMSG=$NA(^TMP("HLS",$J)) ;accumulate message here
|
|---|
| 25 | S PROTOCOL="PRCV_DYNAMED_22_EV_FUND_BAL_DATA"
|
|---|
| 26 | D INIT^HLFNC2(PROTOCOL,.HL)
|
|---|
| 27 | I $G(HL) D Q ; error occurred
|
|---|
| 28 | .; put error handler here for init failure
|
|---|
| 29 | .S PRCVERR=$P(HL,2)
|
|---|
| 30 | .S $EC=",U1_HL7_SYSTEM_ERROR,"
|
|---|
| 31 | S PRCVFS=$G(HL("FS")) ;field separator
|
|---|
| 32 | S PRCVCS=$E(HL("ECH"),1) ;component separator
|
|---|
| 33 | S PRCVRS=$E(HL("ECH"),2) ;repetition separator
|
|---|
| 34 | S PRCVES=$E(HL("ECH"),3) ;encoding character
|
|---|
| 35 | S PRCVSS=$E(HL("ECH"),4) ;subcomponent separator
|
|---|
| 36 | S ANIENS=$G(@PRCVOBJ@("FCP_NUM"))_","_$G(@PRCVOBJ@("STAT"))_","
|
|---|
| 37 | S FCPEXT=$P($$GET1^DIQ(420.01,ANIENS,.01)," ",1)
|
|---|
| 38 | ;MFI segment
|
|---|
| 39 | S SEG="MFI"_PRCVFS_"420"_PRCVCS_"CP"_PRCVFS_PRCVFS_"UPD"_PRCVFS
|
|---|
| 40 | S SEG=SEG_$$FMTHL7^XLFDT($$NOW^XLFDT)_PRCVFS_PRCVFS_"AL"
|
|---|
| 41 | S @PRCVMSG@(1)=SEG
|
|---|
| 42 | ;MFE segment
|
|---|
| 43 | S SEG="MFE"_PRCVFS_"MUP"_PRCVFS_PRCVFS_PRCVFS
|
|---|
| 44 | S SEG=SEG_FCPEXT_PRCVFS_"CE"
|
|---|
| 45 | S @PRCVMSG@(2)=SEG
|
|---|
| 46 | ;FT1 segment
|
|---|
| 47 | S SEG="FT1"_PRCVFS_PRCVFS_PRCVFS_$$YEAR($G(@PRCVOBJ@("FY")))
|
|---|
| 48 | S SEG=SEG_PRCVFS_$$FMTHL7^XLFDT($G(@PRCVOBJ@("TIME")))
|
|---|
| 49 | S SEG=SEG_PRCVFS_PRCVFS_"BAL"_PRCVFS_"AVAIL_BAL"
|
|---|
| 50 | S SEG=SEG_PRCVFS_PRCVFS_PRCVFS_PRCVFS
|
|---|
| 51 | S SEG=SEG_+$G(@PRCVOBJ@("1QBAL"))_PRCVSS_"USD"_PRCVRS
|
|---|
| 52 | S SEG=SEG_+$G(@PRCVOBJ@("2QBAL"))_PRCVSS_"USD"_PRCVRS
|
|---|
| 53 | S SEG=SEG_+$G(@PRCVOBJ@("3QBAL"))_PRCVSS_"USD"_PRCVRS
|
|---|
| 54 | S SEG=SEG_+$G(@PRCVOBJ@("4QBAL"))_PRCVSS_"USD"_PRCVFS
|
|---|
| 55 | ;Assorted HL7 noise (not directly used by this interface)
|
|---|
| 56 | S NOW=$$FMTHL7^XLFDT($$NOW^XLFDT)
|
|---|
| 57 | F I=1:1:8 S SEG=SEG_PRCVFS
|
|---|
| 58 | F I=1:1:16 S SEG=SEG_PRCVCS
|
|---|
| 59 | S SEG=SEG_NOW_PRCVSS_NOW
|
|---|
| 60 | S SEG=SEG_PRCVFS
|
|---|
| 61 | F I=1:1:16 S SEG=SEG_PRCVCS
|
|---|
| 62 | S SEG=SEG_NOW_PRCVSS_NOW
|
|---|
| 63 | F I=1:1:3 S SEG=SEG_PRCVFS
|
|---|
| 64 | F I=1:1:16 S SEG=SEG_PRCVCS
|
|---|
| 65 | S SEG=SEG_NOW_PRCVSS_NOW
|
|---|
| 66 | S @PRCVMSG@(3)=SEG
|
|---|
| 67 | Q
|
|---|
| 68 | ;
|
|---|
| 69 | YEAR(PRCVY) ;Expand a (possibly) 2-digit year
|
|---|
| 70 | I PRCVY'?2N Q PRCVY
|
|---|
| 71 | Q $S(PRCVY>90:"19"_PRCVY,1:"20"_PRCVY)
|
|---|
| 72 | ;
|
|---|
| 73 | ;
|
|---|
| 74 | ETRAP ;
|
|---|
| 75 | D ^%ZTER
|
|---|
| 76 | K PRCVERR ;We want this variable in the error trap
|
|---|
| 77 | D UNWIND^%ZTER
|
|---|
| 78 | Q
|
|---|
