Changeset 636 for FOIAVistA/tag/r/PAID-PRS/PRSDSERV.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• PAID-PRS/PRSDSERV.m (modified) (4 diffs)

FOIAVistA/tag/r/PAID-PRS/PRSDSERV.m

@@ -1 @@
-PRSDSERV ;WOIFO/MGD,PLT - PAID DOWNLOAD MESSAGE SERVER ;12/3/07
- ;;4.0;PAID;**6,78,82,116**;Sep 21, 1995;Build 23
- ;;Per VHA Directive 2004-038, this routine should not be modified.
+PRSDSERV ;HISC/MGD-PAID DOWNLOAD MESSAGE SERVER ;09/13/2003
+ ;;4.0;PAID;**6,78,82**;Sep 21, 1995
  D NOW^%DTC S TIME=% S XMPOS=1 D REC^XMS3 G:XMER'=0 EXIT
- S LPE=$E(XMRG,1,7) I LPE'?1"**"2N1"PDH",LPE'="****PDH" G EXIT
+ G:$E(XMRG,1,7)'="****PDH" EXIT
  ; EMPCNT = # emp in this mail message
  ; SEQNUM = Mail message sequence number if more than one message
@@ -12 +11 @@
  I $D(^PRSD(450.12,"B",XMZ)) G EXIT
  S MTYPE=$S(TYPE="I":"Initial",TYPE="E":"Edit & Update",TYPE="P":"Payrun",TYPE="T":"Transfer",1:"")
- ; Set Lines Per Employee (LPE) for the correct interface
- S LPE=$E(LPE,3,4),LPE=$S(LPE?2N:+LPE,TYPE="I":20,(TYPE="E")!(TYPE="T"):15,TYPE="P":9,1:0)
  D REC^XMS3 G:XMER'=0 EXIT S STA=$E(XMRG,1,3) I STA'?3N G EXIT
  I TYPE="D" D ^PRSDDL G EXIT  ; Process Separation download
@@ -26 +23 @@
  S $P(^PRSD(450.12,+Y,0),U,3)="R",$P(^PRSD(450.12,+Y,0),U,4)=TIME
  S ^PRSD(450.12,"C",TYPE_"-"_DATE_"-"_STA_"-"_SEQNUM,+Y)=""
-SETPRS ;start employee record
+ ; Set Lines Per Employee (LPE) for the correct interface
+SETPRS S LPE=$S(TYPE="I":20,(TYPE="E")!(TYPE="T"):15,TYPE="P":9,1:0)
  S XMPOS=2 F A=1:1:EMPCNT D SSNLOOP Q:SSN=999999999
  I $D(^XTMP("PRS","MNR",TYPE,DATE,STA,SEQNUM)) K ^XTMP("PRS","MNR",TYPE,DATE,STA,SEQNUM) Q
@@ -70 +68 @@
  Q
  ; Piece together the routine name and call the routine
-PROC S TMPIEN="" F  S TMPIEN=$O(^XTMP("PRS",SUB,DATE,TYPE,STA,SSN,TMPIEN)) Q:TMPIEN=""  S RCD=^XTMP("PRS",SUB,DATE,TYPE,STA,SSN,TMPIEN),RTNNUM=$P(TMPIEN,"-",3) S:$L(RTNNUM)=1 RTNNUM=0_RTNNUM S RTN="^PRSD"_RTYPE_RTNNUM D:$T(@RTN)]"" @RTN
+PROC S TMPIEN="" F  S TMPIEN=$O(^XTMP("PRS",SUB,DATE,TYPE,STA,SSN,TMPIEN)) Q:TMPIEN=""  S RCD=^XTMP("PRS",SUB,DATE,TYPE,STA,SSN,TMPIEN),RTNNUM=$P(TMPIEN,"-",3) S:$L(RTNNUM)=1 RTNNUM=0_RTNNUM S RTN="^PRSD"_RTYPE_RTNNUM D @RTN
  Q
 PROC2 I TYPE="P",PP'="" D ^PRSDCOMP  ;Compute calculated fields