source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPRTMT.m@ 775

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1SPNPRTMT ;HIRMFO/WAA- Master Search Program ; 8/20/96
2 ;;2.0;Spinal Cord Dysfunction;**3**;01/02/1997
3 ;;
4 ; This routine is the master search program
5 ; It Will call all the needed search routines as needed
6 ;EN1
7 ; This entry point is the main sort and selection entry point
8 ; The user will be asked to select a series of question then
9 ; be allowed to select other fields to search by.
10 ;
11 ;EN2(D0)
12 ; This entry point is the main filter routine. This program
13 ; will pass all the patient with in the data base through the
14 ; pre-select filter and only store those who mee all the critera
15 ; that was asked for.
16 ; Input:
17 ; D0 = Patient DFN
18 ; Output:
19 ; FLAG = 1/0
20 ; 1 patient meets the critera
21 ; 0 patient fails the critera
22 ;
23 ;DEVICE
24 ; This routine is a generic device selection dialog.
25 ; Input:
26 ; PROGRAM = The calling program
27 ; TITLE = The Title of the print
28 ; Output:
29 ; SPNIO = Q
30 ; If SPNIO is a Q then the user queued the print.
31 ;
32 ;CLOSE
33 ; This routine will set the current device to top of form and close.
34 ;
35 ;STPCK
36 ; This function is to see if the user terminated the print via
37 ; taskman.
38 ;
39EN1 ; Main Search Entry Point
40 S SPNFILTR=$G(SPNFILTR,1)
41 Q:'SPNFILTR
42 S (SPNMAST,SPNLEXIT)=0
43 I '$D(^TMP($J,"SPNPRT","AUP")) S SPNMAST=1 D G:SPNLEXIT EXIT
44 .D EN1^SPNPRTUP
45 .Q
46 D EXIT2
47 D EN1^SPNPRTAU G:SPNLEXIT EXIT
48 D EN1^SPNPRTSR G:SPNLEXIT EXIT
49 Q
50EN2(D0) ; Main filter routine
51 N ACTION,FLAG
52 S ACTION="",FLAG=1
53 F S ACTION=$O(^TMP($J,"SPNPRT",ACTION)) Q:ACTION="" D Q:'FLAG
54 . N SEQUENCE S SEQUENCE=0
55 . F S SEQUENCE=$O(^TMP($J,"SPNPRT",ACTION,SEQUENCE)) Q:SEQUENCE<1 D Q:'FLAG
56 .. N PASSFAIL
57 .. S PASSFAIL=$G(^TMP($J,"SPNPRT",ACTION,SEQUENCE,0))
58 .. Q:PASSFAIL=""
59 .. Q:$E(PASSFAIL,1,2)'="$$"
60 .. S PASSFAIL="S FLAG="_PASSFAIL
61 .. X PASSFAIL
62 .. Q
63 . Q
64 Q FLAG
65DEVICE(PROGRAM,TITLE,ZTSAVE) ; Select device
66 N %ZIS,IOP
67 S SPNIO=""
68 S %ZIS="QM",%ZIS("A")="Select DEVICE: "
69 D ^%ZIS
70 I POP D Q
71 .S SPNLEXIT=1
72 .W !,"Print ",TITLE," has been aborted."
73 .Q
74 I $D(IO("Q")) D
75 .N ZTRTN
76 .S ZTRTN=PROGRAM,ZTDESC=TITLE
77 .S ZTSAVE("^TMP($J,"""_"SPNPRT"_""",")=""
78 .D ^%ZTLOAD
79 .I $D(ZTSK)[0 D Q
80 ..W !,"Print ",TITLE," has been aborted."
81 ..S SPNLEXIT=1
82 ..Q
83 .W !,"Print ",TITLE," has been queued."
84 .W !,"The task number for the print job is ",ZTSK,"."
85 .S SPNIO="Q"
86 .Q
87 Q
88CLOSE ;Close current print device
89 I 'SPNLEXIT W @IOF
90 W ! D ^%ZISC
91 I $D(ZTQUEUED) S ZTREQ="@"
92 D EXIT K SPNMAST
93 Q
94STPCK() ; Taskman check
95 N ZTSTOP
96 S ZTSTOP=0
97 I $$S^%ZTLOAD D
98 .S ZTSTOP=1 K ZTREG W !?10,"*** OUTPUT STOPPED AT USER'S REQUEST ***"
99 .Q
100 Q ZTSTOP
101 ;
102EXIT ;KILL QUIT
103 I $G(SPNMAST) K ^TMP($J,"SPNPRT","AUP")
104EXIT2 K ^TMP($J,"SPNPRT","AUTO")
105 K ^TMP($J,"SPNPRT","POST")
106 Q
Note: See TracBrowser for help on using the repository browser.