source: FOIAVistA/tag/r/CMOP-PSX/PSXRECV.m@ 1569

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

initial load of FOIAVistA 6/30/08 version

File size: 4.6 KB
Line 
1PSXRECV ;BIR/WPB-Downloads Data from Mailman Msg to Files ;04/08/97 2:06 PM
2 ;;2.0;CMOP;**34,38,45**;11 Apr 97
3HDR S (PSXORDCT,PSXSMSG,PSXRTRN,PSXRXS)=0,ZTREQ="@"
4 K DD,DO,^TMP($J,"PSXREV") S PSXXMRG=XMRG
5 S PSXBAT=$P($G(XMRG),U,2),PSXSITE=$P($G(XMRG),U,3),PSXSYST=$P(XMRG,U,4),SDATE=$P($G(XMRG),U,6)
6 S SITEN=$P($G(XMRG),U,5)
7 S PSXREF=SITEN_"-"_PSXBAT,PSXSTART=$P(XMRG,U,8),PSXFROM=XMFROM
8 S PSXSENDR=$P(XMRG,U,7),PSXLAST=$P(XMRG,U,9),PSXDIV=$P(XMRG,U,10),XSITE=$P(XMRG,U,11),XMSER="S."_XQSOP,TXMZ=XQMSG
9 ;S X=SITEN,DIC="4",DIC(0)="MOXZ" S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S SITENUM=+Y K DIC,Y,X ;****DOD L1
10 S X=SITEN,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S SITENUM=$$IEN^XUMF(4,AGNCY,X) K DIC,Y,X,AGNCY ;****DOD L1
11 S OLDBAT=$P($G(XMRG),U,12) I OLDBAT'="" S PSXRTRN=1,PSXOLD=SITEN_"-"_OLDBAT
12 G:$G(SITENUM)="" EXIT1
13 S XXR=$O(^PSX(552,"B",$G(SITENUM),""))
14 G:'$D(^PSX(552,"C",$G(XXR))) EXIT1
15 S:$G(^XMB(3.9,TXMZ,0))["CMOP Controlled Substances Transmission" CSB=1
16 I $G(CSB)=1 N X S X=$$FMADD^XLFDT(DT,+3),^XTMP("PSXCS",PSXREF)=X_U_DT_U_"CS TRANSMISSION" K X
17 ;this would be a good place to send an alert or mail message if the
18 ;transmitting site was not active in the CMOP files
19 I $G(XMFROM)["@" S DOMAIN=$P($G(XMFROM),"@",2)
20 I $G(XMFROM)'["@" S DOMAIN=""
21 S DOMAIN=""
22 S SAME=$O(^PSX(552.1,"B",PSXREF,"")) S:$G(SAME)'="" PSXRTRN=2 D:$G(SAME)'="" CHKDUP^PSXRECV1 G:$G(FLAG5)>0 EXIT
23 I PSXRTRN=1 S RR=$O(^PSX(552.1,"B",PSXOLD,"")) D
24 .Q:$G(RR)'>0
25 .S OLDSDT=$P(^PSX(552.1,RR,0),U,4)
26 .S CHK=$P($G(^PSX(552.1,RR,0)),U,2) D
27 .S:$G(CHK)=3 PSXFLG1=2
28 .I (CHK=2)!(CHK=1) S PSXJOB=""
29 .;I CHK="" S PSXJOB=2,PSXERR=2_"^"_2 D ^PSXERR Q
30 .;I (CHK=3)!(CHK=4) S PSXJOB=2,PSXERR=2_"^"_CHK D ^PSXERR Q
31 .;I CHK=5 S PSXJOB=2,PSXERR=2_"^"_CHK
32STRT I PSXRTRN=1,($G(RR)'=""),($P(^PSX(552.1,$G(RR),0),"^",2)=2) L +^PSX(552.1,$G(RR)):600 G:'$T EXIT S $P(^PSX(552.1,RR,0),"^",2)=5 S DA=RR,DIK="^PSX(552.1," D IX^DIK K DA,DIK L -^PSX(552.1,$G(RR))
33 S:$D(^PSX(552.1,"ART",$G(PSXREF))) PSXRTRN=3
34 S X=PSXREF,DIC="^PSX(552.1,",DIC(0)="Z"
35 S DIC("DR")="1////"_$S(PSXRTRN<1:"1",PSXRTRN>0:"5",1:"")_";2////"_PSXDIV_";3////"_XSITE_";4////"_PSXSENDR_";5////"_SDATE_";8////"_PSXSTART_";9////"_PSXLAST_$S(PSXRTRN=1:";13////"_PSXOLD_";12////1",1:"")_";21////"_$G(CSB)
36 D F K DIC,X,DA,CSB S (OLDDA,PSXDA)=+Y
37 I '$D(^PSX(552.4,"B",PSXDA)) K DD,DO S X=PSXDA,DIC(0)="Z",DIC="^PSX(552.4," D F S DA515=+Y
38 F X XMREC G:$G(XMER)<0 EX^PSXSERV D:$E(XMRG,1,6)["NTE|1|" SITE Q:$E(XMRG,1,5)["$$END" G:$E(XMRG,1,4)["$MSG" MSG
39 K XMER,XMREC,XMRG
40 G EXIT
41 Q
42F D FILE^DICN Q
43SITE S ^PSX(552.1,PSXDA,"S",0)="^552.114A^^"
44 K DO,DD
45 L +^PSX(552.1,PSXDA,"S"):600 G:'$T EXIT
46 S X=XMRG,DA(1)=PSXDA,DIC="^PSX(552.1,"_PSXDA_",""S"",",DIC(0)="Z" D F
47 F X XMREC G:$E(XMRG,1,4)["$MSG" MSG G:$E(XMRG,1,9)["$$END" EXIT S X=XMRG,DA(1)=PSXDA,DIC="^PSX(552.1,"_PSXDA_",""S"",",DIC(0)="Z" D F K DA,DIC,X
48 L -^PSX(552.1,PSXDA,"S")
49 Q
50MSG S PSXORDCT=PSXORDCT+1
51 K DD,DO,PSXMSG,LNCNT,PSXDA
52 S I=1,PSXMSG=$P(XMRG,U,2),(X,PSXID)=PSXREF_"-"_PSXMSG S:PSXSMSG=0 PSXSMSG=PSXMSG S DIC="^PSX(552.2,",DIC(0)="Z",DIC("DR")="1////4;2////"_$H D F S PSXDA=+Y
53 S ^PSX(552.2,PSXDA,"T",0)="^552.27A^^"
54 F X XMREC G:$E(XMRG,1,4)["$MSG" QUE S:$E(XMRG,1,4)["MSH|" $P(XMRG,"|",10)=PSXID S:$E(XMRG,1,7)["ORC|NW" PSXRXS=PSXRXS+1 D:$E(XMRG,1,4)["RX1|" RX1 D:$E(XMRG,1,4)["ZX1|" ZX1 D:$E(XMRG,1,4)["PID|" PID G:$E(XMRG,1,9)["$$END" QUE D
55 .L +^PSX(552.2,PSXDA):30 S ^PSX(552.2,PSXDA,"T",I,0)=$G(XMRG) L -^PSX(552.2,PSXDA) S $P(^PSX(552.2,PSXDA,"T",0),U,3)=I,$P(^(0),U,4)=I,I=I+1 I $E(XMRG,1,4)["ZX1|" S DA(1)=PSXDA,(SUBDA,DA)=I-1,DIK="^PSX(552.2,"_PSXDA_",""T""," D IX^DIK K DA,DIK
56 Q
57PID I $E(XMRG,1,4)["PID|" S NAME=$P(XMRG,"|",6),NAME=$TR(NAME,"^",",") Q
58RX1 I $E(XMRG,1,4)["RX1|" S RXNDX=$P(XMRG,"|",2),DRG515=$P($P(XMRG,"|",15),"^",1),QTY515=$P(XMRG,"|",13),PSXDRG=$P(XMRG,U,2)
59 S FL515=(+$P($P(XMRG,"|",2),"-",3)-1)
60 Q
61ZX1 I $E(XMRG,1,4)["ZX1|" S RX515=$P(XMRG,"|",2),PSXCS=$P($G(XMRG),"|",15) D F515^PSXRECV1
62 Q
63QUE L +^PSX(552.2,PSXDA):600 G:'$T EXIT
64 S DA=PSXDA,DIE="^PSX(552.2,",DR="1////1;2////"_$H D ^DIE K DA,DIE,DR
65 L -^PSX(552.2,PSXDA)
66 I $E(XMRG,1,9)["$$END" G UPDATE^PSXRECV1
67 G MSG
68 ;
69EXIT S XMZ=TXMZ,XMSER="S.PSXX CMOP SERVER" D REMSBMSG^XMA1C
70EXIT1 I $G(OLDDA)'="" S DA=OLDDA,DIK="^PSX(552.1," D IX^DIK K DA,DIK
71 I $G(SAME)'="" S DA=SAME,DIK="^PSX(552.1," D IX^DIK K DA,DIK
72 K PSXSTART,PSXEND,PSXRXCT,PSXMSGCT,PSXSMSG,PSXLAST,PSXRXS,PSXORDCT,PSXSITE,PSXTDT,PSXFTDT,%,DOMAIN,PSXFLAG,I,OLDDA,PSXID,PSXSENDR,PSXREF,PSXMSG,PSXBAT,SDATE,SDT,SUBDA,PSXSYST,X,Y,XMFROM,SITENUM
73 K XMSER,XQMSG,XQSOP,OLDBAT,XMZ,PSXDIV,XSITE,CHK,REC,RR,RRR,SITEN,PSXJOB,PSXERR,PSXFROM,PSXOLD,PSXRTRN,XXR,DA515,DRG515,FL515,QTY515,RX515,SAME,OLDSDT,OLDTM,PSXDRG,NAME,NAME1,FLAG5,PSXXMGR
74 K NM5521,RXNDX
75 Q
Note: See TracBrowser for help on using the repository browser.