| [613] | 1 | RCXVSRV ;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 | ;
|
|---|
| 9 | EN ; 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 | ;
|
|---|
| 17 | REC ; 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 | ;
|
|---|
| 29 | ACK 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 | ;
|
|---|
| 72 | EXIT 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 | ;
|
|---|
| 78 | FWD ; 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
|
|---|
