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