source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LREPISV1.m@ 1604

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1LREPISV1 ;DALOI/CKA LAB EPI EXTRACT SERVER ; 4/1/2003
2 ;;5.2;LAB SERVICE;**281**;Sep 27, 1994
3 ;
4 ; Reference to $$SITE^VASITE supported by IA #10112
5 ; Reference to ^%ZOSF supported by IA #10096
6START ;
7 K ^TMP($J,"LREPDATA")
8 ;Send message to the mail group each time the server is triggered
9 ;containing the name of the person who triggered the server, their
10 ;location, and the action initiated.
11 S LREPST=$P($$SITE^VASITE,"^",2),LRRTYPE=1
12 ;Determine station number
13 S X=XQSUB X ^%ZOSF("UPPERCASE") S LREPSUB=Y
14 S ^TMP($J,"LREPDATA",1)=LREPSUB_" triggered at "_LREPST_" by "_XMFROM_" on "_XQDATE
15 ;The first line of the message tells who requested the action and when
16 S ^TMP($J,"LREPDATA",2)=$S(LREPSUB["RETRANSMIT":" RETRANSMISSION of EPI data",1:"????")_" at "_LREPST
17 ;The second line tells when the server is activated and no data can be gathered from the MailMan message.
18 S LREPLNT=1
19 I LREPSUB'["RETRANSMIT" S ^TMP($J,"LREPDATA",3)="SUBJECT OF MAIL MESSAGE MUST BE RETRANSMIT" G EXIT
20RETRANS ;RETRANSMIT
21 ;first read the text of the message
22 S LRERROR=0
23READ F XMA=1:1 X XMREC Q:XMER<0 S XMTEXT=XMRG D
24 .;
25PROCESS .;
26 .I XMA=1,XMTEXT'="******password******" S ^TMP($J,"LREPDATA",3)="INVALID PASSWORD" S LRERROR=1 Q
27 .;
28 .S LRPROT=1696
29DATE .;
30 .I XMA=3 D
31 ..S X=XMTEXT,%DT="X" D ^%DT
32 ..I Y=-1 S ^TMP($J,"LREPDATA",3)="INVALID STOP DATE" S LRERROR=1 Q
33 ..S LRRPE=Y ;Stop date
34 .I XMA=2 D
35 ..S X=XMTEXT,%DT="X" D ^%DT
36 ..I Y=-1 S ^TMP($J,"LREPDATA",3)="INVALID START DATE" S LRERROR=1 Q
37 ..S LRRPS=Y ;Start date
38 .;
39TEST .;pathogens
40 .F LRI=4:1 Q:LRI'=XMA D:XMTEXT="ALL" Q:XMTEXT="ALL" S LREPI(LRI)=XMTEXT Q:'$D(XMTEXT) S LREPI(XMTEXT)=""
41 ..S LRI=0 F S LRI=$O(^LAB(69.5,LRI)) Q:'LRI!(LRI>99) S LREPI(LRI)=""
42 .;
43 .;
44 I LRERROR G MAIL
45TASK ;
46 D NOW^%DTC
47 S ZTDTH=%
48 Q:'$D(LREPI)
49 K ZTSAVE
50 S ZTSAVE("LR*")=""
51 S ZTIO="",ZTRTN="EN^LREPI",ZTDESC="Laboratory Search/Extract"
52 D ^%ZTLOAD
53 I $D(ZTSK)[0 W !!?5,"Report canceled!"
54 ;
55 ;
56MAIL ;
57 ;
58 ;If the subject contains "RETRANSMIT" DATA EXTRACTION
59EXIT ;If all went well, report that too.
60 S %H=$H D YMD^%DTC S XMDUN="EPI SYSTEM",XMDUZ=".5",XMSUB=LREPST_" EPI ("_X_%_")",XMTEXT="^TMP($J,""LREPDATA"","
61 S XMY("G.EPI-SITE@CINCINNATI.VA.GOV")=""
62 ;S XMY("ANZALDUA,CAROL@VAHVSS.FO-ALBANY.MED.VA.GOV")="" ;,XMY("CAROL.ANZALDUA@MED.VA.GOV")=""
63 D ^XMD
64 ;Mail the errors and successes back to the EPI group at Cincinnati.
65 K ^TMP($J,"LREPDATA")
66 K %,%DT,%H,D,DIC,X,XMDUN,XMDUZ,XMER,XMFROM,XMREC,XMRG,XMSUB,XMTEXT,XMY,XMZ,XQDATE,XQSUB,Y,LREPA,LREPB,LREPDA,LREPDA1,LREPDATA,LREPDFN,LREPDM,LREPDOC
67 K LREPDOM,LREPDTA,LREPED,LREPER,LREPLNT,LREPNM,LREPPT,LREPSD1,LREPSDT,LREPSSN,LREPST,LREPSUB,LREPTC,YSPR,LREPWB,LREPX,ZTQUEUED,ZTSK
68 K XMA,LRA,LRCOND,LRDATA,LRFILL,LRI,LRPATH,LRTEST,LRERROR
69 Q
70 ;
Note: See TracBrowser for help on using the repository browser.