PRCFVEX1 ;WASH IRM/KCMO;SERVER to process returned DUNS numbers; ;8/26/96 11:33
;;5.0;IFCAP;**84**;4/21/95
;
Q:XQSUB'["EDV" ; Must be one of our Messages
N FACID,XMSER,XMZ,IEN,DUNS,CURR,I K ^TMP($J)
S FACID=$P($G(^XTV(8989.3,1,"XUS")),U,17) ;Default Institution KSP
S XMZ=XQMSG
;
REC ; -- Read the Msg lines, Parse and Process
X XMREC G STAT:XMER<0 D G REC
. Q:$P(XMRG,U)'[FACID ; -- Line must begin with Station Number
. S IEN=$P(XMRG,U,2),DUNS=$P($P(XMRG,U,3),"|")
. ; -- Ensure Record Exists
. I '$D(^PRC(440,+IEN,0))#2 Q ;
. ; -- Get Current Value if any, either file or report
. S CURR=$P($G(^PRC(440,+IEN,7)),U,12) I CURR'=DUNS D Q ;
. . ;I $L(CURR) S ^TMP($J,+IEN)="Record: "_IEN_" Current: "_CURR_" D&B: "_DUNS_" *Data has been edited since Extract run."
. . ; -- Validate the Data using silent FM
. . K TMP D VAL^DIE(440,+IEN_",","18.3","",DUNS,.X)
. . I X["^" S ^TMP($J,+IEN)="Record: "_IEN_" D&B: "_DUNS_" *Failed Validation" Q
. . ; -- File it, FDA created in validation
. . S TMP(440,+IEN_",",18.3)=DUNS D FILE^DIE("","TMP")
. . I $D(DIERR)#2 S ^TMP($J,+IEN)="Record: "_IEN_" D&B: "_DUNS_" *Unable to File" Q
Q
STAT ; -- Mail the Discrepency Report
I $O(^TMP($J,0))>0 D ;
. N XMSUB,XMTEXT,XMDUZ,XMY
. S ^TMP($J,.5)="The following DUNS# were not filed in the VENDOR file"
. S ^TMP($J,.6)="and will need to be entered manually."
. S ^TMP($J,.7)=" "
. S XMSUB="IFCAP Vendor DUNS Upload Discrepency Report"
. S XMTEXT="^TMP($J,",XMY("G.EDV")="",XMDUZ="PRCFVEX1" D ^XMD
JOB ; -- Mail the Job Completion Message
;N XMSUB,XMTEXT,XMDUZ,XMY K ^TMP($J)
;S ^TMP($J,1)="The Dun & Bradstreet message: "
;S ^TMP($J,2)="",^TMP($J,3)=" "_XQSUB,^TMP($J,4)=""
;S ^TMP($J,5)="has been processed successfully."
;S XMSUB="IFCAP VENDOR DUNS BULLETIN",XMTEXT="^TMP($J,",XMY("G.EDV")="",XMDUZ="SERVER: PRCFVEX" D ^XMD
REM ; -- Remove the Msg from the Server Queue Basket
S XMSER="S."_XQSOP D REMSBMSG^XMA1C
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFVEX1 1992 printed Dec 13, 2024@02:04:32 Page 2
PRCFVEX1 ;WASH IRM/KCMO;SERVER to process returned DUNS numbers; ;8/26/96 11:33
+1 ;;5.0;IFCAP;**84**;4/21/95
+2 ;
+3 ; Must be one of our Messages
if XQSUB'["EDV"
QUIT
+4 NEW FACID,XMSER,XMZ,IEN,DUNS,CURR,I
KILL ^TMP($JOB)
+5 ;Default Institution KSP
SET FACID=$PIECE($GET(^XTV(8989.3,1,"XUS")),U,17)
+6 SET XMZ=XQMSG
+7 ;
REC ; -- Read the Msg lines, Parse and Process
+1 XECUTE XMREC
if XMER<0
GOTO STAT
Begin DoDot:1
+2 ; -- Line must begin with Station Number
if $PIECE(XMRG,U)'[FACID
QUIT
+3 SET IEN=$PIECE(XMRG,U,2)
SET DUNS=$PIECE($PIECE(XMRG,U,3),"|")
+4 ; -- Ensure Record Exists
+5 ;
IF '$DATA(^PRC(440,+IEN,0))#2
QUIT
+6 ; -- Get Current Value if any, either file or report
+7 ;
SET CURR=$PIECE($GET(^PRC(440,+IEN,7)),U,12)
IF CURR'=DUNS
Begin DoDot:2
+8 ;I $L(CURR) S ^TMP($J,+IEN)="Record: "_IEN_" Current: "_CURR_" D&B: "_DUNS_" *Data has been edited since Extract run."
+9 ; -- Validate the Data using silent FM
+10 KILL TMP
DO VAL^DIE(440,+IEN_",","18.3","",DUNS,.X)
+11 IF X["^"
SET ^TMP($JOB,+IEN)="Record: "_IEN_" D&B: "_DUNS_" *Failed Validation"
QUIT
+12 ; -- File it, FDA created in validation
+13 SET TMP(440,+IEN_",",18.3)=DUNS
DO FILE^DIE("","TMP")
+14 IF $DATA(DIERR)#2
SET ^TMP($JOB,+IEN)="Record: "_IEN_" D&B: "_DUNS_" *Unable to File"
QUIT
End DoDot:2
QUIT
End DoDot:1
GOTO REC
+15 QUIT
STAT ; -- Mail the Discrepency Report
+1 ;
IF $ORDER(^TMP($JOB,0))>0
Begin DoDot:1
+2 NEW XMSUB,XMTEXT,XMDUZ,XMY
+3 SET ^TMP($JOB,.5)="The following DUNS# were not filed in the VENDOR file"
+4 SET ^TMP($JOB,.6)="and will need to be entered manually."
+5 SET ^TMP($JOB,.7)=" "
+6 SET XMSUB="IFCAP Vendor DUNS Upload Discrepency Report"
+7 SET XMTEXT="^TMP($J,"
SET XMY("G.EDV")=""
SET XMDUZ="PRCFVEX1"
DO ^XMD
End DoDot:1
JOB ; -- Mail the Job Completion Message
+1 ;N XMSUB,XMTEXT,XMDUZ,XMY K ^TMP($J)
+2 ;S ^TMP($J,1)="The Dun & Bradstreet message: "
+3 ;S ^TMP($J,2)="",^TMP($J,3)=" "_XQSUB,^TMP($J,4)=""
+4 ;S ^TMP($J,5)="has been processed successfully."
+5 ;S XMSUB="IFCAP VENDOR DUNS BULLETIN",XMTEXT="^TMP($J,",XMY("G.EDV")="",XMDUZ="SERVER: PRCFVEX" D ^XMD
REM ; -- Remove the Msg from the Server Queue Basket
+1 SET XMSER="S."_XQSOP
DO REMSBMSG^XMA1C
+2 QUIT
