TIUUPEDT ; SLC/JER - Upload Parameter Edit ;4/23/93 14:53
;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
MAIN ; Controls branching
N DIC,DA,DIE,DLAYGO,DR,TIUPRM0,TIUPRM1,TIUPRM3,TIUUSRC,TIU1ST,X,Y
N TIUQUIT
D:'$D(TIUPRM0) SETPARM^TIULE
W !,"First edit Institution-wide upload parameters:",!
S (DIC,DLAYGO)=8925.99,DIC(0)="AEMQL",DIC("A")="Select INSTITUTION: "
D ^DIC K DLAYGO Q:+Y'>0 S DA=+Y
S DIE=8925.99,DR="[TIU UPLOAD PARAMETER EDIT]"
D ^DIE
D SETPARM^TIULE
W !,"Now edit the DOCUMENT DEFINITION file:"
F D Q:+$G(TIUQUIT)
. N TIUREP,TIUX,X,Y,DA,DIE,DR
. S Y=$$ASKTYP^TIULA2(38,"LAST","I $P(^TIU(8925.1,+Y,0),U,4)'=""O""","DOCUMENT DEFINITION: ")
. I +Y'>0 S TIUQUIT=1 Q
. S DA=+Y,TIUREP=+Y_U_$$PNAME^TIULC1(+DA)
. S TIUREP(0)=$G(^TIU(8925.1,+DA,0))
. S DIE="^TIU(8925.1,",DR="[TIU UPLOAD FIELD EDIT]"
. D ^DIE S Y=1
. I $D(^TIU(8925.1,+DA,"HEAD"))>9!($D(^TIU(8925.1,+DA,"ITEM"))>9) D
. . W !!,"The header for the ",$P(TIUREP,U,2)," ",$$DDH(TIUREP(0))," is now defined as:"
. . I $P(TIUPRM0,U,16)="D" D DHDR^TIUTHLP(.TIUREP,TIUPRM0,TIUPRM1)
. . I $P(TIUPRM0,U,16)="C" D CHDR^TIUTHLP(.TIUREP,TIUPRM0,TIUPRM1)
. . W !
Q
DDH(TIUDDEF) ; Translate position in DDH
N TIUY
S TIUY=$S($P(TIUDDEF,U,4)="DOC":"TITLE",$P(TIUDDEF,U,4)="DC":"DOCUMENT CLASS",$P(TIUDDEF,U,4)="CL":"CLASS",1:"Document Definition")
Q TIUY
TXTFLD(TFILE,TIUFLT) ; Get Text Field # from ^DD(Target file #,
N DIC,X,Y
S DIC="^DD("_TFILE_",",DIC(0)="AEMQZ",DIC("A")="Select TARGET TEXT FIELD: "
S DIC("S")="I +$$ISWP^TIUUPEDT(TFILE,+Y)"
I $D(TIUFLT),(+$G(TIUFLT)>0) S DIC("B")=TIUFLT
D ^DIC K DIC("S") G:+Y'>0 TXTFLDX
S Y=+Y_";"_$P($P(Y(0),U,4),";")
TXTFLDX Q Y
ISWP(TFILE,TFLD) ; Is a given field a Word-processing type field
N X,Y S Y=0
I +$P(^DD(TFILE,TFLD,0),U,2)>0 D
. N SFILE S SFILE=+$P(^DD(TFILE,TFLD,0),U,2)
. S Y=$S($P(^DD(SFILE,.01,0),U,2)["W":1,1:0)
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUUPEDT 1919 printed Dec 13, 2024@02:46:22 Page 2
TIUUPEDT ; SLC/JER - Upload Parameter Edit ;4/23/93 14:53
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
MAIN ; Controls branching
+1 NEW DIC,DA,DIE,DLAYGO,DR,TIUPRM0,TIUPRM1,TIUPRM3,TIUUSRC,TIU1ST,X,Y
+2 NEW TIUQUIT
+3 if '$DATA(TIUPRM0)
DO SETPARM^TIULE
+4 WRITE !,"First edit Institution-wide upload parameters:",!
+5 SET (DIC,DLAYGO)=8925.99
SET DIC(0)="AEMQL"
SET DIC("A")="Select INSTITUTION: "
+6 DO ^DIC
KILL DLAYGO
if +Y'>0
QUIT
SET DA=+Y
+7 SET DIE=8925.99
SET DR="[TIU UPLOAD PARAMETER EDIT]"
+8 DO ^DIE
+9 DO SETPARM^TIULE
+10 WRITE !,"Now edit the DOCUMENT DEFINITION file:"
+11 FOR
Begin DoDot:1
+12 NEW TIUREP,TIUX,X,Y,DA,DIE,DR
+13 SET Y=$$ASKTYP^TIULA2(38,"LAST","I $P(^TIU(8925.1,+Y,0),U,4)'=""O""","DOCUMENT DEFINITION: ")
+14 IF +Y'>0
SET TIUQUIT=1
QUIT
+15 SET DA=+Y
SET TIUREP=+Y_U_$$PNAME^TIULC1(+DA)
+16 SET TIUREP(0)=$GET(^TIU(8925.1,+DA,0))
+17 SET DIE="^TIU(8925.1,"
SET DR="[TIU UPLOAD FIELD EDIT]"
+18 DO ^DIE
SET Y=1
+19 IF $DATA(^TIU(8925.1,+DA,"HEAD"))>9!($DATA(^TIU(8925.1,+DA,"ITEM"))>9)
Begin DoDot:2
+20 WRITE !!,"The header for the ",$PIECE(TIUREP,U,2)," ",$$DDH(TIUREP(0))," is now defined as:"
+21 IF $PIECE(TIUPRM0,U,16)="D"
DO DHDR^TIUTHLP(.TIUREP,TIUPRM0,TIUPRM1)
+22 IF $PIECE(TIUPRM0,U,16)="C"
DO CHDR^TIUTHLP(.TIUREP,TIUPRM0,TIUPRM1)
+23 WRITE !
End DoDot:2
End DoDot:1
if +$GET(TIUQUIT)
QUIT
+24 QUIT
DDH(TIUDDEF) ; Translate position in DDH
+1 NEW TIUY
+2 SET TIUY=$SELECT($PIECE(TIUDDEF,U,4)="DOC":"TITLE",$PIECE(TIUDDEF,U,4)="DC":"DOCUMENT CLASS",$PIECE(TIUDDEF,U,4)="CL":"CLASS",1:"Document Definition")
+3 QUIT TIUY
TXTFLD(TFILE,TIUFLT) ; Get Text Field # from ^DD(Target file #,
+1 NEW DIC,X,Y
+2 SET DIC="^DD("_TFILE_","
SET DIC(0)="AEMQZ"
SET DIC("A")="Select TARGET TEXT FIELD: "
+3 SET DIC("S")="I +$$ISWP^TIUUPEDT(TFILE,+Y)"
+4 IF $DATA(TIUFLT)
IF (+$GET(TIUFLT)>0)
SET DIC("B")=TIUFLT
+5 DO ^DIC
KILL DIC("S")
if +Y'>0
GOTO TXTFLDX
+6 SET Y=+Y_";"_$PIECE($PIECE(Y(0),U,4),";")
TXTFLDX QUIT Y
ISWP(TFILE,TFLD) ; Is a given field a Word-processing type field
+1 NEW X,Y
SET Y=0
+2 IF +$PIECE(^DD(TFILE,TFLD,0),U,2)>0
Begin DoDot:1
+3 NEW SFILE
SET SFILE=+$PIECE(^DD(TFILE,TFLD,0),U,2)
+4 SET Y=$SELECT($PIECE(^DD(SFILE,.01,0),U,2)["W":1,1:0)
End DoDot:1
+5 QUIT Y
