RCXVSRV ;DAOU/ALA-AR Data Extract Server Program
;;4.5;Accounts Receivable;**201**;Mar 20, 1995
;
;**Program Description**
; This program will parse an incoming message
; either as an acknowledgement or as a request
; for a historical extract
;
EN ; Entry point
K ^TMP("ARCXV")
S RCXMZ=XMZ,VJOB=$J K ^TMP("RCXVSRV",VJOB)
S CT=0 F D Q:XMER'=0
. X XMREC Q:XMER'=0
. S CT=XMPOS
. S ^TMP("RCXVSRV",VJOB,CT)=$G(XMRG)
;
REC ; Process a record
S N="",LFN=1
F S N=$O(^TMP("RCXVSRV",VJOB,N)) Q:N="" D
. I $G(^TMP("RCXVSRV",VJOB,N))["ACK|"!($G(^TMP("RCXVSRV",VJOB,N))["HIS|") S LFN=N
;
S XMRG=$G(^TMP("RCXVSRV",VJOB,LFN)) I XMRG="" Q
S ^TMP("ARCXV","XMRG")=$G(XMRG)
; If the type of message is not an ACK (acknowledgement)
; or a HIS (historical extract request), quit
S RCXVTYP=$P(XMRG,"|")
I RCXVTYP'["ACK"&(RCXVTYP'["HIS") Q
;
ACK I RCXVTYP["ACK" D
. S RCXVNAME=$P(XMRG,"|",2),RCVALUE=$P(XMRG,"|",3),RCFRWD=$P(XMRG,"|",4)
. S RCXVNAME=$$UP^XLFSTR(RCXVNAME),RCVALUE=$$UP^XLFSTR(RCVALUE)
. I RCVALUE'["AA" Q
. S RCXVNAME=$P(RCXVNAME,".TXT",1)
. I $E(RCXVNAME,1,4)'="RCXV" S RCXVNAME="RCXV"_$P(RCXVNAME,"RCXV",2)
. S RCXVBTN=$E(RCXVNAME,15,$L(RCXVNAME))
. ;
. S ^TMP("ARCXV","BATCH")=$G(RCXVBTN)
. S ^TMP("ARCXV","FILE")=$G(RCXVNAME)
. S ^TMP("ARCXV","XMZ")=$G(RCXMZ)
. S ^TMP("ARCXV","FDOM")=$G(RCFRWD)
. ;
. S RCXVLEG=$$GET1^DIQ(342,"1,",20.07,"I")
. I '+RCXVLEG,$G(RCFRWD)'="" D FWD Q
. ; Find the IEN of the batch number
. K ^TMP("RCXVA",VJOB)
. D FIND^DIC(348.4,"","","OP",RCXVBTN,"","B","","","^TMP(""RCXVA"",VJOB)")
. S RCXVDA=$P($G(^TMP("RCXVA",VJOB,"DILIST",0)),U,1)
. S ^TMP("ARCXV","DA")=$G(RCXVDA)
. I +RCXVDA=0 Q
. S DA=$P($G(^TMP("RCXVA",VJOB,"DILIST",RCXVDA,0)),U,1)
. I +DA=0 Q
. S RCXVUP(348.4,DA_",",.09)=$$NOW^XLFDT(),RCXVUP(348.4,DA_",",.03)="C"
. D FILE^DIE("I","RCXVUP","RCXVERR")
;
I RCXVTYP["HIS" D
. S RCXVFFD=$P(XMRG,"|",2),RCXVFTD=$P(XMRG,"|",3)
. S RCXVFFD=$$DATE^RCXVUTIL(RCXVFFD)
. S RCXVFTD=$$DATE^RCXVUTIL(RCXVFTD)
. ;
. ; Get the next Saturday date
. S CURDT=$$DT^XLFDT()
. S CDOW=$$DOW^XLFDT(CURDT,1),NDAYS=6-CDOW
. S FDATE=$$FMADD^XLFDT(CURDT,NDAYS)
. ;
. ; Set up TaskMan
. S RCVXDSC="CBO HISTORICAL EXTRACT"
. S ZTDESC=RCVXDSC,ZTRTN="HIS^RCXVTSK",ZTIO=""
. S ZTSAVE("RCXVFTD")="",ZTSAVE("RCXVFFD")=""
. S ZTDTH=FDATE_".06"
. D ^%ZTLOAD
;
EXIT K RCXVDA,DA,RCXVUP,RCXVFFD,RCXVFTD,CURDT,CDOW,NDAYS,FDATE,ZTSK
K ZTDESC,RCXVDSC,ZTSAVE,ZTDTH,ZTIO,ZTRTN,RCXVTYP,RCXVNAME,RCVALUE
K CT,LFN,N,XMER,XMPOS,XMREC,XMRG,XMZ,RCFRWD,RCVXDSC,RCXMZ,RCXVBTN
K ^TMP("RCXVA",VJOB),^TMP("RCXVSRV",VJOB),VJOB,XMY,RCXVLEG
Q
;
FWD ; Forward the mail message
I $G(DUZ)="" S DUZ=.5
I $G(XMZ)="" S XMZ=RCXMZ
S XMY(RCFRWD)=""
D ENT2^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXVSRV 2811 printed Dec 13, 2024@01:49:49 Page 2
RCXVSRV ;DAOU/ALA-AR Data Extract Server Program
+1 ;;4.5;Accounts Receivable;**201**;Mar 20, 1995
+2 ;
+3 ;**Program Description**
+4 ; This program will parse an incoming message
+5 ; either as an acknowledgement or as a request
+6 ; for a historical extract
+7 ;
EN ; Entry point
+1 KILL ^TMP("ARCXV")
+2 SET RCXMZ=XMZ
SET VJOB=$JOB
KILL ^TMP("RCXVSRV",VJOB)
+3 SET CT=0
FOR
Begin DoDot:1
+4 XECUTE XMREC
if XMER'=0
QUIT
+5 SET CT=XMPOS
+6 SET ^TMP("RCXVSRV",VJOB,CT)=$GET(XMRG)
End DoDot:1
if XMER'=0
QUIT
+7 ;
REC ; Process a record
+1 SET N=""
SET LFN=1
+2 FOR
SET N=$ORDER(^TMP("RCXVSRV",VJOB,N))
if N=""
QUIT
Begin DoDot:1
+3 IF $GET(^TMP("RCXVSRV",VJOB,N))["ACK|"!($GET(^TMP("RCXVSRV",VJOB,N))["HIS|")
SET LFN=N
End DoDot:1
+4 ;
+5 SET XMRG=$GET(^TMP("RCXVSRV",VJOB,LFN))
IF XMRG=""
QUIT
+6 SET ^TMP("ARCXV","XMRG")=$GET(XMRG)
+7 ; If the type of message is not an ACK (acknowledgement)
+8 ; or a HIS (historical extract request), quit
+9 SET RCXVTYP=$PIECE(XMRG,"|")
+10 IF RCXVTYP'["ACK"&(RCXVTYP'["HIS")
QUIT
+11 ;
ACK IF RCXVTYP["ACK"
Begin DoDot:1
+1 SET RCXVNAME=$PIECE(XMRG,"|",2)
SET RCVALUE=$PIECE(XMRG,"|",3)
SET RCFRWD=$PIECE(XMRG,"|",4)
+2 SET RCXVNAME=$$UP^XLFSTR(RCXVNAME)
SET RCVALUE=$$UP^XLFSTR(RCVALUE)
+3 IF RCVALUE'["AA"
QUIT
+4 SET RCXVNAME=$PIECE(RCXVNAME,".TXT",1)
+5 IF $EXTRACT(RCXVNAME,1,4)'="RCXV"
SET RCXVNAME="RCXV"_$PIECE(RCXVNAME,"RCXV",2)
+6 SET RCXVBTN=$EXTRACT(RCXVNAME,15,$LENGTH(RCXVNAME))
+7 ;
+8 SET ^TMP("ARCXV","BATCH")=$GET(RCXVBTN)
+9 SET ^TMP("ARCXV","FILE")=$GET(RCXVNAME)
+10 SET ^TMP("ARCXV","XMZ")=$GET(RCXMZ)
+11 SET ^TMP("ARCXV","FDOM")=$GET(RCFRWD)
+12 ;
+13 SET RCXVLEG=$$GET1^DIQ(342,"1,",20.07,"I")
+14 IF '+RCXVLEG
IF $GET(RCFRWD)'=""
DO FWD
QUIT
+15 ; Find the IEN of the batch number
+16 KILL ^TMP("RCXVA",VJOB)
+17 DO FIND^DIC(348.4,"","","OP",RCXVBTN,"","B","","","^TMP(""RCXVA"",VJOB)")
+18 SET RCXVDA=$PIECE($GET(^TMP("RCXVA",VJOB,"DILIST",0)),U,1)
+19 SET ^TMP("ARCXV","DA")=$GET(RCXVDA)
+20 IF +RCXVDA=0
QUIT
+21 SET DA=$PIECE($GET(^TMP("RCXVA",VJOB,"DILIST",RCXVDA,0)),U,1)
+22 IF +DA=0
QUIT
+23 SET RCXVUP(348.4,DA_",",.09)=$$NOW^XLFDT()
SET RCXVUP(348.4,DA_",",.03)="C"
+24 DO FILE^DIE("I","RCXVUP","RCXVERR")
End DoDot:1
+25 ;
+26 IF RCXVTYP["HIS"
Begin DoDot:1
+27 SET RCXVFFD=$PIECE(XMRG,"|",2)
SET RCXVFTD=$PIECE(XMRG,"|",3)
+28 SET RCXVFFD=$$DATE^RCXVUTIL(RCXVFFD)
+29 SET RCXVFTD=$$DATE^RCXVUTIL(RCXVFTD)
+30 ;
+31 ; Get the next Saturday date
+32 SET CURDT=$$DT^XLFDT()
+33 SET CDOW=$$DOW^XLFDT(CURDT,1)
SET NDAYS=6-CDOW
+34 SET FDATE=$$FMADD^XLFDT(CURDT,NDAYS)
+35 ;
+36 ; Set up TaskMan
+37 SET RCVXDSC="CBO HISTORICAL EXTRACT"
+38 SET ZTDESC=RCVXDSC
SET ZTRTN="HIS^RCXVTSK"
SET ZTIO=""
+39 SET ZTSAVE("RCXVFTD")=""
SET ZTSAVE("RCXVFFD")=""
+40 SET ZTDTH=FDATE_".06"
+41 DO ^%ZTLOAD
End DoDot:1
+42 ;
EXIT KILL RCXVDA,DA,RCXVUP,RCXVFFD,RCXVFTD,CURDT,CDOW,NDAYS,FDATE,ZTSK
+1 KILL ZTDESC,RCXVDSC,ZTSAVE,ZTDTH,ZTIO,ZTRTN,RCXVTYP,RCXVNAME,RCVALUE
+2 KILL CT,LFN,N,XMER,XMPOS,XMREC,XMRG,XMZ,RCFRWD,RCVXDSC,RCXMZ,RCXVBTN
+3 KILL ^TMP("RCXVA",VJOB),^TMP("RCXVSRV",VJOB),VJOB,XMY,RCXVLEG
+4 QUIT
+5 ;
FWD ; Forward the mail message
+1 IF $GET(DUZ)=""
SET DUZ=.5
+2 IF $GET(XMZ)=""
SET XMZ=RCXMZ
+3 SET XMY(RCFRWD)=""
+4 DO ENT2^XMD
+5 QUIT
