INHMSR20.m

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