| 1 | ORSNAST ;SLC/RAF - Policy order search  ;06/25/2007
 | 
|---|
| 2 |  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**50,263**;Dec 17, 1997;Build 9
 | 
|---|
| 3 |  ;;Per VHA Directive 2004-038, this routine should not be modified.
 | 
|---|
| 4 |  ;
 | 
|---|
| 5 |  ;this utility will allow the user to enter a date range to search
 | 
|---|
| 6 |  ;the orders file, 100, looking for orders with a specific nature
 | 
|---|
| 7 |  ;of order or status
 | 
|---|
| 8 |  ;
 | 
|---|
| 9 |  ;
 | 
|---|
| 10 | EN ;
 | 
|---|
| 11 |  S U="^" K ^TMP("ORNS",$J),^TMP("ORSERV",$J)
 | 
|---|
| 12 |  W @IOF,!!?18,"Nature of Order or Order Status Search.",!?15,"This report is formatted for 132 column output."
 | 
|---|
| 13 |  N DASH,DATE,DFN,DIR,DTOUT,DUOUT,EDATE,FORMAT,HDR,HDR1,IEN
 | 
|---|
| 14 |  N LOC,LONER,ORIGVIEW,PAGE,PNM,PROV,QUIT,REF,RPDT,SDATE,SER,SERVICE,STOP,TEXT,TEXTSUB
 | 
|---|
| 15 |  N SINGLE,SIGNED,SNAME,SSN,STATUS,SORT,SEARCH,SUB
 | 
|---|
| 16 |  N VA,VADM,WHEN,WHO,Y
 | 
|---|
| 17 | SORT S DIR(0)="SX^1:Nature of order;2:Order Status"
 | 
|---|
| 18 |  S DIR("A")="Enter the search criteria"
 | 
|---|
| 19 |  S DIR("?")="Enter a 1 to search orders by the Nature of order or a 2 to search orders by the Order Status. Enter an ^ to exit the option."
 | 
|---|
| 20 |  D ^DIR S:+Y>0 SORT=+Y K DIR I $D(DTOUT)!($D(DUOUT)) G EXIT
 | 
|---|
| 21 |  S DIR(0)=$S(SORT=1:"PA^100.02:AEMQ",SORT=2:"PA^100.01:AEMQ")
 | 
|---|
| 22 |  S DIR("A")="Select "_$S(SORT=1:"Nature of order: ",1:"Order Status: ")
 | 
|---|
| 23 |  D ^DIR S:+Y>0 SEARCH=+Y,SNAME=$P(Y,U,2) K DIR I $D(DTOUT)!($D(DUOUT)) G EXIT
 | 
|---|
| 24 |  D SDATE I $D(DTOUT)!$D(DUOUT) G EXIT
 | 
|---|
| 25 |  D EDATE I $D(DTOUT)!$D(DUOUT) G EXIT
 | 
|---|
| 26 |  D CKDATE I $D(DTOUT)!$D(DUOUT) G EXIT
 | 
|---|
| 27 | FORMAT ;allows choice of formats for evaluation purpose
 | 
|---|
| 28 |  S DIR(0)="SX^1:Detailed format;2:Columnar format"
 | 
|---|
| 29 |  S DIR("A")="Select output format"
 | 
|---|
| 30 |  S DIR("?")="Enter a 1 for a Detailed format and a 2 for a Columnar format. Enter an ^ to exit the option."
 | 
|---|
| 31 |  D ^DIR S:+Y>0 FORMAT=+Y K DIR I $D(DTOUT)!$D(DUOUT) G EXIT
 | 
|---|
| 32 | SERV ;sets the variable SERVICE equal to 1 if the user wants to sort by
 | 
|---|
| 33 |  ;service, or sets it to 0 if not
 | 
|---|
| 34 |  I FORMAT=2 D  I $D(DTOUT)!($D(DUOUT)) G EXIT
 | 
|---|
| 35 |  .S DIR(0)="Y"
 | 
|---|
| 36 |  .S DIR("A")="Would you like to sort the output by service"
 | 
|---|
| 37 |  .S DIR("?")="If you answer yes, the output will be sorted by service. Enter an ^ to exit the option."
 | 
|---|
| 38 |  .S DIR("B")="NO"
 | 
|---|
| 39 |  .D ^DIR S SERVICE=+Y K DIR
 | 
|---|
| 40 | SINGLE ;sets variable SINGLE to set up a search of a single service
 | 
|---|
| 41 |  I FORMAT=2&($G(SERVICE)) D  I $D(DTOUT)!($D(DUOUT)) G EXIT
 | 
|---|
| 42 |  .S DIR(0)="Y",DIR("B")="NO"
 | 
|---|
| 43 |  .S DIR("A")="Would you like to search for specific SERVICE/SECTIONS"
 | 
|---|
| 44 |  .S DIR("?")="Enter a YES to search by a single SERVICE/SECTION. You may either press enter without selecting a SERVICE/SECTION or enter an ^ to exit the option,"
 | 
|---|
| 45 |  .D ^DIR S:+Y>0 SINGLE=+Y K DIR
 | 
|---|
| 46 | LONER ;sets DIR call to allow the user to select a single service/section
 | 
|---|
| 47 |  I FORMAT=2&($G(SERVICE))&($G(SINGLE)) D  I $D(QUIT)!('$D(LONER)) G EXIT
 | 
|---|
| 48 |  .F  D  I $D(QUIT)!(Y=-1) Q
 | 
|---|
| 49 |  ..S DIR(0)="PAO^49:AEQM"
 | 
|---|
| 50 |  ..S DIR("A")="Select Service/Section: "
 | 
|---|
| 51 |  ..D ^DIR S:+Y>0 LONER($P(Y,U,2))=+Y K DIR I $D(DTOUT)!($D(DUOUT)) S QUIT=1
 | 
|---|
| 52 | TASK ;
 | 
|---|
| 53 |  S %ZIS="Q" D ^%ZIS I POP Q
 | 
|---|
| 54 |  I $D(IO("Q")) D  K IO("Q") Q
 | 
|---|
| 55 |  .S ZTIO=ION,ZTDESC="File 100 order status search"
 | 
|---|
| 56 |  .S ZTRTN="EN^ORSNAST1",ZTSAVE("SORT")="",ZTSAVE("FORMAT")=""
 | 
|---|
| 57 |  .S ZTSAVE("SDATE")="",ZTSAVE("EDATE")="",ZTSAVE("SEARCH")=""
 | 
|---|
| 58 |  .S ZTSAVE("SNAME")="",ZTSAVE("SERVICE")="",ZTSAVE("SD1")=""
 | 
|---|
| 59 |  .S ZTSAVE("ED1")="",ZTSAVE("LONER*")="",ZTSAVE("SINGLE")=""
 | 
|---|
| 60 |  .D ^%ZTLOAD I $D(ZTSK) W !,?32,"REQUEST QUEUED"
 | 
|---|
| 61 |  U IO D EN^ORSNAST1
 | 
|---|
| 62 |  G EXIT
 | 
|---|
| 63 |  ;
 | 
|---|
| 64 | SDATE ;sets DIR call to ask the user for a starting date
 | 
|---|
| 65 |  S DIR(0)="DA^::ETX"
 | 
|---|
| 66 |  S DIR("A")="Enter a starting date: "
 | 
|---|
| 67 |  S DIR("?")="Enter the date that you wish to start searching with. This date needs to be older than the ending date. For example: If you enter a start date of T-3, the Stop date should be T-2 or less. Enter an ^ to exit the option."
 | 
|---|
| 68 |  D ^DIR S:+Y>0 SDATE=+Y K DIR I $D(DTOUT)!($D(DUOUT)) Q
 | 
|---|
| 69 |  I SDATE'["." S SDATE=SDATE_.0001
 | 
|---|
| 70 |  Q
 | 
|---|
| 71 | EDATE ;sets DIR call to ask the user for an ending date (optional)
 | 
|---|
| 72 |  S DIR(0)="DA^::ETX"
 | 
|---|
| 73 |  S DIR("A")="Enter a ending date: "
 | 
|---|
| 74 |  S DIR("?")="Enter the date that you would like the search to end with. This date needs to be more recent than the start date. For example: If you entered a T-3 for the start date, enter a T-2 or less here. Enter an ^ to exit the option."
 | 
|---|
| 75 |  D ^DIR S:+Y>0 EDATE=+Y K DIR I $D(DTOUT)!($D(DUOUT)) Q
 | 
|---|
| 76 |  I EDATE'["." S EDATE=EDATE_.2359
 | 
|---|
| 77 |  Q
 | 
|---|
| 78 | CKDATE ; Make sure the end date is not older than the start date.
 | 
|---|
| 79 |  I EDATE>SDATE Q
 | 
|---|
| 80 |  W !!,?10,"The starting date must be older than the ending date.",!,?10,"Please re-enter start and end dates.",!!
 | 
|---|
| 81 |  D SDATE I $D(DTOUT)!$D(DUOUT) Q
 | 
|---|
| 82 |  D EDATE I $D(DTOUT)!$D(DUOUT) Q
 | 
|---|
| 83 |  G CKDATE
 | 
|---|
| 84 | EXIT ;
 | 
|---|
| 85 |  K ^TMP("ORNS",$J),^TMP("ORSERV",$J)
 | 
|---|
| 86 |  D ^%ZISC
 | 
|---|
| 87 |  Q
 | 
|---|