Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPEMSG

RCDPEMSG.m

Go to the documentation of this file. 
  1. RCDPEMSG ;ALB/TMK - Server interface to CARC/RARC data from Austin ;01/20/15
  1.  ;;4.5;Accounts Receivable;**303,316**;Mar 20, 1995;Build 2
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Mailman IA 2729
  1.  ; IA 594 - ACCOUNTS RECEIVABLE CATEGORY file (#430.2)
  1.  ; IA 1992 - BILL/CLAIMS file (#399)
  1.  ; IA 3822 - RATE TYPE file (#399.3)
  1.  ; IA 4051 - EXPLANATION OF BENEFITS file (#361.1)
  1.  ; IA 2736 - Mailman
  1.  ;
  1. SERV ; Entry point for server option to process CARC RARC messages received
  1.  ; from Austin. Activated by the option S.RCDPE EDI CARC-RARC SERVER which 
  1.  ; is subscribed to the group G.CARC_RARC_DATA
  1.  ;
  1.  N RCEFLG,RCERR,XMER,RCXMZ,RCTYPE,RCERR
  1.  K ^TMP("RC_CARC_RARC",$J)
  1.  S ^TMP("RC_CARC_RARC",$J,"000")="STARTED-01 "_$G(XMZ)
  1.  S RCXMZ=$G(XMZ)
  1.  ; Read and process the message
  1.  S RCEFLG=$$MSG(RCXMZ,.RCERR)
  1.  D:$G(RCEFLG) EMSG(.RCERR,"G.RCDPE PAYMENTS EXCEPTIONS",RCXMZ)
  1.  ; Remove mail message that has just been processed
  1.  ;D ZAPSERV^XMXAPI("S.RCDPE EDI CARC-RARC SERVER",RCXMZ)
  1.  ;
  1.  S ^TMP("RC_CARC_RARC",$J,"001")="FINISHED"
  1.  ;
  1.  K ^TMP("RC_CARC_RARC",$J)
  1.  ;
  1.  Q
  1.  ;
  1. MSG(RCXMZ,RCERR) ; Read/Store message lines
  1.  ; RCERR = array to hold errors
  1.  ; RCXMZ = Mailman message number to be processed
  1.  ; 
  1.  ; OUTPUT: 0 = No Errors ; 1 = Errors - details in RCERR
  1.  N RCTYP1,RCDATE,RCHD,RCTXN,XMDUZ,RCGBL,RCD,RCFLG,RCCT,RCDXM,X,Y
  1.  N TYPE,CODE,START,MOD,STOP,D0,D1,P1,INREC,DOIT
  1.  S RCFLG=0,INREC=0,RCCT=0,DOIT=1
  1.  S (TYPE,CODE,START,MOD,STOP,D0,D1)=""
  1.  ; Read message, line from mail message is in XMRG variable?
  1.  F  X XMREC Q:XMER<0  S RCCT=RCCT+1,^TMP("RC_CARC_RARC",$J,"MSG",RCCT)=XMRG D
  1.  . S P1=$P(XMRG,U,1)
  1.  . ;If INREC=0 we are between records, skip anything before/in-between/after data records, get next line
  1.  . ;if INREC=1 and P1 is not what we are expecting, then record the error and skip this record when we see the "ZZ" record terminator
  1.  . I (",ZZ,CD,01,02,03,99,")'[(","_P1_",") D:INREC=1 ERR("LINE: "_RCCT_" CODE: "_$G(CODE)_" |"_P1_"|",XMRG,.RCERR) S:INREC=1 DOIT=0 Q
  1.  . E  D
  1.  .. ; If in record and we get a "CD" (new record) or "99" (end of file) Report data error, get next line
  1.  .. I (INREC=1),((P1="CD")!(P1="99")) S X="LINE: "_RCCT_" CODE: "_$G(CODE)_" |"_P1_"|",Y="Out of order record in file message: "_RCXMZ D ERR(X,Y,.RCERR) Q
  1.  .. ; Can't use $CASE which works so, here is the ugly construct to do the same thing
  1.  .. D START(RCCT_" "_P1,XMRG):P1="CD",CODE(RCCT_" "_P1,XMRG):P1="01",DESC(RCCT_" "_P1,XMRG):P1="02",NOTE(RCCT_" "_P1,XMRG):P1="03",END(RCCT_" "_P1,XMRG,.RCERR):P1="ZZ",EOF(RCCT_" "_P1,XMRG):P1="99"
  1.  S:$D(RCERR)>0 RCFLG=1
  1.  Q RCFLG
  1.  ;
  1. ERR(F,LINE,ARR) ; Record a line error
  1.  N EINC
  1.  S ARR("ERROR")=$G(ARR("ERROR"))+1,EINC=ARR("ERROR"),ARR("ERROR",EINC)=F_"  DATA LINE: |"_LINE_"|"
  1.  S ^TMP("RC_CARC_RARC",$J,"00_ERROR",EINC,"MESSAGE_LINE")=F
  1.  S ^TMP("RC_CARC_RARC",$J,"00_ERROR",EINC,"DATA")=LINE
  1.  Q
  1. START(F,LINE) ; "CD" read, set type and indicate a record was entered
  1.  S TYPE=$P(LINE,U,2)
  1.  Q
  1. CODE(F,LINE) ; Process line beginning with "01"
  1.  S CODE=$P(LINE,U,5),START=$P(LINE,U,2),STOP=$P(LINE,U,3),MOD=$P(LINE,U,4),INREC=1
  1.  Q
  1. DESC(F,LINE) ; Process line beginning with "02"
  1.  S D0=$G(D0)_$P(LINE,U,2)
  1.  Q
  1. NOTE(F,LINE) ; Process line beginning with "03"
  1.  S D1=$G(D1)_$P(LINE,U,2)
  1.  Q
  1. END(F,LINE,RCERR) ; Process record reached end of record indicator "ZZ"
  1.  ; File the entry
  1.  N IX,MISS,ZZ,FILE,DATA
  1.  ; If any of the required fields are missing file an error
  1.  I DOIT=0 S DOIT=1 G EQ ; Found error someplace skip this record and reset DOIT variable 
  1.  I ((TYPE'="CARC")&(TYPE'="RARC"))!(CODE="")!(START="")!(D0="") D  D ERR(F_MISS,LINE) I 1
  1.  . S MISS="Missing Required Data: " S:(TYPE'="CARC")&(TYPE'="RARC") MISS=MISS_" Type of Record: |"_TYPE_"|;"
  1.  . S:CODE="" MISS=MISS_" Code;" S:START="" MISS=MISS_" Start Date;" S:D0="" MISS=MISS_" Description;"
  1.  E  D
  1.  . S DATA=CODE_U_D0_U_START_U_MOD_U_STOP_U_D1
  1.  . ; TYPE should be either CARC or RARC
  1.  . S FILE=$S(TYPE="CARC":345,TYPE="RARC":346,1:0)
  1.  . ;See if this is an existing or new record IEN=0 (new) IEN>0 (existing) 
  1.  . S IEN=$$FIND1^DIC(FILE,"","BX",CODE,"","","RCERR")
  1.  . S ^TMP("RC_CARC_RARC",$J,TYPE)=$G(^TMP("RC_CARC_RARC",$J,TYPE))+1,IX=^(TYPE)
  1.  . S ^TMP("RC_CARC_RARC",$J,TYPE,IX)="IEN: "_IEN_" DATA: "_DATA
  1.  . D FILEIT(FILE,IEN,DATA,.RCERR)
  1. EQ ; End Quit 
  1.  S (CODE,START,MOD,STOP,D0,D1)="",INREC=0
  1.  Q
  1.  ;
  1. EOF(F,LINE) ; Reached end of File indicator
  1.  ; Check error array and see if we need to send an email.
  1.  Q
  1.  ;
  1. FILEIT(FILE,IEN,DATA,RCERR) ; Add new record or update existing record
  1.  N I,CODE,DESC,START,STOP,NOTE,FDA,FDAIEN,ERR,RCZ,LMOD
  1.  S LMOD=$$NOW^XLFDT
  1.  S I=+$G(IEN),FDAIEN=$S(+$G(IEN)>0:IEN,1:"+1")
  1.  S CODE=$P(DATA,"^",1),DESC=$P(DATA,"^",2),START=$P(DATA,"^",3),MOD=$P(DATA,"^",4),STOP=$P(DATA,"^",5),NOTE=$P(DATA,"^",6)
  1.  S FDA(I,FILE,FDAIEN_",",.01)=CODE
  1.  S FDA(I,FILE,FDAIEN_",",1)=START
  1.  S:STOP'="" FDA(I,FILE,FDAIEN_",",2)=STOP S:MOD'="" FDA(I,FILE,FDAIEN_",",3)=MOD S:NOTE'="" FDA(I,FILE,FDAIEN_",",5)=NOTE S FDA(I,FILE,FDAIEN_",",6)=LMOD
  1.  ; If there is an IEN then update the existing record otherwise add a new record
  1.  I $G(IEN)>0 D FILE^DIE("E",$NA(FDA(I)),"ERR")
  1.  I $G(IEN)=0 D UPDATE^DIE("E",$NA(FDA(I)),"","ERR") S IEN=$$FIND1^DIC(FILE,"","BX",CODE,"","","ERR") ; Need IEN for WP field
  1.  I $D(ERR)>0 S RCZ=$S($G(IEN)=0:"Adding",1:"Updating") D ERR("Error with "_RCZ_" Data","Code: "_CODE_" Processing did not complete correctly") G FQ
  1.  D WPINS(DESC,IEN,CODE)
  1. FQ ; FILEIT Quit
  1.  K FDA(I),ERR
  1.  Q
  1.  ;
  1. WPINS(DATA,REC,CD) ; Insert data into word processing field
  1.  N DIWL,DIWR,DIWF,ERR,LGT,MID,NXT,RCZ
  1.  K ^UTILITY($J,"W") Set DIWL=1,DIWR=80,DIWF=""
  1.  ; Format Description field for insert to word processing field
  1.  ; if description length is less than 950 chars then insert it to the WP field
  1.  I $L(DATA)<950 S X=DATA,DIWL=1,DIWR=80,DIWF="" D ^DIWP
  1.  D:$L(DATA)>949  ; description of 950 characters or greater - split into 2 strings and insert to WP field
  1.  . S LGT=$L(DATA," "),MID=LGT\2,NXT=MID+1
  1.  . S X=$P(DATA," ",1,MID),DIWL=1,DIWR=80,DIWF="" D ^DIWP
  1.  . S X=$P(DATA," ",NXT,LGT) D ^DIWP
  1.  D WP^DIE(FILE,REC_",",4,"K",$NA(^UTILITY($J,"W",1)),"ERR")
  1.  I $D(ERR) D ERR("Error with CODE: "_CODE_"; "_$G(RCZ)_"Data","Record IEN: "_REC_" Wordprocessing field was not updated correctly")
  1.  Q
  1.  ;
  1.  ; Send error e-mail
  1. EMSG(RCERR,RCEMG,RCXMZ) ; Process Errors - Send bulletin to mail group
  1.  ; RCERR = Error text array
  1.  ; RCEMG = name of the mail group to which these errors should be sent
  1.  ; RCXMZ = internal entry # of the mailman msg with errors
  1.  N CT,XMDUZ,XMSUBJ,XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCXM,RCBODY,RCSUBJ,XMZ,XMERR,Z
  1.  ;
  1.  S CT=0
  1.  ;
  1.  ; Set the error text into RCBODY array to send to mailman
  1.  S RCSUBJ=$$ZSUBJ^XMXUTIL2(RCXMZ)
  1.  S Z=12,RCBODY(1)="ERRORS found processing CARC & RARC data file from FSC:"
  1.  S RCBODY(2)=""
  1.  S RCBODY(3)="The data record within the received message does NOT match the expected format"
  1.  S RCBODY(4)="for VistA to import. Please note that these CARC/RARC codes were NOT updated in"
  1.  S RCBODY(5)="VistA and should be retransmitted from the FSC when fixed."
  1.  S RCBODY(6)=""
  1.  S RCBODY(7)="Mailman Message: "_RCXMZ_" The subject of that message is:"
  1.  S RCBODY(8)="    "_RCSUBJ
  1.  S RCBODY(9)="This message will contain the full text. Line numbers should correspond to"
  1.  S RCBODY(10)="line number in the body of that message."
  1.  S RCBODY(11)=""
  1.  S RCBODY(12)="-----------------------------------------------------------------"
  1.  F  S CT=$O(RCERR("ERROR",CT)) Q:CT=""  S Z=Z+1,RCBODY(Z)=RCERR("ERROR",CT)
  1.  S Z=Z+1,RCBODY(Z)="-----------------------------------------------------------------"
  1.  ;
  1.  I $D(RCEMG) D
  1.  . S:RCEMG="" RCEMG="RCDPE PAYMENTS EXCEPTIONS"
  1.  . S:$E(RCEMG,1,2)'="G." RCEMG="G."_RCEMG
  1.  . S XMTO("I:"_RCEMG)=""
  1.  ;
  1.  S Z=$O(XMTO("")) I Z=.5,'$O(XMTO(.5)) S XMTO("I:G.RCDPE PAYMENTS EXCEPTIONS")=""
  1.  ;
  1.  S XMDUZ=""
  1.  S XMSUBJ="EDI CARC_RARC SERVER OPTION ERROR",XMBODY="RCBODY"
  1.  D
  1.  . N DUZ S DUZ=.5,DUZ(0)="@"
  1.  . D SENDMSG^XMXAPI(DUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
  1.  Q
  1.  ;