XBTM5 ; IHS/ADC/GTH - TECH MANUAL : FIELDS IN THE FILES ; [ 02/07/97 3:02 PM ]
;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
;
NEW A,B,C,I,J
F A=1:1 S X=$P($T(PR+A),";;",2) Q:X="###" D PR(X) Q:$D(DUOUT)
Q:$D(DUOUT)
D ^DIWW
KILL ^TMP("XBTM-FIF",$J)
S DIWF="WN"
D PR($J("",5)_"These are the files in the package:")
Q:$D(DUOUT)
D ALPHA
D PR($J("",5)),PR($J("",5)),PR($J("",5)_"These are the alphabetized fields in the files :")
Q:$D(DUOUT)
S DIWF="W",(A,B,I,J)=""
F S A=$O(^TMP("XBTM-FIF",$J,A)) Q:A="" S B=$O(^(A,0)),I=$O(^(B,0)) D Q:$D(DUOUT)
. D PR(A_$E($J("",40),1,(40-$L(A)))_B_$E($J("",12),1,(12-$L(B)))_I),^DIWW
. S J=J+1
.Q
Q:$D(DUOUT)
D PR($J("",5)),PR($J("",5)),PR($J("",3)_"There are "_+J_" fields in the package files.")
Q:$D(DUOUT)
D ^DIWW
Q
;
PR(X) NEW %,A,B,C,I,J D PR^XBTM(X) Q
;;No files are distributed with this package. Any fields listed,
;;below, will have been created locally. The list will be
;;an alphabetical list of fields in the package's files.
;;|SETTAB("C")||TAB|
;;|SETTAB("C")||TAB|
;;###
;
ALPHA ;
NEW XBFLD,XBPIEN
S XBPIEN=$O(^DIC(9.4,"C","XB",0))
S %=0
F S %=$O(^DIC(9.4,XBPIEN,4,"B",%)) Q:'% D PR(%_$E(" ",1,(12-$L(%)))_$O(^DD(%,0,"NM",""))) Q:$D(DUOUT) D FLD
Q
;
FLD ;
S XBFLD=0
F S XBFLD=$O(^DD(%,XBFLD)) Q:'XBFLD D
.I +$P(^DD(%,XBFLD,0),U,2) S XB=+$P(^(0),U,2) D Q
..NEW %,XBFLD
..S %=XB
..D FLD
..Q
.S ^TMP("XBTM-FIF",$J,$P(^DD(%,XBFLD,0),U),%,XBFLD)=""
.Q
Q
;
XBTM5 ; IHS/ADC/GTH - TECH MANUAL : FIELDS IN THE FILES ; [ 02/07/97 3:02 PM ]
+1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
+2 ;
+3 NEW A,B,C,I,J
+4 FOR A=1:1
SET X=$PIECE($TEXT(PR+A),";;",2)
IF X="###"
QUIT
DO PR(X)
IF $DATA(DUOUT)
QUIT
+5 IF $DATA(DUOUT)
QUIT
+6 DO ^DIWW
+7 KILL ^TMP("XBTM-FIF",$JOB)
+8 SET DIWF="WN"
+9 DO PR($JUSTIFY("",5)_"These are the files in the package:")
+10 IF $DATA(DUOUT)
QUIT
+11 DO ALPHA
+12 DO PR($JUSTIFY("",5))
DO PR($JUSTIFY("",5))
DO PR($JUSTIFY("",5)_"These are the alphabetized fields in the files :")
+13 IF $DATA(DUOUT)
QUIT
+14 SET DIWF="W"
SET (A,B,I,J)=""
+15 FOR
SET A=$ORDER(^TMP("XBTM-FIF",$JOB,A))
IF A=""
QUIT
SET B=$ORDER(^(A,0))
SET I=$ORDER(^(B,0))
Begin DoDot:1
+16 DO PR(A_$EXTRACT($JUSTIFY("",40),1,(40-$LENGTH(A)))_B_$EXTRACT($JUSTIFY("",12),1,(12-$LENGTH(B)))_I)
DO ^DIWW
+17 SET J=J+1
+18 QUIT
End DoDot:1
IF $DATA(DUOUT)
QUIT
+19 IF $DATA(DUOUT)
QUIT
+20 DO PR($JUSTIFY("",5))
DO PR($JUSTIFY("",5))
DO PR($JUSTIFY("",3)_"There are "_+J_" fields in the package files.")
+21 IF $DATA(DUOUT)
QUIT
+22 DO ^DIWW
+23 QUIT
+24 ;
PR(X) NEW %,A,B,C,I,J
DO PR^XBTM(X)
QUIT
+1 ;;No files are distributed with this package. Any fields listed,
+2 ;;below, will have been created locally. The list will be
+3 ;;an alphabetical list of fields in the package's files.
+4 ;;|SETTAB("C")||TAB|
+5 ;;|SETTAB("C")||TAB|
+6 ;;###
+7 ;
ALPHA ;
+1 NEW XBFLD,XBPIEN
+2 SET XBPIEN=$ORDER(^DIC(9.4,"C","XB",0))
+3 SET %=0
+4 FOR
SET %=$ORDER(^DIC(9.4,XBPIEN,4,"B",%))
IF '%
QUIT
DO PR(%_$EXTRACT(" ",1,(12-$LENGTH(%)))_$ORDER(^DD(%,0,"NM","")))
IF $DATA(DUOUT)
QUIT
DO FLD
+5 QUIT
+6 ;
FLD ;
+1 SET XBFLD=0
+2 FOR
SET XBFLD=$ORDER(^DD(%,XBFLD))
IF 'XBFLD
QUIT
Begin DoDot:1
+3 IF +$PIECE(^DD(%,XBFLD,0),U,2)
SET XB=+$PIECE(^(0),U,2)
Begin DoDot:2
+4 NEW %,XBFLD
+5 SET %=XB
+6 DO FLD
+7 QUIT
End DoDot:2
QUIT
+8 SET ^TMP("XBTM-FIF",$JOB,$PIECE(^DD(%,XBFLD,0),U),%,XBFLD)=""
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
