| [613] | 1 | SPNPRTMT ;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 | ;
|
|---|
| 39 | EN1 ; 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
|
|---|
| 50 | EN2(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
|
|---|
| 65 | DEVICE(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
|
|---|
| 88 | CLOSE ;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
|
|---|
| 94 | STPCK() ; 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 | ;
|
|---|
| 102 | EXIT ;KILL QUIT
|
|---|
| 103 | I $G(SPNMAST) K ^TMP($J,"SPNPRT","AUP")
|
|---|
| 104 | EXIT2 K ^TMP($J,"SPNPRT","AUTO")
|
|---|
| 105 | K ^TMP($J,"SPNPRT","POST")
|
|---|
| 106 | Q
|
|---|
