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

INHMSR21.m

Go to the documentation of this file. 
  1. INHMSR21 ;KN; 12 Jan 96 12:02; Statistical Report-Utility 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  ; MODULE NAME: Statistical Report Display Module (INHMSR21).
  1.  ;
  1.  ; DESCRIPTION: The purpose of the INHMSR21 is used to contain
  1.  ;              the functions and support for INHMSR2 and 
  1.  ;        INHMSR20.
  1.  ;
  1.  ;
  1.  ; Description:  The function HEAD is used to display/print report
  1.  ;               header.
  1.  ; Return: None
  1.  ; Parameters:
  1.  ;    FLIEN = File ien
  1.  ;    INA = Array of user selected criteria
  1.  ;    INTYPE = all field type selected by user
  1.  ;
  1.  ; Code begins:
  1.  N L,I,X,Y,H
  1.  K DUOUT S INPAGE=+$G(INPAGE)
  1.  ;Initialize site name and today date
  1.  S INSITE=$S($D(^DIC(4,^DD("SITE",1),0)):^(0),1:^DD("SITE")),INSITE=$S($P(INSITE,"^",4)]"":$P(INSITE,"^",4),1:$P(INSITE,"^",1))
  1.  I '$D(INDT) D NOW^%DTC S Y=$J(%,12,4) D DD^%DT S INDT=Y
  1.  ; Beep for the new page.
  1.  ; Set timeout=120 seconds to quit
  1.  I IO=IO(0),'$D(ZTSK),$E(IOST,1,2)="C-",INPAGE W !,*7,$G(INA("FT")),!  D ^UTSRD("Press <RETURN> to continue or ^ to QUIT;;;;;;;0;;;;DTIME;;X","","",1) S:(X=1)!(X=2) DUOUT=1
  1.  Q:$G(DUOUT)
  1.  W:INPAGE @IOF S INPAGE=INPAGE+1
  1.  ; Get FNAM to display in header.
  1.  S GLNM=$$GLN^INHMSR20(FLIEN),FNAM=$P(@(GLNM_"0)"),U,1),H=IOM/2
  1.  S L=FNAM_" STATISTICS"
  1.  W $G(INA("HD"))
  1.  W !,INSITE,?(IOM-28),INDT,?(IOM-9),"Page",INPAGE,!!!?(H-($L(L)\2)),L
  1.  S L="From:   "_INSD(1)_"     To:   "_INED(1) W !?(H-($L(L)\2)),L,!
  1.  W ! K Z S $P(Z,"-",IOM)="" W Z
  1.  W !?3,"Field Name",?(IOM-10),"Count"
  1.  W ! K Z S $P(Z,"-",IOM+1)="" W Z
  1.  Q
  1.  ;  
  1. RANGES(INA) ; Ranges input
  1.  ; 
  1.  ; Description:  The function RANGES is used to determine the 
  1.  ;               search range based on user select criteria.
  1.  ; Return: none
  1.  ; Parameters: 
  1.  ; INA = Array of user selected criteria
  1.  ;
  1.  ; Code begins:
  1.  ; field .01 is selected
  1.  I INA(0)=1 D
  1.  .S FLD(0)=$O(INA(0))
  1.  .S I=$O(INA(0))
  1.  .S INSD=$G(INA(I,3)),INED=$G(INA(I,4))
  1.  .; field .01 is date, convert to time format
  1.  .I INA(I,6)["D"  D  Q
  1.  ..;INA array now contains external form, change conversion
  1.  ..S INSD(1)=INSD,INED(1)=INED,%DT="TX"
  1.  ..S X=INSD D ^%DT S INSD=Y-.0000001
  1.  ..S X=INED D ^%DT S INED=Y S:INED\1=INED INED=INED+.24
  1.  ..I INSD(1)="" S INSD=$O(@(GLNM_"""B"","""")")),Y=INSD,%DT="TX" D DD^%DT S INSD(1)=Y
  1.  ..I INED(1)="" D NOW^%DTC S INED=%,Y=$J(%,12,4),%DT="TX" D DD^%DT S INED(1)=Y
  1.  .I INA(I,6)'["D"  D  Q
  1.  ..; if field .01 is not date, is pointer or free text
  1.  ..; Search the whole file
  1.  ..S INSD="",INED=$O(@(GLNM_"""B"","""")"),-1)
  1.  ..S INSD(1)=$G(INA(FLD(0),3)),INED(1)=$G(INA(FLD(0),4))
  1.  ..; for pointer then convert
  1.  ..I INA(I,6)["P" D
  1.  ...S INGNM=$$GPC3^INHMSR10(INIEN,.01),A="^"_INGNM_"""B"""_")"
  1.  ...I INSD(1)'="" S INSD(1)=$O(@A@(INSD(1)))
  1.  ...I INED(1)'="" S INED(1)=INED(1)_"~",INED(1)=$O(@A@(INED(1)))
  1.  ...;I INED(1)="" S INED(1)=$O(@A@(""),-1)
  1.  I INA(0)'=1 D
  1.  .; no range for .01 field
  1.  .S:$G(INA(0))=0 FLD(0)=$O(INA(0))
  1.  .S:$G(INA(0))=2 FLD(0)=0,SEL=$G(SEL)+1
  1.  .S INSD="",INSD(1)=$O(@(GLNM_"""B"","""")"))
  1.  .S (INED,INED(1))=$O(@(GLNM_"""B"","""")"),-1)
  1.  .; call function HDCON to convert to external value for header
  1.  .S INSD(1)=$$HDCON^INHMSR22(INIEN,.01,INSD(1)),INED(1)=$$HDCON^INHMSR22(INIEN,.01,INED(1))
  1.  Q
  1.  ;
  1. ADJ(NUM) ; 
  1.  ;
  1.  ; Description:  The function ADJ is used to right justify a number, 
  1.  ;  width=7
  1.  ; Return: None
  1.  ; Parameters:
  1.  ;    NUM = Number to display
  1.  ;
  1.  ; Code begins:
  1.  W ?(IOM-13),$$JUST^UTIL($G(NUM),7,"R",0)
  1.  Q
  1.  ;
  1. DISF(L,SK,FTYP,FNAM) ; Display field 
  1.  ;
  1.  ; Description:  The function DISF is used to display a field type 
  1.  ;               and field name.
  1.  ; Return: None
  1.  ; Parameters:
  1.  ;    L   = left margin
  1.  ;    SK   = a flag - 0: display field type, 1: skip
  1.  ;    FTYP = Field type
  1.  ;    FNAM = Name of the field
  1.  ;
  1.  ; code begins
  1.  I SK=0  D
  1.  .; For long type > 30 chars goes to new line
  1.  .W !?$G(L),$G(FTYP)_" : "
  1.  .I (($L(FTYP)+$G(L))>30) W !?($G(L)+5),$G(FNAM)
  1.  .I (($L(FTYP)+$G(L))'>30) W $G(FNAM)
  1.  I SK'=0  D
  1.  .I (($L(FTYP)+$G(L))>30) W !?($G(L)+5),$G(FNAM)
  1.  .I (($L(FTYP)+$G(L))'>30) W !?($L(FTYP)+$G(L)+3),$G(FNAM)
  1.  Q
  1.  ;
  1. INDASH ; Dash
  1.  ;
  1.  ; Description:  The function INDASH is used to display a dash 
  1.  ;               for count total.
  1.  ; Return: none
  1.  ; Parameters: none
  1.  ;
  1.  ; Code begins:
  1.  W !?(IOM-10),"-------"
  1.  Q
  1.  ;
  1. INLN(STR,NUM) ; Line
  1.  ;
  1.  ; Description:   The function INLN is used to return to second line 
  1.  ;                if display is too long.
  1.  ; Return: none
  1.  ; Parameters:
  1.  ;    STR = String to display
  1.  ;    NUM = Start new line at NUM+5 characters
  1.  ;
  1.  ; Code begins:
  1.  I $X>30 W !?($G(NUM)+5),STR
  1.  E  W STR
  1.  Q
  1.  ;
  1. CMPEXT(IN,IN1FT) ; Compare external value for the pointer
  1.  ;
  1.  ; Description:  The function CMPEXT is used to compare IN value
  1.  ;  for a pointer or free text if user select a range.
  1.  ;  IN1X is the external value.  If IN is in the range
  1.  ;  selected then continue the count, i.e. return 0
  1.  ; Return:  1 = for quit
  1.  ;     0 = for continue
  1.  ; Parameters:
  1.  ; IN = value to compare
  1.  ;
  1.  ; Code begins:
  1.  N INTMP,IN1X
  1.  ; Initialize the return value, default = 0 (continue)
  1.  S INTMP=0
  1.  ; if user select range for field .01 and it is pointer or freetext
  1.  I (INA(0)=1)&((IN1FT["P")!(IN1FT["F"))  D
  1.  .; for the pointer, get its external value
  1.  .S:IN1FT["P" IN1X=$$INXMVG^INHMSR22(INIEN,INA(FLD(0),1),$G(IN))
  1.  .; for the freetext, get the value
  1.  .S:IN1FT["F" IN1X=$G(IN)
  1.  .; save external value for header
  1.  .I '$D(INP($G(IN1X))) S INP($G(IN1X))=""
  1.  .; then compare if it is in selected range
  1.  .; If no from the range
  1.  .I INA(FLD(0),3)="" S:INA(FLD(0),4)_"~"']IN1X INTMP=1
  1.  .; If no to the range
  1.  .I INA(FLD(0),4)="" S:IN1X']INA(FLD(0),3) INTMP=1
  1.  .; If both from and to then keep the same
  1.  .I (INA(FLD(0),3)'="")&(INA(FLD(0),4)'="") S:(INA(FLD(0),3)]IN1X)!(INA(FLD(0),4)_"~"']IN1X) INTMP=1
  1.  Q INTMP