INHMSR10 ;KN; 11 Jul 96 11:52; Statistical Report-Def Screen Utilities
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
; MODULE NAME: Statistical Report - Definition Screen Utilities
; INHMSR10.
;
; PURPOSE:
; The purpose of this routine is used to contain utility functions
; and support for INHMSR1.
;
; DESCRIPTION:
; The processing of this routine is used to collect for utility
; functions to support INHMSR1 Statistical Report Definintion
; Screen modules.
;
Q
GPC2(INFL,INFD) ; get piece #2
;
; Description: The function GPC2 is used to get piece #2 from
; data dictionary ^DD to determine the field type.
;
; Return: Field type (i.e. Number, Set of code, Date, Pointer)
; Parameters:
; INFL = File ien (internal entry number)
; INFD = Field ien
Q $P($G(^DD(INFL,INFD,0)),U,2)
;
;
GPC3(INFL,INFD) ;get piece #3 to determine field type
;
; Description: The function GPC3 is used to get piece #3 from
; data dictionary ^DD, to get data for pointer
; and set data type.
;
; Return: Field type
; Parameters:
; INFL = File ien (internal entry number)
; INFD = Field ien
Q $P($G(^DD(INFL,INFD,0)),U,3)
;
GVL(INFL,INFD) ;validation function, return mumps code for date, other default.
;
; Description: The function GVL is used to return Mumps code to
; validate user's input according to field type.
;
; Return: Mumps code for validation
; Parameters:
; INFL = File ien (internal entry number)
; INFD = Field ien
; Code begins:
N INTMP,PC2,DIC,DIE
S PC2=$$GPC2(INFL,INFD)
; Validation for date
I PC2["D" S INTMP="S %DT=""TX"" D ^%DT S Y1=Y D DD^%DT S X=Y K:Y1<1 X"
E S INTMP=$P($G(^DD(INFL,INFD,0)),U,5,99)
; for Interface error, press enter will ask for input and override
; the input transform for location of error
I INFL=4003,INFD=.05 S INTMP="S DIC(0)=""DQ"",(DIE,DIC)=$G(^DIC(4003.1,0,""GL"")),DIC(""S"")=""I $P(^(0),U)'=""""ALL"""""" D ^DIC K DIC S C=$P(^DD("_INFL_","_INFD_",0),U,2) D Y^DIQ S DIC=DIE,X=$P(Y,U,2) K:Y<0 X"
Q INTMP
;
INHELP(INFL,INFD) ; Get help for range input.
;
; Description: The function INHELP is used to provide help for
; the range input.
; Return: none
; Parameters:
; INFL = File ien (internal entry number)
; INFD = Field ien
; Code begins:
N DQ,DV,D,DP,DZ,INIOSL
; Save value only if exist
S:$D(DIJC("IOSL")) INIOSL=$G(DIJC("IOSL"))
; Display the screen DWL for support help
D POP^DWLR2(12,1)
S DIJC("IOSL")=6
; Call function to get information for help
D FMHELP^INHUT2(INFL,INFD)
I $$CR^UTSRD
; Restore value only if saved before
S:$D(INIOSL) DIJC("IOSL")=INIOSL
Q
;
ISTHERE(INFL,INFD,INFLG) ;Check if the field is selectable
;
; Description: The function ISTHERE is used to check if the
; field is selectable and return 1. All the
; selectable fields are stored in global.
; Return: 1 = True
; 0 = False
; Parameters:
; INFL = File ien(internal entry number)
; INFD = Field ien
; INFLG = flag
; = 1 indicates that this file has predefined selectable
; fields stored in global.
; = 0 indicates that there is no pre-defined selectable
; and therefore ignores computed and multiple field.
; Code begins:
N INTMP,X,PC2
S INTMP=0
I INFLG D
.; Search ^UTILITY if a field is there
.S INTMP=$D(^UTILITY($J,"INHSR",INFL,INFD))#10
E D
.; Set function to determine of the field type
.S PC2=$$GPC2(INFL,INFD)
.; ignore it if a multiple field
.S:'($E(PC2)?1N) INTMP=1
Q INTMP
;
INACHK(INFL,INA) ;verify field .01 range
;
; Description: The function INACHK is used to verify .01 field
; range.
; Return: 1 = Error detected
; 0 = No error
; Parameters:
; INFL = File ien
; INA = Criteria array for statistical report
; Code begins:
N TMP,IN,INB,INC
;int TMP, X, GLNN= Global name, GLN= global+cross ref B
S TMP=0,X=$O(INA(0)),GLNN=$G(^DIC(INFL,0,"GL")),GLN=""_GLNN_"""B"""_")"
; IN=first field in global, INB=field ien of the first field in global
S IN=$O(@GLN@("")),INB=$O(@GLN@(IN,""))
; In=last field in global, INC=field ien of last field in global
S IN=$O(@GLN@(""),-1),INC=$O(@GLN@(IN,"")),IN=$G(INC)-$G(INB)
; check if first field selected is .01
I $G(INA(X,1))=.01 D
.; Check doest it have range
.I '$L(INA(X,3))&'$L(INA(X,4)) D
..; if no range then display
..D MESS^DWD(5,10) W !,"Approximate search size "_IN_" messages"
..I $$YN^UTSRD("Do you want to continue ?") S INA(0)=0
..E S TMP=1
.; INA(0)=0 field .01 has range
.E S INA(0)=1
E D
.; field .01 is no selected
.D MESS^DWD(5,10) W !,"Approximate search size "_IN_" messages"
.I $$YN^UTSRD("Do you want to continue ?") S INA(0)=2
.E S TMP=1 Q
.; X=first order selected
.S X=$O(INA(0))
.; Loop thru INA array and make sure field .01 is not selected
.; in order different than 1
.F S X=$O(INA(X)) Q:X="" D
..; If the .01 field is selected. It is order must be "1"
..I $G(INA(X,1))=.01 D MESS^DWD(5,10) W !,$G(INA(X,2))," Field must be order 1" S TMP=1 I $$CR^UTSRD
Q TMP
INHMSR10 ;KN; 11 Jul 96 11:52; Statistical Report-Def Screen Utilities
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ; MODULE NAME: Statistical Report - Definition Screen Utilities
+5 ; INHMSR10.
+6 ;
+7 ; PURPOSE:
+8 ; The purpose of this routine is used to contain utility functions
+9 ; and support for INHMSR1.
+10 ;
+11 ; DESCRIPTION:
+12 ; The processing of this routine is used to collect for utility
+13 ; functions to support INHMSR1 Statistical Report Definintion
+14 ; Screen modules.
+15 ;
+16 QUIT
GPC2(INFL,INFD) ; get piece #2
+1 ;
+2 ; Description: The function GPC2 is used to get piece #2 from
+3 ; data dictionary ^DD to determine the field type.
+4 ;
+5 ; Return: Field type (i.e. Number, Set of code, Date, Pointer)
+6 ; Parameters:
+7 ; INFL = File ien (internal entry number)
+8 ; INFD = Field ien
+9 QUIT $PIECE($GET(^DD(INFL,INFD,0)),U,2)
+10 ;
+11 ;
GPC3(INFL,INFD) ;get piece #3 to determine field type
+1 ;
+2 ; Description: The function GPC3 is used to get piece #3 from
+3 ; data dictionary ^DD, to get data for pointer
+4 ; and set data type.
+5 ;
+6 ; Return: Field type
+7 ; Parameters:
+8 ; INFL = File ien (internal entry number)
+9 ; INFD = Field ien
+10 QUIT $PIECE($GET(^DD(INFL,INFD,0)),U,3)
+11 ;
GVL(INFL,INFD) ;validation function, return mumps code for date, other default.
+1 ;
+2 ; Description: The function GVL is used to return Mumps code to
+3 ; validate user's input according to field type.
+4 ;
+5 ; Return: Mumps code for validation
+6 ; Parameters:
+7 ; INFL = File ien (internal entry number)
+8 ; INFD = Field ien
+9 ; Code begins:
+10 NEW INTMP,PC2,DIC,DIE
+11 SET PC2=$$GPC2(INFL,INFD)
+12 ; Validation for date
+13 IF PC2["D"
SET INTMP="S %DT=""TX"" D ^%DT S Y1=Y D DD^%DT S X=Y K:Y1<1 X"
+14 IF '$TEST
SET INTMP=$PIECE($GET(^DD(INFL,INFD,0)),U,5,99)
+15 ; for Interface error, press enter will ask for input and override
+16 ; the input transform for location of error
+17 IF INFL=4003
IF INFD=.05
SET INTMP="S DIC(0)=""DQ"",(DIE,DIC)=$G(^DIC(4003.1,0,""GL"")),DIC(""S"")=""I $P(^(0),U)'=""""ALL"""""" D ^DIC K DIC S C=$P(^DD("_INFL_","_INFD_",0),U,2) D Y^DIQ S DIC=DIE,X=$P(Y,U,2) K:Y<0 X"
+18 QUIT INTMP
+19 ;
INHELP(INFL,INFD) ; Get help for range input.
+1 ;
+2 ; Description: The function INHELP is used to provide help for
+3 ; the range input.
+4 ; Return: none
+5 ; Parameters:
+6 ; INFL = File ien (internal entry number)
+7 ; INFD = Field ien
+8 ; Code begins:
+9 NEW DQ,DV,D,DP,DZ,INIOSL
+10 ; Save value only if exist
+11 IF $DATA(DIJC("IOSL"))
SET INIOSL=$GET(DIJC("IOSL"))
+12 ; Display the screen DWL for support help
+13 DO POP^DWLR2(12,1)
+14 SET DIJC("IOSL")=6
+15 ; Call function to get information for help
+16 DO FMHELP^INHUT2(INFL,INFD)
+17 IF $$CR^UTSRD
+18 ; Restore value only if saved before
+19 IF $DATA(INIOSL)
SET DIJC("IOSL")=INIOSL
+20 QUIT
+21 ;
ISTHERE(INFL,INFD,INFLG) ;Check if the field is selectable
+1 ;
+2 ; Description: The function ISTHERE is used to check if the
+3 ; field is selectable and return 1. All the
+4 ; selectable fields are stored in global.
+5 ; Return: 1 = True
+6 ; 0 = False
+7 ; Parameters:
+8 ; INFL = File ien(internal entry number)
+9 ; INFD = Field ien
+10 ; INFLG = flag
+11 ; = 1 indicates that this file has predefined selectable
+12 ; fields stored in global.
+13 ; = 0 indicates that there is no pre-defined selectable
+14 ; and therefore ignores computed and multiple field.
+15 ; Code begins:
+16 NEW INTMP,X,PC2
+17 SET INTMP=0
+18 IF INFLG
Begin DoDot:1
+19 ; Search ^UTILITY if a field is there
+20 SET INTMP=$DATA(^UTILITY($JOB,"INHSR",INFL,INFD))#10
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 ; Set function to determine of the field type
+23 SET PC2=$$GPC2(INFL,INFD)
+24 ; ignore it if a multiple field
+25 IF '($EXTRACT(PC2)?1N)
SET INTMP=1
End DoDot:1
+26 QUIT INTMP
+27 ;
INACHK(INFL,INA) ;verify field .01 range
+1 ;
+2 ; Description: The function INACHK is used to verify .01 field
+3 ; range.
+4 ; Return: 1 = Error detected
+5 ; 0 = No error
+6 ; Parameters:
+7 ; INFL = File ien
+8 ; INA = Criteria array for statistical report
+9 ; Code begins:
+10 NEW TMP,IN,INB,INC
+11 ;int TMP, X, GLNN= Global name, GLN= global+cross ref B
+12 SET TMP=0
SET X=$ORDER(INA(0))
SET GLNN=$GET(^DIC(INFL,0,"GL"))
SET GLN=""_GLNN_"""B"""_")"
+13 ; IN=first field in global, INB=field ien of the first field in global
+14 SET IN=$ORDER(@GLN@(""))
SET INB=$ORDER(@GLN@(IN,""))
+15 ; In=last field in global, INC=field ien of last field in global
+16 SET IN=$ORDER(@GLN@(""),-1)
SET INC=$ORDER(@GLN@(IN,""))
SET IN=$GET(INC)-$GET(INB)
+17 ; check if first field selected is .01
+18 IF $GET(INA(X,1))=.01
Begin DoDot:1
+19 ; Check doest it have range
+20 IF '$LENGTH(INA(X,3))&'$LENGTH(INA(X,4))
Begin DoDot:2
+21 ; if no range then display
+22 DO MESS^DWD(5,10)
WRITE !,"Approximate search size "_IN_" messages"
+23 IF $$YN^UTSRD("Do you want to continue ?")
SET INA(0)=0
+24 IF '$TEST
SET TMP=1
End DoDot:2
+25 ; INA(0)=0 field .01 has range
+26 IF '$TEST
SET INA(0)=1
End DoDot:1
+27 IF '$TEST
Begin DoDot:1
+28 ; field .01 is no selected
+29 DO MESS^DWD(5,10)
WRITE !,"Approximate search size "_IN_" messages"
+30 IF $$YN^UTSRD("Do you want to continue ?")
SET INA(0)=2
+31 IF '$TEST
SET TMP=1
QUIT
+32 ; X=first order selected
+33 SET X=$ORDER(INA(0))
+34 ; Loop thru INA array and make sure field .01 is not selected
+35 ; in order different than 1
+36 FOR
SET X=$ORDER(INA(X))
IF X=""
QUIT
Begin DoDot:2
+37 ; If the .01 field is selected. It is order must be "1"
+38 IF $GET(INA(X,1))=.01
DO MESS^DWD(5,10)
WRITE !,$GET(INA(X,2))," Field must be order 1"
SET TMP=1
IF $$CR^UTSRD
End DoDot:2
End DoDot:1
+39 QUIT TMP
