- 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 ;