| 1 | PRCFVEX ;WASH IRMFO/KCMO;Extract Data for DUNS Number; ;8/14/96  11:02 | 
|---|
| 2 | ;;5.0;IFCAP;**84,83**;4/21/95 | 
|---|
| 3 | ; | 
|---|
| 4 | STRT ; -- Loop through Vendors, skip * entries, Max 32k Messages | 
|---|
| 5 | N DEBUG,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,X,Y,N0,N7,STR,FACID,LEN,MSGNUM,I,ST,ET | 
|---|
| 6 | S DEBUG=1 ; Deugging Flag, 1 process | 
|---|
| 7 | D NOW^%DTC S Y=% D DD^%DT S ST=Y | 
|---|
| 8 | S FACID=$P($G(^XTV(8989.3,1,"XUS")),U,17) ;Default Institution KSP | 
|---|
| 9 | I '$D(^PRC(411,"B",FACID)) W !!,"THE 'DEFAULT INSTITUTION' IS NOT DEFINED IN THE KERNEL SITE PARAMETER FILE!",!!,"PLEASE EDIT THIS FIELD BEFORE CONTINUING." Q | 
|---|
| 10 | S (MSGNUM,LEN,I)=0 K ^TMP($J) | 
|---|
| 11 | S X="" F  S X=$O(^PRC(440,"B",X))  Q:X=""  D  ; | 
|---|
| 12 | . S Y=0 F  S Y=$O(^PRC(440,"B",X,Y)) Q:Y<1  I $D(^PRC(440,Y,0))#2 D  ; | 
|---|
| 13 | . . S N0=^(0),N7=$G(^(7)) Q:$E(N0)="*" | 
|---|
| 14 | . . ; -- Record String will be ^ delimited and layed out as follows: | 
|---|
| 15 | . . ; -- FACILITY ID^IFCAP RECNUM^DUNS NUMBER^VENDOR NAME^ \ | 
|---|
| 16 | . . ; -- VENDOR ADDRESS 1^VENDOR ADDRESS 2^VENDOR ADDRESS 3^ \ | 
|---|
| 17 | . . ; -- VENDOR ADDRESS 4^CITY^STATE^ZIP^CONTACT NAME^ \ | 
|---|
| 18 | . . ; -- VENDOR TELEPHONE NUMBER. | 
|---|
| 19 | . . S STR=FACID_U_Y_U_$P(N7,U,12)_U_$P(N0,U)_U_$P(N0,U,2)_U_$P(N0,U,3)_U_$P(N0,U,4)_U_$P(N0,U,5)_U_$P(N0,U,6)_U | 
|---|
| 20 | . . S STR=STR_$P($G(^DIC(5,+$P(N0,U,7),0)),U)_U_$P(N0,U,8)_U_$P(N0,U,9)_U_$P(N0,U,10)_"|" | 
|---|
| 21 | . . S I=I+1,^TMP($J,I,0)=STR,LEN=$L(STR)+LEN I LEN>31000 D MSG | 
|---|
| 22 | D MSG,SUMM W !!,"Extract Vendor DUNN's Completed!!" Q | 
|---|
| 23 | ; | 
|---|
| 24 | MSG ; -- Drop a Message | 
|---|
| 25 | N X,Y | 
|---|
| 26 | Q:'$D(^TMP($J,1,0))#2 | 
|---|
| 27 | S ^TMP($J,I+1,0)="|$" | 
|---|
| 28 | S MSGNUM=MSGNUM+1,XMSUB="Sta "_FACID_" Vendor Extract Part "_MSGNUM | 
|---|
| 29 | S XMCHAN="",XMTEXT="^TMP($J,",XMDUZ="VENDOR EXTRACT" | 
|---|
| 30 | I $G(DEBUG) W !,"Sending: ",XMSUB | 
|---|
| 31 | S XMY("XXX@Q-EDV.MED.VA.GOV")="" D ^XMD ;  Address and Send | 
|---|
| 32 | K ^TMP($J) S (LEN,I)=0 | 
|---|
| 33 | Q | 
|---|
| 34 | ; | 
|---|
| 35 | SUMM ; -- Summary Info | 
|---|
| 36 | D NOW^%DTC S Y=% D DD^%DT S ET=Y | 
|---|
| 37 | ; Record: FACID^SUM^#Msgs^StartTime^StopTime | 
|---|
| 38 | S X(1,0)=FACID_"^SUM^"_MSGNUM_U_ST_U_ET_"|$" | 
|---|
| 39 | ;S X(1,0)="Station: "_FACID | 
|---|
| 40 | ;S X(2,0)="Transmitted "_MSGNUM_" Messages" | 
|---|
| 41 | ;S X(3,0)="Start Time: "_ST | 
|---|
| 42 | ;S X(4,0)="Finish Time: "_ET | 
|---|
| 43 | S XMSUB="Sta "_FACID_" Vendor Extract Summary" | 
|---|
| 44 | S XMCHAN="",XMTEXT="X(",XMDUZ="VENDOR EXTRACT" | 
|---|
| 45 | S XMY("POSTMASTER@Q-EDV.MED.VA.GOV")="" D ^XMD ;  Address and Send | 
|---|
| 46 | Q | 
|---|
| 47 | ; | 
|---|