INHMSR20 ;KN; 27 Nov 95 09:56; Statistical Report-Utility
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
; DESCRIPTION:
; The processing of this routine is used to collect for
; utility functions to support INHMSR2 Statistical Report
; Display module.
;
Q
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 number)
; 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.
; 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
; No range selected, keep current field the same
I $G(CF)="" S TMP=$G(CF) Q TMP
; For date, and number back up a litle bit (-.0000001)
I (@AR["N")!(@AR["D") S TMP=CF-.0000001
; For pointer or free text keep the same
I (@AR["P")!(@AR["F")!(@AR["S") S TMP=CF
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) Q TMP
; For DATE, and Number jack it up a a little bit (+.0000001)
I (@AR["D")!(@AR["N") S TMP=CF+.0000001
; For pointer or free text, use ~ for compare
I (@AR["P")!(@AR["F")!(@AR["S") S TMP=CF_"~"
Q TMP
;
CMP(S,IINA,TML,TMU) ; Compare
;
;
; Description: The function CMP is used to compare if S is
; in the range from TML to TMU, 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
; IINA = Contains type of field
; TML = Lower limit
; TMU = Upper limit
; Code begins:
N INTMP
S INTMP=0
; No FROM and TO, count this field
I (TML="")&(TMU="")&(S]"") Q 1
; No TO, compare from TML and on
I (TMU="") D Q INTMP
.I ((IINA["N")!(IINA["D"))&(S'<TML) S INTMP=1 Q
.I ((IINA["P")!(IINA["S")!(IINA["F"))&(TML']S) S INTMP=1 Q
; No FROM
I (TML="") D Q INTMP
.I ((IINA["N")!(IINA["D"))&(S'>TMU) S INTMP=1 Q
.I ((IINA["P")!(IINA["S")!(IINA["F"))&(S']TMU) S INTMP=1 Q
; Both FROM and TO, compare to lower limit and upper limit
I (TML'="")&(TMU'="") D Q INTMP
.I ((IINA["N")!(IINA["D"))&(S'<TML)&(S'>TMU) S INTMP=1 Q
.I ((IINA["P")!(IINA["S")!(IINA["F"))&(TML']S)&(S']TMU) S INTMP=1 Q
;nothing match, return 0
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=""
; Go through the current level of the array, LEV is the current subscript
F S LEV=$O(@REF@(LEV)) Q:LEV="" D
.; if the subscript is not a number, concat "" to make it a string
. S ZLEV=LEV S:LEV'=(+LEV) ZLEV=""""_LEV_""""
.; construct the indirect value for next level of the array TREF
. S:REF[")" TREF=$E(REF,1,$L(REF)-1)_","_ZLEV_")"
. S:REF'[")" TREF=REF_"("_ZLEV_")"
.; Recursively calling this same routine
. D FILL(.INC,TREF)
.; Accumulating the count
. S @REF=$G(@REF)+$G(@TREF)
Q
;
FILL1(INC,REF) ; Display the output of the Statistical Report
;
; Description: The function FILL1 is used to perform the display
; routine (using recursive).
;
; - upon entry set LEVEL=0
; - INSFLG flag to disable field type display in second line & on
; - INL is the length of field type, if > 20 then go to new line
; ex. in case of the ORIGINAL TRANSACTION TYPE.
; Return: none
; Parameters:
; INC = The counter array
; REF = Name of INC array
; Code begins:
N CSUB,TREF,ZSUB,DFLG S CSUB="",INSFLG=0
Q:$G(DUOUT)
F S CSUB=$O(@REF@(CSUB)) Q:CSUB="" D Q:$G(DUOUT)
. S ZSUB=CSUB S:CSUB'=(+CSUB) ZSUB=""""_CSUB_""""
. S:REF[")" TREF=$E(REF,1,$L(REF)-1)_","_ZSUB_")"
. S:REF'[")" TREF=REF_"("_ZSUB_")"
.; Set level of the subscript
. S LEVEL=$G(LEVEL)+1
.; If only six lines left in the page, then go to the new page
. I $Y+6>IOSL D HEAD^INHMSR21(INIEN,.INA,INTYPE) Q:$G(DUOUT)
.;display field type only on the first line of a new type
.I '$G(INSFLG) W !?(LEVEL*3),$G(INDP(LEVEL))," : " D INLN^INHMSR21(CSUB,LEVEL*3) S INL(LEVEL)=$L($G(INDP(LEVEL)))
.I ($G(INSFLG)&($G(INL(LEVEL))>20)) W !?(5+(LEVEL*3)),CSUB
.I ($G(INSFLG)&($G(INL(LEVEL))'>20)) W !?($G(INL(LEVEL))+3+(LEVEL*3)),CSUB
. D FILL1(.INC,TREF) Q:$G(DUOUT)
.; check if this is the last level, then this is the count
. I $G(INSEL)=$G(LEVEL) D ADJ^INHMSR21($G(@TREF)) S INSFLG=1
.; otherwise it must be the subtotal
. I $Y+7>IOSL D HEAD^INHMSR21(INIEN,.INA,INTYPE) Q:$G(DUOUT)
. I $G(INSEL)=($G(LEVEL)+1) D INDASH^INHMSR21
. I ($G(LEVEL)'=$G(INSEL)) W !?(LEVEL*3),$G(INDP(LEVEL))," SUBTOTAL : " D INLN^INHMSR21(CSUB,LEVEL*3+5) D ADJ^INHMSR21($G(@TREF)) S INSFLG=0 W !
. S LEVEL=$G(LEVEL)-1
Q
INHMSR20 ;KN; 27 Nov 95 09:56; Statistical Report-Utility
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ; DESCRIPTION:
+5 ; The processing of this routine is used to collect for
+6 ; utility functions to support INHMSR2 Statistical Report
+7 ; Display module.
+8 ;
+9 QUIT
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 number)
+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.
+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 ; No range selected, keep current field the same
+11 IF $GET(CF)=""
SET TMP=$GET(CF)
QUIT TMP
+12 ; For date, and number back up a litle bit (-.0000001)
+13 IF (@AR["N")!(@AR["D")
SET TMP=CF-.0000001
+14 ; For pointer or free text keep the same
+15 IF (@AR["P")!(@AR["F")!(@AR["S")
SET TMP=CF
+16 QUIT TMP
+17 ;
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)
QUIT TMP
+11 ; For DATE, and Number jack it up a a little bit (+.0000001)
+12 IF (@AR["D")!(@AR["N")
SET TMP=CF+.0000001
+13 ; For pointer or free text, use ~ for compare
+14 IF (@AR["P")!(@AR["F")!(@AR["S")
SET TMP=CF_"~"
+15 QUIT TMP
+16 ;
CMP(S,IINA,TML,TMU) ; Compare
+1 ;
+2 ;
+3 ; Description: The function CMP is used to compare if S is
+4 ; in the range from TML to TMU, and determine
+5 ; any type of data date, numeric, or string in a
+6 ; specific range.
+7 ; Return: 1 = True
+8 ; 0 = False
+9 ; Parameters:
+10 ; S = Selected items to compare
+11 ; IINA = Contains type of field
+12 ; TML = Lower limit
+13 ; TMU = Upper limit
+14 ; Code begins:
+15 NEW INTMP
+16 SET INTMP=0
+17 ; No FROM and TO, count this field
+18 IF (TML="")&(TMU="")&(S]"")
QUIT 1
+19 ; No TO, compare from TML and on
+20 IF (TMU="")
Begin DoDot:1
+21 IF ((IINA["N")!(IINA["D"))&(S'<TML)
SET INTMP=1
QUIT
+22 IF ((IINA["P")!(IINA["S")!(IINA["F"))&(TML']S)
SET INTMP=1
QUIT
End DoDot:1
QUIT INTMP
+23 ; No FROM
+24 IF (TML="")
Begin DoDot:1
+25 IF ((IINA["N")!(IINA["D"))&(S'>TMU)
SET INTMP=1
QUIT
+26 IF ((IINA["P")!(IINA["S")!(IINA["F"))&(S']TMU)
SET INTMP=1
QUIT
End DoDot:1
QUIT INTMP
+27 ; Both FROM and TO, compare to lower limit and upper limit
+28 IF (TML'="")&(TMU'="")
Begin DoDot:1
+29 IF ((IINA["N")!(IINA["D"))&(S'<TML)&(S'>TMU)
SET INTMP=1
QUIT
+30 IF ((IINA["P")!(IINA["S")!(IINA["F"))&(TML']S)&(S']TMU)
SET INTMP=1
QUIT
End DoDot:1
QUIT INTMP
+31 ;nothing match, return 0
+32 QUIT INTMP
+33 ;
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 ; Go through the current level of the array, LEV is the current subscript
+11 FOR
SET LEV=$ORDER(@REF@(LEV))
IF LEV=""
QUIT
Begin DoDot:1
+12 ; if the subscript is not a number, concat "" to make it a string
+13 SET ZLEV=LEV
IF LEV'=(+LEV)
SET ZLEV=""""_LEV_""""
+14 ; construct the indirect value for next level of the array TREF
+15 IF REF[")"
SET TREF=$EXTRACT(REF,1,$LENGTH(REF)-1)_","_ZLEV_")"
+16 IF REF'[")"
SET TREF=REF_"("_ZLEV_")"
+17 ; Recursively calling this same routine
+18 DO FILL(.INC,TREF)
+19 ; Accumulating the count
+20 SET @REF=$GET(@REF)+$GET(@TREF)
End DoDot:1
+21 QUIT
+22 ;
FILL1(INC,REF) ; Display the output of the Statistical Report
+1 ;
+2 ; Description: The function FILL1 is used to perform the display
+3 ; routine (using recursive).
+4 ;
+5 ; - upon entry set LEVEL=0
+6 ; - INSFLG flag to disable field type display in second line & on
+7 ; - INL is the length of field type, if > 20 then go to new line
+8 ; ex. in case of the ORIGINAL TRANSACTION TYPE.
+9 ; Return: none
+10 ; Parameters:
+11 ; INC = The counter array
+12 ; REF = Name of INC array
+13 ; Code begins:
+14 NEW CSUB,TREF,ZSUB,DFLG
SET CSUB=""
SET INSFLG=0
+15 IF $GET(DUOUT)
QUIT
+16 FOR
SET CSUB=$ORDER(@REF@(CSUB))
IF CSUB=""
QUIT
Begin DoDot:1
+17 SET ZSUB=CSUB
IF CSUB'=(+CSUB)
SET ZSUB=""""_CSUB_""""
+18 IF REF[")"
SET TREF=$EXTRACT(REF,1,$LENGTH(REF)-1)_","_ZSUB_")"
+19 IF REF'[")"
SET TREF=REF_"("_ZSUB_")"
+20 ; Set level of the subscript
+21 SET LEVEL=$GET(LEVEL)+1
+22 ; If only six lines left in the page, then go to the new page
+23 IF $Y+6>IOSL
DO HEAD^INHMSR21(INIEN,.INA,INTYPE)
IF $GET(DUOUT)
QUIT
+24 ;display field type only on the first line of a new type
+25 IF '$GET(INSFLG)
WRITE !?(LEVEL*3),$GET(INDP(LEVEL))," : "
DO INLN^INHMSR21(CSUB,LEVEL*3)
SET INL(LEVEL)=$LENGTH($GET(INDP(LEVEL)))
+26 IF ($GET(INSFLG)&($GET(INL(LEVEL))>20))
WRITE !?(5+(LEVEL*3)),CSUB
+27 IF ($GET(INSFLG)&($GET(INL(LEVEL))'>20))
WRITE !?($GET(INL(LEVEL))+3+(LEVEL*3)),CSUB
+28 DO FILL1(.INC,TREF)
IF $GET(DUOUT)
QUIT
+29 ; check if this is the last level, then this is the count
+30 IF $GET(INSEL)=$GET(LEVEL)
DO ADJ^INHMSR21($GET(@TREF))
SET INSFLG=1
+31 ; otherwise it must be the subtotal
+32 IF $Y+7>IOSL
DO HEAD^INHMSR21(INIEN,.INA,INTYPE)
IF $GET(DUOUT)
QUIT
+33 IF $GET(INSEL)=($GET(LEVEL)+1)
DO INDASH^INHMSR21
+34 IF ($GET(LEVEL)'=$GET(INSEL))
WRITE !?(LEVEL*3),$GET(INDP(LEVEL))," SUBTOTAL : "
DO INLN^INHMSR21(CSUB,LEVEL*3+5)
DO ADJ^INHMSR21($GET(@TREF))
SET INSFLG=0
WRITE !
+35 SET LEVEL=$GET(LEVEL)-1
End DoDot:1
IF $GET(DUOUT)
QUIT
+36 QUIT
