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

RCXVSRV.m

Go to the documentation of this file.
  1. RCXVSRV ;DAOU/ALA-AR Data Extract Server Program
  1. ;;4.5;Accounts Receivable;**201**;Mar 20, 1995
  1. ;
  1. ;**Program Description**
  1. ; This program will parse an incoming message
  1. ; either as an acknowledgement or as a request
  1. ; for a historical extract
  1. ;
  1. EN ; Entry point
  1. K ^TMP("ARCXV")
  1. S RCXMZ=XMZ,VJOB=$J K ^TMP("RCXVSRV",VJOB)
  1. S CT=0 F D Q:XMER'=0
  1. . X XMREC Q:XMER'=0
  1. . S CT=XMPOS
  1. . S ^TMP("RCXVSRV",VJOB,CT)=$G(XMRG)
  1. ;
  1. REC ; Process a record
  1. S N="",LFN=1
  1. F S N=$O(^TMP("RCXVSRV",VJOB,N)) Q:N="" D
  1. . I $G(^TMP("RCXVSRV",VJOB,N))["ACK|"!($G(^TMP("RCXVSRV",VJOB,N))["HIS|") S LFN=N
  1. ;
  1. S XMRG=$G(^TMP("RCXVSRV",VJOB,LFN)) I XMRG="" Q
  1. S ^TMP("ARCXV","XMRG")=$G(XMRG)
  1. ; If the type of message is not an ACK (acknowledgement)
  1. ; or a HIS (historical extract request), quit
  1. S RCXVTYP=$P(XMRG,"|")
  1. I RCXVTYP'["ACK"&(RCXVTYP'["HIS") Q
  1. ;
  1. ACK I RCXVTYP["ACK" D
  1. . S RCXVNAME=$P(XMRG,"|",2),RCVALUE=$P(XMRG,"|",3),RCFRWD=$P(XMRG,"|",4)
  1. . S RCXVNAME=$$UP^XLFSTR(RCXVNAME),RCVALUE=$$UP^XLFSTR(RCVALUE)
  1. . I RCVALUE'["AA" Q
  1. . S RCXVNAME=$P(RCXVNAME,".TXT",1)
  1. . I $E(RCXVNAME,1,4)'="RCXV" S RCXVNAME="RCXV"_$P(RCXVNAME,"RCXV",2)
  1. . S RCXVBTN=$E(RCXVNAME,15,$L(RCXVNAME))
  1. . ;
  1. . S ^TMP("ARCXV","BATCH")=$G(RCXVBTN)
  1. . S ^TMP("ARCXV","FILE")=$G(RCXVNAME)
  1. . S ^TMP("ARCXV","XMZ")=$G(RCXMZ)
  1. . S ^TMP("ARCXV","FDOM")=$G(RCFRWD)
  1. . ;
  1. . S RCXVLEG=$$GET1^DIQ(342,"1,",20.07,"I")
  1. . I '+RCXVLEG,$G(RCFRWD)'="" D FWD Q
  1. . ; Find the IEN of the batch number
  1. . K ^TMP("RCXVA",VJOB)
  1. . D FIND^DIC(348.4,"","","OP",RCXVBTN,"","B","","","^TMP(""RCXVA"",VJOB)")
  1. . S RCXVDA=$P($G(^TMP("RCXVA",VJOB,"DILIST",0)),U,1)
  1. . S ^TMP("ARCXV","DA")=$G(RCXVDA)
  1. . I +RCXVDA=0 Q
  1. . S DA=$P($G(^TMP("RCXVA",VJOB,"DILIST",RCXVDA,0)),U,1)
  1. . I +DA=0 Q
  1. . S RCXVUP(348.4,DA_",",.09)=$$NOW^XLFDT(),RCXVUP(348.4,DA_",",.03)="C"
  1. . D FILE^DIE("I","RCXVUP","RCXVERR")
  1. ;
  1. I RCXVTYP["HIS" D
  1. . S RCXVFFD=$P(XMRG,"|",2),RCXVFTD=$P(XMRG,"|",3)
  1. . S RCXVFFD=$$DATE^RCXVUTIL(RCXVFFD)
  1. . S RCXVFTD=$$DATE^RCXVUTIL(RCXVFTD)
  1. . ;
  1. . ; Get the next Saturday date
  1. . S CURDT=$$DT^XLFDT()
  1. . S CDOW=$$DOW^XLFDT(CURDT,1),NDAYS=6-CDOW
  1. . S FDATE=$$FMADD^XLFDT(CURDT,NDAYS)
  1. . ;
  1. . ; Set up TaskMan
  1. . S RCVXDSC="CBO HISTORICAL EXTRACT"
  1. . S ZTDESC=RCVXDSC,ZTRTN="HIS^RCXVTSK",ZTIO=""
  1. . S ZTSAVE("RCXVFTD")="",ZTSAVE("RCXVFFD")=""
  1. . S ZTDTH=FDATE_".06"
  1. . D ^%ZTLOAD
  1. ;
  1. EXIT K RCXVDA,DA,RCXVUP,RCXVFFD,RCXVFTD,CURDT,CDOW,NDAYS,FDATE,ZTSK
  1. K ZTDESC,RCXVDSC,ZTSAVE,ZTDTH,ZTIO,ZTRTN,RCXVTYP,RCXVNAME,RCVALUE
  1. K CT,LFN,N,XMER,XMPOS,XMREC,XMRG,XMZ,RCFRWD,RCVXDSC,RCXMZ,RCXVBTN
  1. K ^TMP("RCXVA",VJOB),^TMP("RCXVSRV",VJOB),VJOB,XMY,RCXVLEG
  1. Q
  1. ;
  1. FWD ; Forward the mail message
  1. I $G(DUZ)="" S DUZ=.5
  1. I $G(XMZ)="" S XMZ=RCXMZ
  1. S XMY(RCFRWD)=""
  1. D ENT2^XMD
  1. Q