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