Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: INHMSR10

INHMSR10.m

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