XINDX7 ;ISC/RWF - SETUP ENVITOMENT ;04/22/08 15:12
;;7.3;TOOLKIT;**20,27,48,68,110,140,148**;Apr 25, 1995;Build 3
; Per VHA Directive 2004-038, this routine should not be modified.
;To call XINDEX from elsewere.
;D SETUP^XINDX7 then load routines into ^UTILITY($J,1,<rtn name>,0,n,0)
;with @root@(0)='line count' and @root@(n,0)=a routine line
;Then for each routine S RTN="rtn name",INDLC=0 D BEG^XINDEX
;
Q
SETUP ;Write startup header stuff.
D BUILD
U IO D HDR
S Q="""",U="^",INDDS=0,RTN="$",DA=INDDA,IND("TM")=$H
I INDDA>0 D START^XINDX10 D:IOSL\2<$Y HDR W !!,"Routines are being processed.",!
;Build count of routines.
S NRO=0,NRO(1)=0,RTN="$"
F S RTN=$O(^UTILITY($J,RTN)) Q:RTN="" S NRO=NRO+1 S:RTN["|" NRO(1)=NRO(1)+1
S RTN="$"
W "Routines: ",NRO-NRO(1)," Faux Routines: ",NRO(1),!!
Q
HDR S:'$D(INDXDT) DT=$$DT^XLFDT(),INDXDT=$$HTE^XLFDT($H)
I '$D(INDHDR) D
. X ^%ZOSF("UCI") S INDHDR(1)="UCI: "_$P(Y,",")_" CPU: "_^%ZOSF("VOL")_" "_INDXDT
. S INDHDR="V. A. C R O S S R E F E R E N C E R "_$P($T(+2),";",3)
. S INDHDR(2)="[5/5/2016 VA Standards & Conventions]"
. Q
W:$Y>3 @IOF W !!,?IOM-$L(INDHDR)\2,INDHDR,!,?IOM-$L(INDHDR(2))\2,INDHDR(2),!,?IOM-$L(INDHDR(1))\2,INDHDR(1),!
Q
BUILD N IX,X,TAG,TG,TX,S,L,V K IND
F TAG=1:1 S X=$T(TABLE+TAG) Q:X="" D
. S TG=$P(X,";;",2),TX=$P(X,";;",3) Q:TG=""
. F IX=1:1 S X=$P(TX,":",IX) Q:X="" D
. . S S=$P(X,","),L=$P(X,",",2),V=$P(X,",",3)
. . S IND(TG,S)=L_"^"_V,IND(TG,L)=L_"^"_V
. Q
Q
;p148 change $Q to 2 max # parameters
TABLE ;;Short name, Full name, parameters (CMD default - add to GRB), FNC: function^min # parameters ; max # parameters
CMD ;;CMD;;B,BREAK,B:C,CLOSE,C:D,DO,DG1^XINDX4:E,ELSE,:F,FOR,F:G,GOTO,G:H,HALT,H:H,HANG,H:I,IF,:J,JOB,J:K,KILL,K:L,LOCK,L
;;CMD;;M,MERGE,M:N,NEW,N:O,OPEN,O:Q,QUIT,Q:R,READ,R:S,SET,S:TC,TCOMMIT,TR:TRE,TRESTART,TR:TRO,TROLLBACK,TR:TS,TSTART,TR:U,USE,U:V,VIEW,V:W,WRITE,W:X,XECUTE,X:
;;
FNC ;;FNC;;A,ASCII,1;2:C,CHAR,1;999:D,DATA,1;1:E,EXTRACT,1;3:F,FIND,2;3:G,GET,1;2:I,INCREMENT,1;2:J,JUSTIFY,2;3:L,LENGTH,1;2:O,ORDER,1;2:P,PIECE,2;4:Q,QUERY,1;2:R,RANDOM,1;1:S,SELECT,1;999:T,TEXT,1;1:V,VIEW,1;999,
;;FNC;;FN,FNUMBER,2;3:NA,NAME,1;2:QL,QLENGTH,1;1:QS,QSUBSCRIPT,1;3:RE,REVERSE,1;1:ST,STACK,1;2:TR,TRANSLATE,1;3:WFONT,WFONT,4;4:WTFIT,WTFIT,6;6:WTWIDTH,WTWIDTH,5;5:
;;
SVN ;;SVN;;D,DEVICE:EC,ECODE:ES,ESTACK:ET,ETRAP:H,HOROLOG:I,IO:J,JOB:K,KEY:P,PRINCIPAL:Q,QUIT:S,STORAGE:ST,STACK:SY,SYSTEM:T,TEST:X,X:Y,Y
;;
SSVN ;;SSVN;;C,CHARACTER:D,DEVICE:DI,DISPLAY:E,EVENT:G,GLOBAL:J,JOB:L,LOCK:R,ROUTINE:S,SYSTEM:W,WINDOW:Z,Z
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXINDX7 2633 printed Apr 09, 2024@21:42:54 Page 2
XINDX7 ;ISC/RWF - SETUP ENVIRONMENT ;2018-02-22 12:54 PM
+1 ;;7.3;TOOLKIT;**20,27,48,68,110,10001**;Apr 25, 1995;Build 4
+2 ; Routine originally authored by Department of Veterans Affairs
+3 ; HDR+3 updated by Sam Habiel to update SAC Version number
+4 ; SVN updated by George Timson to remove PDISPLAY
+5 ;To call XINDEX from elsewere.
+6 ;D SETUP^XINDX7 then load routines into ^UTILITY($J,1,<rtn name>,0,n,0)
+7 ;with @root@(0)='line count' and @root@(n,0)=a routine line
+8 ;Then for each routine S RTN="rtn name",INDLC=0 D BEG^XINDEX
+9 ;
+10 ;
+11 QUIT
SETUP ;Write startup header stuff.
+1 DO BUILD
+2 USE IO
DO HDR
+3 SET Q=""""
SET U="^"
SET INDDS=0
SET RTN="$"
SET DA=INDDA
SET IND("TM")=$HOROLOG
+4 IF INDDA>0
DO START^XINDX10
if IOSL\2<$Y
DO HDR
WRITE !!,"Routines are being processed.",!
+5 ;Build count of routines.
+6 SET NRO=0
SET NRO(1)=0
SET RTN="$"
+7 FOR
SET RTN=$ORDER(^UTILITY($JOB,RTN))
if RTN=""
QUIT
SET NRO=NRO+1
if RTN["|"
SET NRO(1)=NRO(1)+1
+8 SET RTN="$"
+9 WRITE "Routines: ",NRO-NRO(1)," Faux Routines: ",NRO(1),!!
+10 QUIT
HDR if '$DATA(INDXDT)
SET DT=$$DT^XLFDT()
SET INDXDT=$$HTE^XLFDT($HOROLOG)
+1 IF '$DATA(INDHDR)
Begin DoDot:1
+2 XECUTE ^%ZOSF("UCI")
SET INDHDR(1)="UCI: "_$PIECE(Y,",")_" CPU: "_^%ZOSF("VOL")_" "_INDXDT
+3 SET INDHDR="V. A. C R O S S R E F E R E N C E R "_$PIECE($TEXT(+2),";",3)
+4 ; **SMH date updated
SET INDHDR(2)="[5/5/2016 VA Standards & Conventions]"
+5 QUIT
End DoDot:1
+6 if $Y>3
WRITE @IOF
WRITE !!,?IOM-$LENGTH(INDHDR)\2,INDHDR,!,?IOM-$LENGTH(INDHDR(2))\2,INDHDR(2),!,?IOM-$LENGTH(INDHDR(1))\2,INDHDR(1),!
+7 QUIT
BUILD NEW IX,X,TAG,TG,TX,S,L,V
KILL IND
+1 FOR TAG=1:1
SET X=$TEXT(TABLE+TAG)
if X=""
QUIT
Begin DoDot:1
+2 SET TG=$PIECE(X,";;",2)
SET TX=$PIECE(X,";;",3)
if TG=""
QUIT
+3 FOR IX=1:1
SET X=$PIECE(TX,":",IX)
if X=""
QUIT
Begin DoDot:2
+4 SET S=$PIECE(X,",")
SET L=$PIECE(X,",",2)
SET V=$PIECE(X,",",3)
+5 SET IND(TG,S)=L_"^"_V
SET IND(TG,L)=L_"^"_V
End DoDot:2
+6 QUIT
End DoDot:1
+7 QUIT
TABLE ;;Short name, Full name, parameters (CMD default - add to GRB)
CMD ;;CMD;;B,BREAK,B:C,CLOSE,C:D,DO,DG1^XINDX4:E,ELSE,:F,FOR,F:G,GOTO,G:H,HALT,H:H,HANG,H:I,IF,:J,JOB,J:K,KILL,K:L,LOCK,L
+1 ;;CMD;;M,MERGE,M:N,NEW,N:O,OPEN,O:Q,QUIT,Q:R,READ,R:S,SET,S:TC,TCOMMIT,TR:TRE,TRESTART,TR:TRO,TROLLBACK,TR:TS,TSTART,TR:U,USE,U:V,VIEW,V:W,WRITE,W:X,XECUTE,X:
+2 ;;
FNC ;;FNC;;A,ASCII,1;2:C,CHAR,1;999:D,DATA,1;1:E,EXTRACT,1;3:F,FIND,2;3:G,GET,1;2:J,JUSTIFY,2;3:L,LENGTH,1;2:O,ORDER,1;2:P,PIECE,2;4:Q,QUERY,1;1:R,RANDOM,1;1:S,SELECT,1;999:T,TEXT,1;1:V,VIEW,1;999,
+1 ;;FNC;;FN,FNUMBER,2;3:NA,NAME,1;2:QL,QLENGTH,1;1:QS,QSUBSCRIPT,1;3:RE,REVERSE,1;1:ST,STACK,1;2:TR,TRANSLATE,1;3:WFONT,WFONT,4;4:WTFIT,WTFIT,6;6:WTWIDTH,WTWIDTH,5;5:
+2 ;;
SVN ;;SVN;;D,DEVICE:EC,ECODE:ES,ESTACK:ET,ETRAP:H,HOROLOG:I,IO:J,JOB:K,KEY:P,PRINCIPAL:Q,QUIT:S,STORAGE:ST,STACK:SY,SYSTEM:T,TEST:X,X:Y,Y
+1 ;;
SSVN ;;SSVN;;C,CHARACTER:D,DEVICE:DI,DISPLAY:E,EVENT:G,GLOBAL:J,JOB:L,LOCK:R,ROUTINE:S,SYSTEM:W,WINDOW:Z,Z
