- 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 Feb 18, 2025@23:16:13 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