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

RCRCSRV.m

Go to the documentation of this file.
  1. RCRCSRV ;ALB/CMS - RC SERVER DRIVER ; 16-JUN-00
  1. V ;;4.5;Accounts Receivable;**61,87,63,147,159**;Mar 20, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. SERVER ;RC RC SERV SERVER OPTION MAIN ENTRY POINT
  1. ;INPUT : Mailman variables
  1. ;OUTPUT : Sets the XTMP global for certain types of message
  1. ; : Sets the task job in the background if appropriate
  1. ; : Adds Confirmation or Error to AR Transmission File
  1. ;
  1. Q:$G(XMZ)="" Q:'$D(^XMB(3.9,XMZ))
  1. S XMXX="S.RC RC SERV",XMCHAN=1
  1. D SETSB^XMA1C ;Save message in postmaster server basket
  1. N RCBDT,RCCMSG,RCDOM,RCEDT,RCJOB,RCSCE,RCSTA,RCTYP,RCVAR,RCSITE,RCXMY,RCXMZ,RCXTYP
  1. S RCXMZ=XMZ,RCJOB=$J
  1. D READ
  1. D SEND
  1. D TASK
  1. S XMZ=RCXMZ,XMSER="S.RC RC SERV" D REMSBMSG^XMA1C
  1. K XMCHAN,XMDUZ,XMDUN,XMFROM,XMREC,XMSER,XMXX,XMY,XMZ
  1. Q Q
  1. ;
  1. READ ;READ TRANSMISSION CHK FIRST LINE PUT MESSAGE IN XTMP
  1. N II,RCEND,RCNT,XMRG,XMER,X2
  1. S RCNT=0,RCCMSG="",RCSITE=$$SITE^RCMSITE,RCDOM=$G(XMFROM)
  1. F II=0:0 D Q:$G(RCCMSG)]""
  1. .X XMREC S RCNT=RCNT+1
  1. .I $G(XMER)<0 D Q
  1. ..I $G(RCEND)="" S RCCMSG="E;Incomplete message from Regional Counsel"
  1. ..E S RCCMSG="C;AR accepted "_RCNT_" lines successfully."
  1. ..S RCBDT=$P($G(RCEND),"$",4),RCEDT=$P($G(RCEND),"$",5)
  1. ..; I +$P(RCVAR,U,5),$D(^XTMP(RCXTYP,RCJOB,0)) S $P(^XTMP(RCXTYP,RCJOB,0),"^",5)=RCNT
  1. .I RCNT=1 D CHK1 I $G(RCCMSG)]"" Q
  1. .I ($P(XMRG,"$",2)="END")!($P(XMRG,"$",3)="END") S RCEND=XMRG S RCNT=RCNT-1 Q
  1. .I '$L(XMRG) S RCNT=RCNT-1 Q
  1. .I +$P(RCVAR,U,5) S ^XTMP(RCXTYP,RCXMZ,RCNT)=XMRG
  1. Q
  1. ;
  1. SEND ;CONFIRMATION, ERROR, ORIGINAL MESSAGE TRANSPORT
  1. ;I message is the original send confirmation or error to RC
  1. ;INPUT: RCCMSG from Read module always set
  1. ; RCVAR if exists
  1. ;I message is a Confirmation or Error from RC to site quit
  1. I $P(RCCMSG,";",1)="Q" G SENDQ
  1. S RETRY=0
  1. ;
  1. XMB N LN,RCCOM,RCSUB,RCWHO,RETRY,XMDUZ,XMSUB,XMTEXT,XMY,X,Y
  1. ;Line below may not be needed
  1. ;I confirmation don't send to anyone.
  1. I $G(RCDOM)="" S RCDOM=$$RCDOM^RCRCUTL
  1. S:$G(XMFROM)]"" XMY(XMFROM)=""
  1. ;S RCWHO="S.RC RC SERV@"_RCDOM,XMY(RCWHO)=""
  1. S RCWHO=RCDOM,XMY(RCWHO)=""
  1. S Y=DT D D^DIQ
  1. S LN(1)="$$RC$"_$G(RCTYP,"UNK")_"$"_$E(RCCMSG,1)_"$"_$G(RCSITE,"UNK")_"$"
  1. S LN(2)="Status: Mail Message #("_XMZ_") received at the VAMC "_$G(RCSITE,"UNK")_" system on "_Y
  1. S LN(3)=$S($E(RCCMSG,1)="E":"Error ",1:"")_"Message: "_$P(RCCMSG,";",2)
  1. S LN(4)="Desc.: "_$P($G(RCVAR),U,4)
  1. S (RCSUB,XMSUB)="AR/RC - "_$G(RCSITE,"UNK")_" "_$S($E(RCCMSG,1)="C":"CONFIRMATION ("_$G(RCTYP,"UNK")_")",1:"TRANSMISSION ("_$G(RCTYP,"UNK")_") ERROR")_" MESSAGE"
  1. S XMTEXT="LN(",XMDUZ="ACCOUNTS RECEIVABLE RC SERVER"
  1. D ^XMD I XMZ<1 S RETRY=RETRY+1 I RETRY<100 G XMB
  1. S RCCOM=LN(3)
  1. D ENT^RCRCXMS(XMZ,RCSUB,RCWHO,RCCOM)
  1. SENDQ Q
  1. ;
  1. CHK1 ;CHECK FIRST LINE OF TRANSMISSION
  1. ;First Line Syntax:
  1. ;$$RC$S1$$sta#prefix$RC Address
  1. ; o first four characters must be $$RC$
  1. ; o $ piece 4 required must be a server code in routine RCRCVAR
  1. ; o $ piece 5 will be "C" for a confirmation message or
  1. ; "E" for error receiving the message
  1. ; "" for the original transmission of a message
  1. ; o $ piece 6 station number
  1. ; o $ piece 7 is the RC address to send back to at RCDOM
  1. ;Last Line Syntax: $END$#oflines$
  1. ; $END$#oflines$Beg.Ref.DT$End.Ref.DT (Rec Rept. 4 of 4)
  1. ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1. ;INPUT: XMRG - First line of mail message
  1. ;OUTPUT: RCVAR - Server Code^(C,E,O)^Recipient^desc.^0or1^taskroutine
  1. ; or Killed
  1. ; RCCMSG - Error message
  1. ; RCSTA - Station Number
  1. ; RCXMY - send message to
  1. ; RCJOB - $J
  1. ;
  1. I $E(XMRG,1,5)'="$$RC$" S RCCMSG="E;RC Server at site is unable to interpret the first line of this message." G CHK1Q
  1. S RCSCE=$P(XMRG,"$",5) S RCSCE=$S(RCSCE="C":RCSCE,RCSCE="E":RCSCE,RCSCE="":"O",1:"UNK")
  1. S RCTYP=$P(XMRG,"$",4),RCVAR=$$CHK^RCRCVAR(RCTYP,RCSCE)
  1. I $P(RCVAR,";",1)="E" S RCCMSG=RCVAR K RCVAR G CHK1Q
  1. S RCSTA=$P(XMRG,"$",6)
  1. S RCXMY=$P(XMRG,"$",7)
  1. S RCDOM=$G(XMFROM)
  1. ; If original message needs an XTMP global initialize it
  1. I +$P(RCVAR,U,5) D XTMP(RCTYP,$P(RCVAR,U,4))
  1. D FILE
  1. I "CE"[RCSCE S RCCMSG="Q;"
  1. CHK1Q Q
  1. ;
  1. TASK ;If message is original fire off the background job
  1. ;fire off the background task now. (The time the server is run.)
  1. I $G(RCSCE)="O",$E($G(RCCMSG),1)'="E" D TASK^RCRCRR
  1. TASKQ Q
  1. ;
  1. FILE ;Update AR Transmission File
  1. N DA,DIE,DR,RCCOM,RCX,X,Y
  1. I RCSCE="O" D G FILEQ
  1. . S RCSUB=$$SUBGET^XMGAPI0(RCXMZ)
  1. . S RCCOM="RC sent Request Action ("_RCTYP_")."
  1. . D ENT^RCRCXMS(RCXMZ,$G(RCSUB),"RC SERVER AT "_RCSTA,RCCOM)
  1. ;If Message is a Confirm or Error from RC
  1. X XMREC S RCNT=RCNT+1 I XMRG'["STATUS:" G FILEQ
  1. S RCX=+$P(XMRG,"Message ",2)
  1. S DA=$O(^RCT(349.3,"B",RCX,0))
  1. I DA S DIE="^RCT(349.3,",DR=$S(RCSCE="E":6,1:5)_"////^S X="_RCXMZ D ^DIE
  1. I 'DA,RCSCE="E" D
  1. . S RCSUB=$$SUBGET^XMGAPI0(RCXMZ)
  1. . S RCCOM="RC sent Error message ("_RCTYP_")."
  1. . D ENT^RCRCXMS(RCXMZ,$G(RCSUB),"RC SERVER AT "_RCSTA,RCCOM)
  1. FILEQ Q
  1. ;
  1. XTMP(RCTYP,RCDSC) ;INITIALIZE TOP XTMP Global for Server Type
  1. ;INPUT : Type of server message must be passed
  1. ;OUTPUT: XTMP global gets created for this server type
  1. ; : RCXTYP gets set to PRCA_rctype(MR1,RR1,TR,CL...)
  1. ; : RCJOB Job Number
  1. ;XTMP purge data will be 30 days past the create date
  1. N RCDT,X,X1,X2,Y,%,%H,%I
  1. D NOW^%DTC S (X1,RCDT)=X,X2=30 D C^%DTC
  1. S RCXTYP="PRCA"_RCTYP K ^XTMP(RCXTYP,RCXMZ)
  1. S ^XTMP(RCXTYP,RCXMZ,0)=X_"^"_RCDT_"^"_RCDSC_U_RCXMZ
  1. Q
  1. ;RCRCSRV