Changeset 636 for FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEST.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEST.m (modified) (6 diffs)

FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEST.m

@@ -1 +1 @@
 IBCEST ;ALB/TMP - 837 EDI STATUS MESSAGE PROCESSING ;17-APR-96
- ;;2.0;INTEGRATED BILLING;**137,189,197,135,283,320,368**;21-MAR-94;Build 21
- ;;Per VHA Directive 2004-038, this routine should not be modified.
+ ;;2.0;INTEGRATED BILLING;**137,189,197,135,283,320**;21-MAR-94
  ; IA 4042 for call to AUDITX^PRCAUDT
  Q
@@ -63 +62 @@
  ;       1 = single bill 0 = batch
  ; 
- N DA,DIK,DIE,DIC,X,Y,DR,DO,DD,DLAYGO,Z,Z0,Z1,Z2,Z3,IBT,IBDUP,IBFLDS,IBY,IBAUTO,IBLN
+ N DA,DIK,DIE,DIC,X,Y,DR,DO,DD,DLAYGO,Z,Z0,Z1,IBT,IBDUP,IBFLDS,IBY,IBAUTO
  ;
  S X=IBBILL,IBDUP=0
@@ -113 +112 @@
  . D BLDMSG(IB1,IBTDA,.IBT,.IBAUTO)
  . ;
- . ; IB*2*368 - ymg - 2Q,RE,RP messages will be filed as informational
- . ; Z0 is the flag for 2Q code
- . ; Z1 is the flag for RE code
- . ; Z2 is the flag for RP code
- . ; Z3 is the flag for autofiling the message
- . I $P($G(^IBM(361,+IBY,0)),U,3)="R" D
- .. S Z="",(Z0,Z1,Z2,Z3)=0 F  S Z=$O(IBT(Z)) Q:Z=""!(Z3=1)  D
- ... S IBLN=$$UP^XLFSTR($G(IBT(Z)))
- ... I (Z0!Z1!Z2)=0 D
- .... S:IBLN?.E1"CODE:".P1"2Q".E Z0=1
- .... S:IBLN?.E1"CODE:".P1"RE".E Z1=1
- .... S:IBLN?.E1"CODE:".P1"RP".E Z2=1
- ... I Z0=1 S:IBLN?.P1"CLAIM".P1"REJECTED".P1"BY".P1"CLEARINGHOUSE".E Z3=1
- ... I Z1=1 S:IBLN?.P1"ELECTRONIC".P1"CLAIM".P1"REJECTED".P1"BY".P1"EMDEON".E Z3=1
- ... I Z2=1 S:IBLN?.P1"PAPER".P1"CLAIM".P1"REJECTED".P1"BY".P1"EMDEON".E Z3=1
- .. I Z3=1 S IBAUTO=1,DIE=361,DA=+IBY,DR=".03////I" D ^DIE
+ . ; IB*2*320 - esg - 2Q messages will be filed as informational
+ . I $P($G(^IBM(361,+IBY,0)),U,3)="R",$G(IBT(1))["2Q  CLAIM REJECTED BY CLEARINGHOUSE" D
+ .. S IBAUTO=1
+ .. S DIE=361,DA=+IBY,DR=".03////I" D ^DIE
  .. Q
  . ;
@@ -134 +121 @@
  . I $G(IBAUTO),$P($G(^IBM(361,+IBY,0)),U,3)="I" D
  .. S DIE="^IBM(361,",DR=".09////2;.14////1;.1////F",DA=+IBY D ^DIE
- .. I IB1,$P($G(^IBM(361,+IBY,0)),U,11) S Z="",Z0=0 F  S Z=$O(IBT(Z)) Q:Z=""!(Z0=1)  D
- ... S Z0=$$PRINTUPD^IBCEU0($$UP^XLFSTR($G(IBT(Z))),$P($G(^IBM(361,+IBY,0)),U,11))
- . ;
- . D MSGLNSZ(.IBT) ; Convert Message Lines in IBT to be no longer than 70 chars
+ .. I IB1,$P($G(^IBM(361,+IBY,0)),U,11),$$PRINTUPD^IBCEU0($G(IBT(1)),$P($G(^IBM(361,+IBY,0)),U,11))
+ . ;
  . D WP^DIE(361,+IBY_",",1,"A","IBT")    ; file message text
  . ;
@@ -158 +143 @@
  ; Don't move the raw data over, just move the text of the message
  F  S IBZ=$O(^IBA(364.2,IBTDA,2,IBZ)) Q:'IBZ  S IBZ1=$G(^(IBZ,0)) S IBDATA=($E(IBZ1,1,2)="##") Q:IBDATA  S IBZ0=IBZ0+1,IBT(IBZ0)=IBZ1 I 'IBCK S Z=$$CKREVU^IBCEM4(IBZ1,,,.IBCK),IBAUTO=$S(IBCK:0,Z:1,1:IBAUTO)
+ ;
+ ; Convert Message Lines in IBT to be no longer than 70 chars
+ D MSGLNSZ(.IBT)
  Q
  ;
@@ -206 +194 @@
  ; which is an array of Converted Message Lines (with lines no more than 70 chars each)
  ;
- N LN,XARY,XARYLN,CNT,OUTMSG,TMPMSG,LDNGSP,LDNGSPN
- S LN="",CNT=0 F  S LN=$O(MSG(LN)) Q:LN=""  D  ;
+ N LN,XARY,XARYLN,CNT,OUTMSG,TMPMSG,LDNGSP
+ S LN="",CNT=0
+ F  S LN=$O(MSG(LN)) Q:LN=""  D  ;
+ . ;
  . ; Find any leading spaces in original message line, 
  . ; to be used if line got split below
  . S TMPMSG=$$TRIM^XLFSTR(MSG(LN),"L"," ")  ;Trim Leading Spaces
  . S LDNGSP=$P(MSG(LN),TMPMSG,1)  ;get leading spaces if any
- . S LDNGSPN=$L(LDNGSP) S:LDNGSPN>30 LDNGSP=$E(LDNGSP,1,30) ;make sure there are no more than 30 leading spaces 
+ . ;
  . ; Converts a single line to multiple lines with a maximum width of 70 each
  . ; If line is 70 chars or less, this call returns the exact line
- . K XARY D FSTRNG^IBJU1(TMPMSG,70-LDNGSPN,.XARY)
+ . K XARY D FSTRNG^IBJU1(MSG(LN),70,.XARY)
+ . ;
  . ; Scan lines and merge them into the final output array (OUTMSG)
  . ; On lines 2 and higher, add Leading Spaces found above, if any.
- . S XARYLN="" F  S XARYLN=$O(XARY(XARYLN)) Q:XARYLN=""  S CNT=CNT+1,OUTMSG(CNT)=LDNGSP_XARY(XARYLN)
+ . S XARYLN=""
+ . F  S XARYLN=$O(XARY(XARYLN)) Q:XARYLN=""  S CNT=CNT+1,OUTMSG(CNT)=$S(XARYLN=1:XARY(XARYLN),1:LDNGSP_XARY(XARYLN))
  ;
  ; Move the final Message Lines (OUTMSG) into MSG array to be returned
  K MSG M MSG=OUTMSG
- Q
- ;
+ Q  ;MSGLNSZ
+ ;