Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMQQEM3

AMQQEM3.m

Go to the documentation of this file. 
  1. AMQQEM3 ; IHS/CMI/THL - FINE TUNES THE HEADER LINE ;
  1.  ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1.  ;-----
  1.  I 'Y Q
  1.  S AMQQEMN=Y,AMQQEM3=0
  1.  N Y
  1.  I '$D(AMQQEM("FIX")) N AMQQFLEN D FLEN^AMQQEM31 I $D(AMQQQUIT) Q
  1.  I $D(AMQQSTOP) G EXIT
  1. RUN F AMQQEM3=1:1:5 D @$P("LIST^DATE^TYPE^TUNE^LIST",U,AMQQEM3) I $D(AMQQQUIT)!($G(AMQQEMFN)>98)!($D(AMQQSTOP)) Q
  1. EXIT I $D(AMQQSTOP) W *7 S AMQQEMFS=$P(AMQQEMFS,U,1,$L(AMQQEMFS,U)-2)_U K AMQQSTOP,@G@(AMQQEMN) D LIST
  1.  K AMQQEM3,AMQQEMAX,AMQQEMP,DIRUT,DIROUT,DUOUT,DTOUT
  1.  Q
  1.  ;
  1. LIST ; - EP -
  1.  N T K H
  1.  I AMQQEMFS="" Q
  1.  S J=1
  1.  S (I,N)=0
  1.  S H(1)=""
  1.  S T=0
  1.  F AMQQEMFN=1:1 S A=$P(AMQQEMFS,U,AMQQEMFN) Q:A=""  D
  1.  .S X=$P(@G@(A,0),U,6)
  1.  .S Y=$P(@G@(A,0),U,7)
  1.  .I 'Y,A=$G(AMQQEMN),$D(AMQQFLEN) S Y=AMQQFLEN
  1.  .I 'Y,$G(AMQQEM("FIX")) S Y=AMQQEM("FIX"),$P(@G@(A,0),U,7)=AMQQEM("FIX")
  1.  .I '$D(AMQQEM("FIX")) S Y=Y+1 ; ADD 1 SPACE FOR THE DELIMITER
  1.  .S X=$E(X,1,Y)
  1.  .S Z=""
  1.  .S $P(Z," ",((Y+1)-$L(X)))=""
  1.  .S T=T+Y
  1.  .I (Y+N)>78 S:AMQQEMFN>1 J=J+1 S N=0,H(J)=""
  1.  .S I=I+1
  1.  .S N=N+Y
  1.  .S H(J)=H(J)_X_Z_";"_Y_";"_$C(64+I)_U
  1.  I AMQQEMFN<99 D DISP
  1.  Q
  1.  ;
  1. DISP N A,D,I,X,Y,Z,%,J,N,K,T S (T,K)=0
  1.  S D=$G(AMQQEM("DEL"))
  1.  S:D="TAB" D="t"
  1.  S:D="UP ARROW" D=U
  1.  W @IOF
  1.  F J=1:1 Q:'$D(H(J))  S N=0 W:J>1 ! D
  1.  .F I=1:1 S X=$P(H(J),U,I) Q:X=""  W $P(X,";") S N=N+$P(X,";",2)
  1.  .W !
  1.  .F I=1:1 S X=$P(H(J),U,I) Q:X=""  S K=K+1,Y=$P(X,";",2),T=T+Y,Z=$P(X,";",3) S:$P(AMQQEMFS,U,K)=AMQQEMN&(AMQQEM3'=5) Z=U S %="",$P(%,Z,Y+$D(AMQQEM("FIX")))="" W %,D
  1.  .I $D(H(J+1)) Q
  1.  .S A=78-N
  1.  .S:N>78 A=78-(N#78)
  1.  .S:(AMQQEM("LEN")-T)<A A=AMQQEM("LEN")-T
  1.  .S %=""
  1.  .S $P(%,".",A+1)=""
  1.  .W %
  1.  .W:(AMQQEM("LEN")-T)>A ">"
  1.  S %=""
  1.  S $P(%,"-",78)=""
  1.  W !,%
  1.  Q
  1.  ;
  1. TUNE I $D(AMQQEMKL) D T21 W !!,"This field cancelled..." H 2 K AMQQEMKL Q
  1.  W @IOF
  1.  D LIST
  1.  W !
  1.  S %=$P(@G@(AMQQEMN,0),U,6)
  1.  I %="" S %=$P(^(0),U,3)
  1.  W "Edit field/variable = """,%,""""
  1.  S DIR(0)="SO^0:NO ADDITIONAL CHANGES;1:DATA TYPE;2:DELETE;3:MOVE;4:RENAME;5:TRANSFORM (MUMPS code, programmers only)"
  1.  S DIR(0)=DIR(0)_";6:"_$S($D(AMQQEM("FIX")):"WIDTH OF FIELD",1:"SUBSTITUTE DELIMITER CHARACTER")
  1.  S DIR(0)=DIR(0)_";7:PUT VALUE IN QUOTES"
  1.  I '$D(AMQQEM("FIX")) S DIR(0)=DIR(0)_";8:CHANGE FIELD WIDTH"
  1.  S DIR("A")="     Your choice"
  1.  S DIR("B")="NO ADDITIONAL CHANGES"
  1.  D ^DIR
  1.  K DIR
  1.  S:$D(DUOUT) DIRUT=1
  1.  I Y?1."^" S AMQQQUIT="" Q
  1.  I 'Y Q
  1.  I Y=2 D T2 Q
  1.  I Y=8 S Y=9
  1.  I Y=7 S Y=8
  1.  I Y=6,'$D(AMQQEM("FIX")) S Y=7
  1.  D MARK^AMQQEMAN,@("T"_Y)
  1.  I $D(AMQQQUIT) Q
  1.  D LIST
  1.  G TUNE
  1.  Q
  1.  ;
  1. DATE I $P(@G@(AMQQEMN,0),U,4)="D",'$D(AMQQEM("DATE TRANS")) K DIR D  Q
  1.  .D ^AMQQEM21
  1.  .I $D(AMQQQUIT) Q
  1.  .I $D(AMQQEMNO) K AMQQEMNO S AMQQEMKL="" Q
  1.  .F %=0:0 S %=$O(@G@(%)) Q:'%  I $P(^(%,0),U,4)="D" S ^(2)=AMQQEM("DATE TRANS")
  1.  D MARK^AMQQEMAN
  1.  Q
  1.  ;
  1. TYPE I $G(AMQQEM("DATA"))'=2!($D(AMQQEMKL)) Q
  1.  W "DATA TYPE",!
  1. TYPE1 S %=$P(@G@(AMQQEMN,0),U,4)
  1.  S DIR("B")=$S(%="D":"D",%="N":"N",1:"F")
  1.  S DIR(0)="S^N:NUMBER;D:DATE;F:FREE TEXT;M:MONEY($dollars.cents)"
  1.  S DIR("A")="Data type"
  1.  D ^DIR
  1.  K DIR
  1.  S:$D(DUOUT) DIRUT=1
  1.  I X?1."^" S AMQQQUIT="" Q
  1.  S $P(@G@(AMQQEMN,0),U,4)=Y
  1.  Q
  1.  ;
  1. T1 W "VIEW/EDIT DATA TYPE",!
  1.  D TYPE1
  1.  Q
  1.  ;
  1. T2 W "DELETE",!
  1.  S DIR(0)="YO",DIR("A")="Are you sure that you want to delete this segment"
  1.  D ^DIR
  1.  K DIR
  1.  S:$D(DUOUT) DIRUT=1
  1.  I X?1."^" S AMQQQUIT="" Q
  1.  I 'Y Q
  1. T21 F %=1:1 S X=$P(AMQQEMFS,U,%) Q:X=""  I X=AMQQEMN S AMQQEMFS=$P(AMQQEMFS,U,1,%-1)_U_$P(AMQQEMFS,U,%+1,99) S:$P(AMQQEMFS,U)="" AMQQEMFS=$P(AMQQEMFS,U,2,99) Q
  1.  I AMQQEMFS="" W @IOF
  1.  Q
  1.  ;
  1. T3 W "MOVE",!
  1.  I $L(AMQQEMFS,U)=2 W *7,"Whoops, you have only defined one segment.  Request denied..." H 3 Q
  1.  S X=0
  1.  F %=1:1 S Y=$P(AMQQEMFS,U,%) Q:Y=""  I Y S X=X+1 I Y=AMQQEMN S AMQQEMP=%
  1.  S %(1)=$S(AMQQEMP=1:"B",1:"A")
  1.  S %(2)=$S(AMQQEMP=X:$C(64+X-1),1:$C(64+X))
  1.  S AMQQEMAX=X
  1.  I 'X W "  ??",*7 Q
  1.  I X=2 S AMQQEMFS=$P(AMQQEMFS,U,2)_U_$P(AMQQEMFS,U)_U Q
  1.  S DIR("B")="("_%(1)_"-"_%(2)_")"
  1.  S DIR(0)="FO^:"
  1.  S DIR("A")="Move to which segment"
  1.  D ^DIR
  1.  K DIR
  1.  S:$D(DUOUT) DIRUT=1
  1.  I "^"[X Q
  1.  I X?2."^" S AMQQQUIT="" Q
  1.  I X'?1U W "  ??",*7 D MARK^AMQQEMAN G T3
  1.  I ($A(X)-64)>AMQQEMAX W "  ??",*7 G T3
  1.  I $P(AMQQEMFS,U,$A(X)-64)=AMQQEMN W "  ??",*7 G T3
  1.  S Z=$P(AMQQEMFS,U,AMQQEMP)
  1.  S $P(AMQQEMFS,U,AMQQEMP)=""
  1.  I $E(AMQQEMFS)=U S AMQQEMFS=$E(AMQQEMFS,2,999)
  1.  I AMQQEMFS["^^" S AMQQEMFS=$P(AMQQEMFS,"^^")_U_$P(AMQQEMFS,"^^",2)
  1.  S $P(AMQQEMFS,U,$A(X)-64)=Z_U_$P(AMQQEMFS,U,$A(X)-64)
  1.  Q
  1.  ;
  1. T4 W "RENAME FIELD",!
  1.  I $P(@G@(AMQQEMN,0),U,6)="" S $P(^(0),U,6)=$P(^(0),U,3) W "Current field name: ",$P(^(0),U,6)
  1.  S DIR(0)="FO^1:"_AMQQEM("HLEN")
  1.  S DIR("A")="Enter new name"
  1.  D ^DIR
  1.  K DIR
  1.  S:$D(DUOUT) DIRUT=1
  1.  I "^"[X Q
  1.  I "^^"=X S AMQQQUIT="" Q
  1.  S $P(@G@(AMQQEMN,0),U,6)=Y
  1.  Q
  1.  ;
  1. T5 D T5^AMQQEM31
  1.  Q
  1.  ;
  1. T6 D T6^AMQQEM31
  1.  Q
  1.  ;
  1. T7 D T7^AMQQEM31
  1.  Q
  1.  ;
  1. T8 D T8^AMQQEM31
  1.  Q
  1.  ;
  1. T9 D T6^AMQQEM31
  1.  Q
  1.  ;