INHU1.m

INHU1 ;JSH; 6 May 98 09:15;GIS utilities - cont'd

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;COPYRIGHT 1991-2000 SAIC

 ;

CUR() ;Currency report

 ;Returns a 1 if current, 0 if not current, -1 if unknown

 N CT,I,J,T

 S CT=$P(^INRHSITE(1,0),U,13) Q:'CT -1

 S T=-1

 F I="E","P","K","S","N" S J=$O(^INTHU("ASP",I,0,0)) D:J

 . Q:'$D(^INTHU(J,0))  S:+^(0)>T T=+^(0)

 Q:T=-1 1

 S T=$$CDATF2H^UTDT(T),T2=$P(T,",",2),T=+T

 S H=$H,H2=$P(H,",",2),H=+H

 S D=$S(H2>T2:H-T*86640+H2-T2,1:H-T-1*86640+T2-H2)\60

 Q D'>CT

 ;

MESS(IND0) ;Display message text with entry #IND0

 N INJ,INMS,INMSA

 Q:$G(DUOUT)!'$G(IND0)  Q:'$D(^INTHU(IND0))  Q:'$O(^INTHU(IND0,3,0))

 D T^DIWW Q:$G(DUOUT)

 W "MESSAGE TEXT:"

 S INMS="INMSA"

 D ONE^INHUT9("^INTHU("_IND0_",3,0)",.INMS,IOM,3,"|CR|")

 S INJ=0 F   D T^DIWW Q:$G(DUOUT)  S INJ=$O(@INMS@(INJ)) Q:'INJ  W @INMS@(INJ)

 K @INMS

 Q

 ;

CR() ;Press return to continue

 W ! D ^UTSRD("Press <RETURN> to continue: ")

 Q ""

 ;

ERRMSG() ;Returns latest error message

 N X,Y S X=1 S Y=$$GETERR^%ZTOS S:Y="" Y="No error message."

 Q Y

 ;

TXTPTR(DIC,X,Y) ;Input transform for free-text pointers

 ;INPUT:

 ;   DIC      - file reference

 ;   X        - user input (dot pass)

 ;   Y        - dot pass

 ;

 ;OUTPUT:

 ;   X        - .01 field from the file

 ;   Y        -  standard Y array from DIC

 ;

 N D,DIX,DS,DZ K Y Q:'$D(X)  S DIC(0)="EQZM" D ^DIC I Y<0 K X Q

 S X=$P(Y(0),U,1),DWVOY=X

 Q

 ;

TXTHLP(DIC) ;Executable help for free-text pointers

 ;INPUT:

 ;  DIC     - file reference

 ;

 N D,DIX,DS,DZ,Y,X S DIC(0)="E",X="??" D ^DIC

 Q

 ;

INHU1     ;JSH; 6 May 98 09:15;GIS utilities - cont'd

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3       ;

CUR()     ;Currency report

 +1       ;Returns a 1 if current, 0 if not current, -1 if unknown

 +2        NEW CT,I,J,T

 +3        SET CT=$PIECE(^INRHSITE(1,0),U,13)

           IF 'CT

               QUIT -1

 +4        SET T=-1

 +5        FOR I="E","P","K","S","N"

               SET J=$ORDER(^INTHU("ASP",I,0,0))

               IF J

                   Begin DoDot:1

 +6                    IF '$DATA(^INTHU(J,0))

                           QUIT 

                       IF +^(0)>T

                           SET T=+^(0)

                   End DoDot:1

 +7        IF T=-1

               QUIT 1

 +8        SET T=$$CDATF2H^UTDT(T)

           SET T2=$PIECE(T,",",2)

           SET T=+T

 +9        SET H=$HOROLOG

           SET H2=$PIECE(H,",",2)

           SET H=+H

 +10       SET D=$SELECT(H2>T2:H-T*86640+H2-T2,1:H-T-1*86640+T2-H2)\60

 +11       QUIT D'>CT

 +12      ;

MESS(IND0) ;Display message text with entry #IND0

 +1        NEW INJ,INMS,INMSA

 +2        IF $GET(DUOUT)!'$GET(IND0)

               QUIT 

           IF '$DATA(^INTHU(IND0))

               QUIT 

           IF '$ORDER(^INTHU(IND0,3,0))

               QUIT 

 +3        DO T^DIWW

           IF $GET(DUOUT)

               QUIT 

 +4        WRITE "MESSAGE TEXT:"

 +5        SET INMS="INMSA"

 +6        DO ONE^INHUT9("^INTHU("_IND0_",3,0)",.INMS,IOM,3,"|CR|")

 +7        SET INJ=0

           FOR 

               DO T^DIWW

               IF $GET(DUOUT)

                   QUIT 

               SET INJ=$ORDER(@INMS@(INJ))

               IF 'INJ

                   QUIT 

               WRITE @INMS@(INJ)

 +8        KILL @INMS

 +9        QUIT 

 +10      ;

CR()      ;Press return to continue

 +1        WRITE !

           DO ^UTSRD("Press <RETURN> to continue: ")

 +2        QUIT ""

 +3       ;

ERRMSG()  ;Returns latest error message

 +1        NEW X,Y

           SET X=1

           SET Y=$$GETERR^%ZTOS

           IF Y=""

               SET Y="No error message."

 +2        QUIT Y

 +3       ;

TXTPTR(DIC,X,Y) ;Input transform for free-text pointers

 +1       ;INPUT:

 +2       ;   DIC      - file reference

 +3       ;   X        - user input (dot pass)

 +4       ;   Y        - dot pass

 +5       ;

 +6       ;OUTPUT:

 +7       ;   X        - .01 field from the file

 +8       ;   Y        -  standard Y array from DIC

 +9       ;

 +10       NEW D,DIX,DS,DZ

           KILL Y

           IF '$DATA(X)

               QUIT 

           SET DIC(0)="EQZM"

           DO ^DIC

           IF Y<0

               KILL X

               QUIT 

 +11       SET X=$PIECE(Y(0),U,1)

           SET DWVOY=X

 +12       QUIT 

 +13      ;

TXTHLP(DIC) ;Executable help for free-text pointers

 +1       ;INPUT:

 +2       ;  DIC     - file reference

 +3       ;

 +4        NEW D,DIX,DS,DZ,Y,X

           SET DIC(0)="E"

           SET X="??"

           DO ^DIC

 +5        QUIT 

 +6       ;