INHMR20 ;KN; 18 Jul 95 09:07; Statistical Report - Display Utilities
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
; PURPOSE:
; The purpose of the routine INHMR20 is used to contain
; the utility functions and support for INHMR2.
;
; DESCRIPTION:
; The processing of this routine is used to collect for
; utility functions to support INHMR2 Statistical Report
; Display module.
;
GNDP(INFL,INFD) ; Get node and piece
;
; Description: The function GNDP is used to get node and piece
; where data are at.
; Return: Node#^Piece#
; Parameters:
; INFL = File ien (internal entry into ^INTHU)
; INFD = Field ien
; CODE BEGINS:
Q $P($P($G(^DD(INFL,INFD,0)),U,4),";",1,2)
;
GLN(INFL) ; Get global name
;
; Description: The function GLN is used to get global name ^INTHU.
; Return: Global name (ex. ^INTHU)
; Parameters:
; INFL = File ien ( internal entry number )
; Code begins:
Q $G(^DIC(INFL,0,"GL"))
;
PRVF(CF,AR) ; Previous field
;
; Description: The function PRVF is used to return previous
; field ien, given current field ien CF.
; Return: Field ien for previous field of CF
; Parameters:
; CF = current field ien
; AR = Name of array which contains an array of field ien
; Code begins:
N TMP
I $G(CF)="" S TMP=$G(CF) Q TMP
I (@AR["S")!(@AR["P") S TMP=$O(@AR@(CF),-1)
E S TMP=CF-.1
Q TMP
;
NXTF(CF,AR) ; Next field ien
;
; Description: The function NXTF is used to return next field
; ien, given current field ien CF
; Return: Field ien for next field of CF
; Parameters:
; CF = current field ien
; AR = Name of array which contains an array of field ien
; Code begins:
N TMP
I $G(CF)="" S TMP=$G(CF)
E D
.I (@AR["S")!(@AR["P") S TMP=$O(@AR@(CF))
.E S TMP=CF+.1
Q TMP
;
CMP(S,INF,IINA,TMP,TMN) ; Compare
;
; Description: The function CMP is used to compare if S is
; in the range from TMP to TMN, and determine
; any type of data date, numeric, or string in a
; specific range.
; Return: 1 = True
; 0 = False
; Parameters:
; S = Selected items to compare
; INF = Order of items selected by user
; IINA =
; TMP = Lower limit
; TMN = Uper limit
; Code begins:
N INTMP
S INTMP=0
I IINA["P" S C=$P(^DD(INIEN,INA(INF,1),0),U,2),Y=S D Y^DIQ S S=Y
I $L($G(INA(INF,3)))=0 S:(S]"") INTMP=1
E D
.I (TMN'="") D
..I (IINA["N")!(IINA["D") S:(S>TMP)&(S<TMN) INTMP=1
..E S:(S]TMP)&(TMN]S) INTMP=1
.E D
..I (IINA["N")!(IINA["D") S:(S>TMP) INTMP=1
..E S:(S]TMP) INTMP=1
Q INTMP
;
FILL(INC,REF) ; Fill up incount array
;
; Description: The function FILL is used to fill an array with
; all the subtotals (count) and totals.
; Return: none
; Parameters:
; INC = The counter array
; REF = Name of INC array
; Code begins:
N LEV,TREF,ZLEV S LEV=""
F S LEV=$O(@REF@(LEV)) Q:LEV="" D
. S ZLEV=LEV S:LEV'=(0+LEV) ZLEV=""""_LEV_""""
. S:REF[")" TREF=$E(REF,1,$L(REF)-1)_","_ZLEV_")"
. S:REF'[")" TREF=REF_"("_ZLEV_")"
. D FILL(.INC,TREF)
. S @REF=$G(@REF)+$G(@TREF)
Q
INHMR20 ;KN; 18 Jul 95 09:07; Statistical Report - Display Utilities
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ; PURPOSE:
+5 ; The purpose of the routine INHMR20 is used to contain
+6 ; the utility functions and support for INHMR2.
+7 ;
+8 ; DESCRIPTION:
+9 ; The processing of this routine is used to collect for
+10 ; utility functions to support INHMR2 Statistical Report
+11 ; Display module.
+12 ;
GNDP(INFL,INFD) ; Get node and piece
+1 ;
+2 ; Description: The function GNDP is used to get node and piece
+3 ; where data are at.
+4 ; Return: Node#^Piece#
+5 ; Parameters:
+6 ; INFL = File ien (internal entry into ^INTHU)
+7 ; INFD = Field ien
+8 ; CODE BEGINS:
+9 QUIT $PIECE($PIECE($GET(^DD(INFL,INFD,0)),U,4),";",1,2)
+10 ;
GLN(INFL) ; Get global name
+1 ;
+2 ; Description: The function GLN is used to get global name ^INTHU.
+3 ; Return: Global name (ex. ^INTHU)
+4 ; Parameters:
+5 ; INFL = File ien ( internal entry number )
+6 ; Code begins:
+7 QUIT $GET(^DIC(INFL,0,"GL"))
+8 ;
PRVF(CF,AR) ; Previous field
+1 ;
+2 ; Description: The function PRVF is used to return previous
+3 ; field ien, given current field ien CF.
+4 ; Return: Field ien for previous field of CF
+5 ; Parameters:
+6 ; CF = current field ien
+7 ; AR = Name of array which contains an array of field ien
+8 ; Code begins:
+9 NEW TMP
+10 IF $GET(CF)=""
SET TMP=$GET(CF)
QUIT TMP
+11 IF (@AR["S")!(@AR["P")
SET TMP=$ORDER(@AR@(CF),-1)
+12 IF '$TEST
SET TMP=CF-.1
+13 QUIT TMP
+14 ;
NXTF(CF,AR) ; Next field ien
+1 ;
+2 ; Description: The function NXTF is used to return next field
+3 ; ien, given current field ien CF
+4 ; Return: Field ien for next field of CF
+5 ; Parameters:
+6 ; CF = current field ien
+7 ; AR = Name of array which contains an array of field ien
+8 ; Code begins:
+9 NEW TMP
+10 IF $GET(CF)=""
SET TMP=$GET(CF)
+11 IF '$TEST
Begin DoDot:1
+12 IF (@AR["S")!(@AR["P")
SET TMP=$ORDER(@AR@(CF))
+13 IF '$TEST
SET TMP=CF+.1
End DoDot:1
+14 QUIT TMP
+15 ;
CMP(S,INF,IINA,TMP,TMN) ; Compare
+1 ;
+2 ; Description: The function CMP is used to compare if S is
+3 ; in the range from TMP to TMN, and determine
+4 ; any type of data date, numeric, or string in a
+5 ; specific range.
+6 ; Return: 1 = True
+7 ; 0 = False
+8 ; Parameters:
+9 ; S = Selected items to compare
+10 ; INF = Order of items selected by user
+11 ; IINA =
+12 ; TMP = Lower limit
+13 ; TMN = Uper limit
+14 ; Code begins:
+15 NEW INTMP
+16 SET INTMP=0
+17 IF IINA["P"
SET C=$PIECE(^DD(INIEN,INA(INF,1),0),U,2)
SET Y=S
DO Y^DIQ
SET S=Y
+18 IF $LENGTH($GET(INA(INF,3)))=0
IF (S]"")
SET INTMP=1
+19 IF '$TEST
Begin DoDot:1
+20 IF (TMN'="")
Begin DoDot:2
+21 IF (IINA["N")!(IINA["D")
IF (S>TMP)&(S<TMN)
SET INTMP=1
+22 IF '$TEST
IF (S]TMP)&(TMN]S)
SET INTMP=1
End DoDot:2
+23 IF '$TEST
Begin DoDot:2
+24 IF (IINA["N")!(IINA["D")
IF (S>TMP)
SET INTMP=1
+25 IF '$TEST
IF (S]TMP)
SET INTMP=1
End DoDot:2
End DoDot:1
+26 QUIT INTMP
+27 ;
FILL(INC,REF) ; Fill up incount array
+1 ;
+2 ; Description: The function FILL is used to fill an array with
+3 ; all the subtotals (count) and totals.
+4 ; Return: none
+5 ; Parameters:
+6 ; INC = The counter array
+7 ; REF = Name of INC array
+8 ; Code begins:
+9 NEW LEV,TREF,ZLEV
SET LEV=""
+10 FOR
SET LEV=$ORDER(@REF@(LEV))
IF LEV=""
QUIT
Begin DoDot:1
+11 SET ZLEV=LEV
IF LEV'=(0+LEV)
SET ZLEV=""""_LEV_""""
+12 IF REF[")"
SET TREF=$EXTRACT(REF,1,$LENGTH(REF)-1)_","_ZLEV_")"
+13 IF REF'[")"
SET TREF=REF_"("_ZLEV_")"
+14 DO FILL(.INC,TREF)
+15 SET @REF=$GET(@REF)+$GET(@TREF)
End DoDot:1
+16 QUIT
