source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNSERV.m@ 1697

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

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1SPNSERV ;SAN/WDE-Master server rtn for the spn* data;5/28/98
2 ;;2.0;Spinal Cord Dysfunction;**6,8**;01/02/97
3 ;
4 ;
5 ; This rtn is called from the option file.
6 ; The option is SPNSERVER it's type is a server.
7 ; Lines in the message with text
8 ; PERFORM TAG^ROUTINE will be save for processing.
9 ; needed variables can be included on the line.
10UNPK ;
11 ;From the server sftw
12 ; XMER=0 for a good read
13 ; -1 end of message
14 ; XMREC is an executed var that reads the message
15 ; XMGR is the line of text that is being readd
16 ;Built here
17 ; SPNDATA(ARRAY will contain the programs to run
18 ; The text in the message MUST contain
19 ; PERFORM TAG^ROUTINE;DESCRIPTION;TIME TO RUN;
20 ; the 4rd piece if present it will be SPNSDATE ie 2980101.001
21 ; the 5th piece if present it will be the SPNEDATE ie 2980101.2359
22 ; piece 6-10 will be parms spnparm(5...10) for open use
23 ;
24 ;hold xmz in spnxmz so we can delete it when all done with the message
25 S SPNXMZ=XMZ
26 ; read the message and test for programs save em if there
27 ;
28 F SPN=1:1 X XMREC Q:(XMER=-1) D
29 .I $P(XMRG,";",1)["^" I $P(XMRG,";",1)["PERFORM " I $P(XMRG,";",1)["^" S SPNDATA(SPN)=XMRG
30 ;
31 ;
32 ; read the spn array and task off the routines and send notices
33 ;
34 I $D(SPNDATA) S SPN=0 F A=1:1 S SPN=$O(SPNDATA(SPN)) Q:SPN="" S XMRG=$G(SPNDATA(SPN)) I $L(XMRG) D TASK
35EXIT ;
36 I $G(SPNXMZ) S XMZ=SPNXMZ S XMSER="SPNSERVER" D REMSBMSG^XMA1C
37 K SPNXMZ,XMSER,SPNPARM,SPNERR,X,A,SPNCNT,SPNDATA,SPNTXT,SPNDESC,SPNGRP
38 K SPNSUB,ZTSAVE,ZTSK,ZTDESC,ZTIO,XMY
39 Q
40 ;---------------------------------------------------------------------
41TASK ;
42 ; spnerr 0 is good 1 is an error
43 ; spnparm is an array that contains the data for the
44 ; program that is going to be ran.
45 ; spnparm(DESCRIPTION) is the task description and message title
46 ; spnparm(ENDATE) is a place holder for report end date
47 ; spnparm(REQUEST STRING) = the xmrg value from the server sftw
48 ; spnparm(RUN ROUTINE) = the routine to run
49 ; spnparm(SITE) = the host site
50 ; spnparm(STARTDATE) = is a place holder for report start dates
51 ; spnparm(TASKTIME) = time that the job will be ran
52 ; spnparm(SPNPAR /6-10/) can be used to pass other varibles needed
53 ; spntxt is the message required in ^spnmail
54 ;
55 ;
56 ; Loop through the XMRG variable and set up the spnparm array
57 ;
58 S SPNCNT=1 F X="RUN ROUTINE","DESCRIPTION","TASKTIME","STARTDATE","ENDATE","SPNPAR6","SPNPAR7","SPNPAR8","SPNPAR9","SPNPAR10" S SPNPARM(X)=$P(XMRG,";",SPNCNT) S SPNCNT=SPNCNT+1
59 S SPNPARM("SITE")=$G(^DD("SITE"))_"("_$G(^DD("SITE",1))_")"
60 S SPNPARM("REQUEST STRING")=$G(XMRG)
61 S SPNPARM("RUN ROUTINE")=$P(SPNPARM("RUN ROUTINE"),"PERFORM ",2)
62 ;
63 ; Test the parms and if error send message and clean up and quit
64 ;
65 D TEST I SPNERR=1 D CLEAN Q
66 ;
67 ;
68 ; The data ran through the screen without error & will be tasked off.
69 ;
70 S ZTDTH=$G(SPNPARM("TASKTIME")) S Y=ZTDTH X ^DD("DD") S $P(SPNPARM("TASKTIME"),U,2)=Y K Y
71 S SPNERR=0
72 S ZTRTN=$G(SPNPARM("RUN ROUTINE"))
73 S ZTDESC=$G(SPNPARM("DESCRIPTION"))
74 S ZTDTH=$P(SPNPARM("TASKTIME"),U,1)
75 S ZTSAVE("SPNPARM(")=""
76 S ZTIO=""
77 D ^%ZTLOAD
78 ;
79 ; test for task number if zip, send error message to group and quit
80 ;
81 I $D(ZTSK)=0 S ZTSK="No task number." D SENDERR D CLEAN Q
82 ;
83 ;; at this point the task was set and we want to know it
84 ;
85 S SPNTXT(1)=$G(SPNPARM("DESCRIPTION"))
86 S SPNTXT(2)="Has been task to run at "_^DD("SITE")_"."
87 S SPNTXT(3)="Routine : "_$G(SPNPARM("RUN ROUTINE"))
88 S SPNTXT(4)="Time set to run: "_$P(SPNPARM("TASKTIME"),U,2)
89 S SPNTXT(5)="If you are not happy with the run time you"
90 S SPNTXT(6)="can reschedule it for another time."
91 S SPNTXT(7)="The task number is "_ZTSK
92 S XMY("G.SPNL SCD REGISTRY@SAN-DIEGO.VA.GOV")=""
93 S XMY("G.SPNL SCD COORDINATOR")=""
94 S SPNDESC=$G(SPNPARM("DESCRIPTION"))
95 D ^SPNMAIL
96CLEAN ;
97 K SPNERR,SPNSUB,SPNDESC,SPNTXT,SPNPARM,SPNRTN,SPNTXT,SPNGRP
98 Q
99TEST ;--------------------------------------------------------------------
100 ; test the spnparm array for any missing elements
101 ; if ztrtn,ztdesc,tasktime are missing send us a
102 ; notice and go to next request.
103 ; If the routine is not on the disk send error message.
104 S SPNERR=0
105 I $G(SPNPARM("RUN ROUTINE"))="" S SPNERR=1
106 S X=$G(SPNPARM("RUN ROUTINE")) S X=$P(X,"^",2) X ^%ZOSF("TEST") I $T=0 S SPNERR=1 S SPNTXT(5)="Routine not found on disk.."
107 I $G(SPNPARM("DESCRIPTION"))="" S SPNERR=1
108 I $G(SPNPARM("TASKTIME"))="" S SPNERR=1 S SPNTXT(5)="No task time"
109 I SPNERR=0 Q
110 ;
111SENDERR ; this tag is called if the requested didn't get task.
112 ;
113 S SPNTXT(1)="The data extract at "_^DD("SITE")_" didn't arrive correct."
114 S SPNTXT(2)="Resubmit it with the correct sting."
115 S SPNTXT(3)="XMRG value was"
116 S SPNTXT(4)=$G(SPNPARM("REQUEST STRING"))
117 S SPNGRP="G.SPNL SCD REGISTRY@SAN-DIEGO.VA.GOV"
118 S SPNDESC=$G(SPNPARM("DESCRIPTION"))
119 D ^SPNMAIL
120 Q
Note: See TracBrowser for help on using the repository browser.