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

INHU1.m

Go to the documentation of this file.
  1. INHU1 ;JSH; 6 May 98 09:15;GIS utilities - cont'd
  1. ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1. ;COPYRIGHT 1991-2000 SAIC
  1. ;
  1. CUR() ;Currency report
  1. ;Returns a 1 if current, 0 if not current, -1 if unknown
  1. N CT,I,J,T
  1. S CT=$P(^INRHSITE(1,0),U,13) Q:'CT -1
  1. S T=-1
  1. F I="E","P","K","S","N" S J=$O(^INTHU("ASP",I,0,0)) D:J
  1. . Q:'$D(^INTHU(J,0)) S:+^(0)>T T=+^(0)
  1. Q:T=-1 1
  1. S T=$$CDATF2H^UTDT(T),T2=$P(T,",",2),T=+T
  1. S H=$H,H2=$P(H,",",2),H=+H
  1. S D=$S(H2>T2:H-T*86640+H2-T2,1:H-T-1*86640+T2-H2)\60
  1. Q D'>CT
  1. ;
  1. MESS(IND0) ;Display message text with entry #IND0
  1. N INJ,INMS,INMSA
  1. Q:$G(DUOUT)!'$G(IND0) Q:'$D(^INTHU(IND0)) Q:'$O(^INTHU(IND0,3,0))
  1. D T^DIWW Q:$G(DUOUT)
  1. W "MESSAGE TEXT:"
  1. S INMS="INMSA"
  1. D ONE^INHUT9("^INTHU("_IND0_",3,0)",.INMS,IOM,3,"|CR|")
  1. S INJ=0 F D T^DIWW Q:$G(DUOUT) S INJ=$O(@INMS@(INJ)) Q:'INJ W @INMS@(INJ)
  1. K @INMS
  1. Q
  1. ;
  1. CR() ;Press return to continue
  1. W ! D ^UTSRD("Press <RETURN> to continue: ")
  1. Q ""
  1. ;
  1. ERRMSG() ;Returns latest error message
  1. N X,Y S X=1 S Y=$$GETERR^%ZTOS S:Y="" Y="No error message."
  1. Q Y
  1. ;
  1. TXTPTR(DIC,X,Y) ;Input transform for free-text pointers
  1. ;INPUT:
  1. ; DIC - file reference
  1. ; X - user input (dot pass)
  1. ; Y - dot pass
  1. ;
  1. ;OUTPUT:
  1. ; X - .01 field from the file
  1. ; Y - standard Y array from DIC
  1. ;
  1. N D,DIX,DS,DZ K Y Q:'$D(X) S DIC(0)="EQZM" D ^DIC I Y<0 K X Q
  1. S X=$P(Y(0),U,1),DWVOY=X
  1. Q
  1. ;
  1. TXTHLP(DIC) ;Executable help for free-text pointers
  1. ;INPUT:
  1. ; DIC - file reference
  1. ;
  1. N D,DIX,DS,DZ,Y,X S DIC(0)="E",X="??" D ^DIC
  1. Q
  1. ;