Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: CIAUDAT

CIAUDAT.m

Go to the documentation of this file. 
  1. CIAUDAT ;MSC/IND/DKM - Date range input;14-Aug-2006 09:35;DKM
  1.  ;;1.2;CIA UTILITIES;;Mar 20, 2007
  1.  ;;Copyright 2000-2006, Medsphere Systems Corporation
  1.  ;=================================================================
  1.  ; Prompt for date range (normal format)
  1. NORMAL D D1("P1"),D2("P2"):CIADAT1
  1.  Q
  1.  ; Prompt for date range (inverse format)
  1. INVRSE D D1("PI1"),D2("PI2"):CIADAT1
  1.  Q
  1.  ; Prompt for starting date
  1. D1(CIAOPT) ;
  1.  S CIADAT1=$$ENTRY("Start date: ",.CIAOPT,"",0,$Y)
  1.  Q
  1.  ; Prompt for ending date
  1. D2(CIAOPT) ;
  1.  S CIADAT2=$$ENTRY("End date  : ",.CIAOPT,"",0,$Y+1)
  1.  Q
  1.  ; Prompt for a date
  1. ENTRY(%CIAP,%CIAOPT,%CIADAT,%CIAX,%CIAY,%CIATRP,%CIAHLP) ;
  1.  N %CIAD,%CIAI,%CIADT,%CIAZ,%CIADISV
  1.  S %CIAX=$G(%CIAX,$X),%CIAY=$G(%CIAY,$Y),DUZ=+$G(DUZ),DTIME=$G(DTIME,99999999),%CIAOPT=$$UP^XLFSTR($G(%CIAOPT)),%CIADISV=""
  1.  S %CIATRP=$G(%CIATRP),%CIADAT=$G(%CIADAT)
  1.  S:$G(%CIAHLP)="" %CIAHLP="HELP^CIAUDAT"
  1.  S:$G(%CIAP)="" %CIAP="Enter date: "
  1.  F %CIAZ=0:1:9 I %CIAOPT[%CIAZ S %CIADISV="CIADAT"_%CIAZ Q
  1. DAT1 S %CIADT="",@$$TRAP^CIAUOS("DAT1^CIAUDAT")
  1.  F %CIAZ="P","T","F","X" S:%CIAOPT[%CIAZ %CIADT=%CIADT_%CIAZ
  1.  F  D  Q:$D(%CIAI)
  1.  .W $$XY^CIAU(%CIAX,%CIAY)_%CIAP,*27,"[J"
  1.  .S $X=%CIAX+$L(%CIAP)
  1.  .I %CIAOPT["E" S %CIAI=$$ENTRY^CIAUEDT(%CIADAT,79-$X,$X,$Y,"","R")
  1.  .E  I %CIADAT'="" S %CIAI=%CIADAT,%CIADAT=""
  1.  .E  R %CIAI:DTIME
  1.  .I $E(%CIAI)="?" D  Q
  1.  ..W !
  1.  ..I %CIAI["??" D HELP
  1.  ..E  D @%CIAHLP
  1.  ..D PAUSE()
  1.  ..K %CIAI
  1.  .I %CIAI=" " S %CIAI=$S(%CIADISV="":"",1:$G(^DISV(DUZ,%CIADISV))) K:%CIAI="" CIAZ1
  1.  .W $$XY^CIAU(%CIAX+$L(%CIAP),%CIAY),*27,"[K"
  1.  I %CIAI="",%CIATRP'="" S %CIAI=$G(@%CIATRP@(" "))
  1.  S %CIAI=$$UP^XLFSTR(%CIAI),%CIAD=""
  1.  Q:"^^"[%CIAI -$L(%CIAI)
  1.  I %CIATRP'="" D  I %CIAD'="" S %CIAOPT=$TR(%CIAOPT,"I") G DAT2
  1.  .I $D(@%CIATRP@(%CIAI)) S %CIAD=@%CIATRP@(%CIAI)
  1.  .E  D
  1.  ..N X
  1.  ..S X=%CIAI,%CIAZ=""
  1.  ..F  S %CIAZ=$O(@%CIATRP@("?",%CIAZ)) Q:%CIAZ=""  I %CIAI?@%CIAZ D  Q
  1.  ...S %CIAD=$$MSG^CIAU($G(@%CIATRP@("?",%CIAZ)))
  1.  S %CIAI=$$DT^CIAU(%CIAI,%CIADT)
  1.  G:%CIAI=-1 DAT1
  1.  I %CIAOPT["+",%CIAI<$S(%CIAI=%CIAI\1:$$DT^XLFDT,1:$$NOW^XLFDT) D  G DAT1
  1.  .D PAUSE("Must be on or after current date.")
  1.  I %CIAOPT["-",%CIAI>$S(%CIAI=%CIAI\1:$$DT^XLFDT,1:$$NOW^XLFDT) D  G DAT1
  1.  .D PAUSE("Must be on or before current date.")
  1.  S %CIAD=$$ENTRY^CIAUDT(%CIAI)
  1. DAT2 W %CIAD
  1.  S:%CIADISV'="" ^DISV(DUZ,%CIADISV)=%CIAI
  1.  Q $S(%CIAOPT["I":9999999-%CIAI,1:%CIAI)
  1. HELP W ?2,"Enter a valid ",$S(%CIAOPT["+":"future ",%CIAOPT["-":"past ",1:""),"date using one of the following formats:",!!
  1.  W ?5,"Format",?20,"Example",?35,"Explanation",?60,"Comments",!
  1.  W ?5,"------",?20,"-------",?35,"-----------",?60,"--------",!
  1.  W ?5,"mm/dd/yy",?20,"6/20/93",?35,"June 20, 1993",?60,"If you omit the",!
  1.  W ?5,"dd-mmm-yy",?20,"27-JUL-58",?35,"July 27, 1958",?60,"year, the "_$S(%CIAOPT["P":"most",%CIAOPT["F":"closest",1:"current"),!
  1.  W ?5,"mmddyy",?20,"070457",?35,"July 4, 1957",?60,$S(%CIAOPT["P":"recent past date",%CIAOPT["F":"future date",1:"calendar year"),!
  1.  W ?5,"mmm dd yyyy",?20,"JAN 5, 1984",?35,"January 5, 1984",?60,"is assumed.",!
  1.  W ?5,"T-n",?20,"T-5",?35,"Today's date - 5 days.",!!
  1.  Q
  1. PAUSE(%CIAZ) ;
  1.  W $$XY^CIAU(0,22),$G(%CIAZ)
  1.  I $$PAUSE^CIAU
  1.  Q