source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFVEX1.m@ 691

Last change on this file since 691 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1PRCFVEX1 ;WASH IRM/KCMO;SERVER to process returned DUNS numbers; ;8/26/96 11:33
2 ;;5.0;IFCAP;**84**;4/21/95
3 ;
4 Q:XQSUB'["EDV" ; Must be one of our Messages
5 N FACID,XMSER,XMZ,IEN,DUNS,CURR,I K ^TMP($J)
6 S FACID=$P($G(^XTV(8989.3,1,"XUS")),U,17) ;Default Institution KSP
7 S XMZ=XQMSG
8 ;
9REC ; -- Read the Msg lines, Parse and Process
10 X XMREC G STAT:XMER<0 D G REC
11 . Q:$P(XMRG,U)'[FACID ; -- Line must begin with Station Number
12 . S IEN=$P(XMRG,U,2),DUNS=$P($P(XMRG,U,3),"|")
13 . ; -- Ensure Record Exists
14 . I '$D(^PRC(440,+IEN,0))#2 Q ;
15 . ; -- Get Current Value if any, either file or report
16 . S CURR=$P($G(^PRC(440,+IEN,7)),U,12) I CURR'=DUNS D Q ;
17 . . ;I $L(CURR) S ^TMP($J,+IEN)="Record: "_IEN_" Current: "_CURR_" D&B: "_DUNS_" *Data has been edited since Extract run."
18 . . ; -- Validate the Data using silent FM
19 . . K TMP D VAL^DIE(440,+IEN_",","18.3","",DUNS,.X)
20 . . I X["^" S ^TMP($J,+IEN)="Record: "_IEN_" D&B: "_DUNS_" *Failed Validation" Q
21 . . ; -- File it, FDA created in validation
22 . . S TMP(440,+IEN_",",18.3)=DUNS D FILE^DIE("","TMP")
23 . . I $D(DIERR)#2 S ^TMP($J,+IEN)="Record: "_IEN_" D&B: "_DUNS_" *Unable to File" Q
24 Q
25STAT ; -- Mail the Discrepency Report
26 I $O(^TMP($J,0))>0 D ;
27 . N XMSUB,XMTEXT,XMDUZ,XMY
28 . S ^TMP($J,.5)="The following DUNS# were not filed in the VENDOR file"
29 . S ^TMP($J,.6)="and will need to be entered manually."
30 . S ^TMP($J,.7)=" "
31 . S XMSUB="IFCAP Vendor DUNS Upload Discrepency Report"
32 . S XMTEXT="^TMP($J,",XMY("G.EDV")="",XMDUZ="PRCFVEX1" D ^XMD
33JOB ; -- Mail the Job Completion Message
34 ;N XMSUB,XMTEXT,XMDUZ,XMY K ^TMP($J)
35 ;S ^TMP($J,1)="The Dun & Bradstreet message: "
36 ;S ^TMP($J,2)="",^TMP($J,3)=" "_XQSUB,^TMP($J,4)=""
37 ;S ^TMP($J,5)="has been processed successfully."
38 ;S XMSUB="IFCAP VENDOR DUNS BULLETIN",XMTEXT="^TMP($J,",XMY("G.EDV")="",XMDUZ="SERVER: PRCFVEX" D ^XMD
39REM ; -- Remove the Msg from the Server Queue Basket
40 S XMSER="S."_XQSOP D REMSBMSG^XMA1C
41 Q
Note: See TracBrowser for help on using the repository browser.