source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCVBLD.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1PRCVBLD ;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 ;
5EN ;
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 ;
20BLD1(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 ;
69YEAR(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 ;
74ETRAP ;
75 D ^%ZTER
76 K PRCVERR ;We want this variable in the error trap
77 D UNWIND^%ZTER
78 Q
Note: See TracBrowser for help on using the repository browser.