- 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 Jan 18, 2025@03:05:44 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