| 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
 | 
|---|