- 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 Jan 18, 2025@03:21:07 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