source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXVSRV.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1RCXVSRV ;DAOU/ALA-AR Data Extract Server Program
2 ;;4.5;Accounts Receivable;**201**;Mar 20, 1995
3 ;
4 ;**Program Description**
5 ; This program will parse an incoming message
6 ; either as an acknowledgement or as a request
7 ; for a historical extract
8 ;
9EN ; Entry point
10 K ^TMP("ARCXV")
11 S RCXMZ=XMZ,VJOB=$J K ^TMP("RCXVSRV",VJOB)
12 S CT=0 F D Q:XMER'=0
13 . X XMREC Q:XMER'=0
14 . S CT=XMPOS
15 . S ^TMP("RCXVSRV",VJOB,CT)=$G(XMRG)
16 ;
17REC ; Process a record
18 S N="",LFN=1
19 F S N=$O(^TMP("RCXVSRV",VJOB,N)) Q:N="" D
20 . I $G(^TMP("RCXVSRV",VJOB,N))["ACK|"!($G(^TMP("RCXVSRV",VJOB,N))["HIS|") S LFN=N
21 ;
22 S XMRG=$G(^TMP("RCXVSRV",VJOB,LFN)) I XMRG="" Q
23 S ^TMP("ARCXV","XMRG")=$G(XMRG)
24 ; If the type of message is not an ACK (acknowledgement)
25 ; or a HIS (historical extract request), quit
26 S RCXVTYP=$P(XMRG,"|")
27 I RCXVTYP'["ACK"&(RCXVTYP'["HIS") Q
28 ;
29ACK I RCXVTYP["ACK" D
30 . S RCXVNAME=$P(XMRG,"|",2),RCVALUE=$P(XMRG,"|",3),RCFRWD=$P(XMRG,"|",4)
31 . S RCXVNAME=$$UP^XLFSTR(RCXVNAME),RCVALUE=$$UP^XLFSTR(RCVALUE)
32 . I RCVALUE'["AA" Q
33 . S RCXVNAME=$P(RCXVNAME,".TXT",1)
34 . I $E(RCXVNAME,1,4)'="RCXV" S RCXVNAME="RCXV"_$P(RCXVNAME,"RCXV",2)
35 . S RCXVBTN=$E(RCXVNAME,15,$L(RCXVNAME))
36 . ;
37 . S ^TMP("ARCXV","BATCH")=$G(RCXVBTN)
38 . S ^TMP("ARCXV","FILE")=$G(RCXVNAME)
39 . S ^TMP("ARCXV","XMZ")=$G(RCXMZ)
40 . S ^TMP("ARCXV","FDOM")=$G(RCFRWD)
41 . ;
42 . S RCXVLEG=$$GET1^DIQ(342,"1,",20.07,"I")
43 . I '+RCXVLEG,$G(RCFRWD)'="" D FWD Q
44 . ; Find the IEN of the batch number
45 . K ^TMP("RCXVA",VJOB)
46 . D FIND^DIC(348.4,"","","OP",RCXVBTN,"","B","","","^TMP(""RCXVA"",VJOB)")
47 . S RCXVDA=$P($G(^TMP("RCXVA",VJOB,"DILIST",0)),U,1)
48 . S ^TMP("ARCXV","DA")=$G(RCXVDA)
49 . I +RCXVDA=0 Q
50 . S DA=$P($G(^TMP("RCXVA",VJOB,"DILIST",RCXVDA,0)),U,1)
51 . I +DA=0 Q
52 . S RCXVUP(348.4,DA_",",.09)=$$NOW^XLFDT(),RCXVUP(348.4,DA_",",.03)="C"
53 . D FILE^DIE("I","RCXVUP","RCXVERR")
54 ;
55 I RCXVTYP["HIS" D
56 . S RCXVFFD=$P(XMRG,"|",2),RCXVFTD=$P(XMRG,"|",3)
57 . S RCXVFFD=$$DATE^RCXVUTIL(RCXVFFD)
58 . S RCXVFTD=$$DATE^RCXVUTIL(RCXVFTD)
59 . ;
60 . ; Get the next Saturday date
61 . S CURDT=$$DT^XLFDT()
62 . S CDOW=$$DOW^XLFDT(CURDT,1),NDAYS=6-CDOW
63 . S FDATE=$$FMADD^XLFDT(CURDT,NDAYS)
64 . ;
65 . ; Set up TaskMan
66 . S RCVXDSC="CBO HISTORICAL EXTRACT"
67 . S ZTDESC=RCVXDSC,ZTRTN="HIS^RCXVTSK",ZTIO=""
68 . S ZTSAVE("RCXVFTD")="",ZTSAVE("RCXVFFD")=""
69 . S ZTDTH=FDATE_".06"
70 . D ^%ZTLOAD
71 ;
72EXIT K RCXVDA,DA,RCXVUP,RCXVFFD,RCXVFTD,CURDT,CDOW,NDAYS,FDATE,ZTSK
73 K ZTDESC,RCXVDSC,ZTSAVE,ZTDTH,ZTIO,ZTRTN,RCXVTYP,RCXVNAME,RCVALUE
74 K CT,LFN,N,XMER,XMPOS,XMREC,XMRG,XMZ,RCFRWD,RCVXDSC,RCXMZ,RCXVBTN
75 K ^TMP("RCXVA",VJOB),^TMP("RCXVSRV",VJOB),VJOB,XMY,RCXVLEG
76 Q
77 ;
78FWD ; Forward the mail message
79 I $G(DUZ)="" S DUZ=.5
80 I $G(XMZ)="" S XMZ=RCXMZ
81 S XMY(RCFRWD)=""
82 D ENT2^XMD
83 Q
Note: See TracBrowser for help on using the repository browser.