- DIP11 ;SFISC/XAK,TKW-GET SORT TEMPLATE ;23JULY2014
- ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- ;;Licensed under the terms of the Apache License, Version 2.0.
- ;
- SCREENTM(Z,D2) ;Z=ZERO NODE OF SORT TEMPLATE; D2 = THERE IS SORT-BY LOGIC
- I $P(Z,U,4)-DL Q 0 ;TEMPLATE MUST BE FOR THIS FILE
- I 'D2&'L D Q $D(Z) ;IN SILENT MODE, DON'T PICK SEARCH OR INQUIRY TYPE IF THERE'S A SORT TYPE OF SAME NAME
- .N NAME,I S NAME=$P(Z,U) F I=0:0 S I=$O(^DIBT("B",NAME,I)) Q:'I I I-Y,$P($G(^DIBT(I,0)),U,4)=DL,$D(^(2)) K Z Q
- I DUZ(0)="@" Q 1
- I D2 Q:'L 1 Q:$P(Z,U,3)="" 1 Q $TR($P(Z,U,3),DUZ(0))'=$P(Z,U,3) ;IF A SORT TEMPLATE, ACCESS CODES MUST MATCH
- I '$P(Z,U,5) Q 1
- I $P(Z,U,5)=DUZ Q 1 ;If a SEARCH or INQUIRY TEMPLATE, USER MUST MATCH
- Q 0
- ;
- TEM ;
- G B^DIP:DJ-1 K DPP,DIC
- S X=$P($E(X,2,99),"]",1),DIC(0)="ZQS"_$E("E",'($D(BY)#2)!''L),DIC="^DIBT(",D="F"_DL
- S DIC("S")="I $$SCREENTM^DIP11(^(0),$D(^(2)))"
- I X?."?" S:X'?1"???" X="??" D IX^DIC S DJ=0 Q
- D ^DIC I Y<0 S DJ=0 Q ;LOOK UP THE SORT TEMPLATE
- EMPTY I '$D(^DIBT(+Y,2)),'$D(^(1)),'$D(^("BY0")) W:'$G(DIQUIET) !,$$EZBLD^DIALOG(1509) S DJ=0 Q ;SORT TEMPLATE HAS NO VALUES
- S DPP(DJ)=DL_"^^'"_$P(Y,U,2)_"' "_$$EZBLD^DIALOG(7099)_"^@'"_P,(DIBT1,X)=+Y,DIBT2=$P(Y(0),U),D=DIC_X_"," K DIC ;*CCO/NI SORT TEMPLATE 'NUMBER'
- I '$D(FLDS),$G(^DIBT(X,"DIPT"))]"" S FLDS="["_^("DIPT")_"]" I L D
- . ;N %,A S %(1)=^("DIPT") D BLD^DIALOG(8030,.%,"","A") W ! F %=0:0 S %=$O(A(%)) Q:'% W A(%),!
- . S L=0 Q ;??
- I $D(^DIBT(X,1)) S DIC=D_1_C,DPP(DJ,"SER")="998^998" D ENT^DIP10(DJ,DIBT1) I $D(^DIBT(X,1)) S Y=1 D
- .F DY=1:1 S Y=$O(^(Y,-1)) S:Y="" Y=-1 S:$O(^(Y)) Y=$O(^(Y)) I $D(^(Y))<9 S DPP(DJ,"IX")=DIC_DI_U_DY,DIBT=X Q
- .Q
- ENDIPT I $G(^DIBT(X,"BY0"))="",'$D(^DIBT(X,2)) Q
- I $G(^DIBT(X,"BY0"))="",$G(^DIBT(X,2,0))="" S %Y="DPP(",%X=D_"2," D %XY^%RCR S DIBTOLD="" D CNVCM G T0
- S D=$G(^DIBT(X,"BY0")) I $P(D,U)]"",$P(D,U,2) D
- . N Y K DISPAR(0) S BY(0)="^"_$P(D,U),L(0)=$P(D,U,2)
- . F D=1:1:(L(0)-1) D
- .. S Y=$G(^DIBT(X,"BY0D",D,0))
- .. I '$D(FR(0,D))#2,$P(Y,U,2)]"" S FR(0,D)=$P(Y,U,2)
- .. I '$D(TO(0,D))#2,$P(Y,U,3)]"" S TO(0,D)=$P(Y,U,3)
- .. I $G(^DIBT(X,"BY0D",D,1))]"" S DISPAR(0,D)=^(1) S:$G(^DIBT(X,"BY0D",D,2))]"" DISPAR(0,D,"OUT")=^(2)
- .. Q
- . N X D EN^DIP10 Q
- ;S DJ=$O(DPP(999),-1)+1
- F D=0:0 S D=$O(^DIBT(X,2,D)) Q:'D D ;GO THRU THE SORT LEVELS OF THE STORED TEMPLATE
- .N A,B,C S DPP(DJ)=$G(^DIBT(X,2,D,0))
- BRINGIN .S A="A" F S A=$O(^DIBT(X,2,D,A)) Q:A="" I A'="SER" S DPP(DJ,A)=^(A) I A["COMPUTED" M DPP(DJ,A)=^(A)
- .F B=1,2,3 F A=0:0 S A=$O(^DIBT(X,2,D,B,A)) Q:'A S C=$G(^(A,0)) D
- ..I B=1 S:$P(C,U)=+C DPP(DJ,+C)=$P(C,U,2) Q
- ..I B=2 S:($P(C,U)=+C)&($P(C,U,2)=+$P(C,U,2)) DPP(DJ,+C,$P(C,U,2))=$P(C,U,3,7)_U_$G(^DIBT(X,2,D,2,A,"RCOD")) Q
- ..I $P(C,U,1)]"",$P(C,U,2)]"" S DPP(DJ,$P(C,U,1),$P(C,U,2))=$G(^DIBT(X,2,D,3,A,"OVF0"))
- ..Q
- .S DJ=DJ+1 Q
- T0 Q:$D(DIBTRPT)
- I $D(DIAR) S DIARU=X ;I '$P(DIARB,U,2) S $P(DIARB,U,2)=DIARU
- F D=0:0 S D=$O(^DIBT(X,3,D)) Q:D="" S DSC(D)=^(D)
- I 'L!($D(DPP(0))&(DUZ(0)'="@"))!$D(^DIBT(X,"CANONIC")) G T1
- S %=$P(^DIBT(X,0),U,6) ;CHECK WRITE ACCESS TO SORT TEMPLATE
- I %]"" F D=1:1:$L(%) I DUZ(0)[$E(%,D)!(DUZ(0)="@") S %="" Q
- I %="",X'<1 S %=$P(Y(0),U,1) D G Q:$D(DIRUT) I %=1 K DIBTOLD G EDT^DIP0
- . N X,Y K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="WANT TO EDIT '"_%_"' TEMPLATE" D ^DIR K DIR
- . S %=Y Q
- ;DON'T WANT TO EDIT
- T1 F DJ=$G(DPP(0))+1:1 Q:'$D(DPP(DJ)) D I '$D(DJ)!($D(DTOUT))!($D(DIRUT)) G Q
- . N DL,DU,DV,X,Y,Z,DIFLD,DIFLDREG K DPP(DJ,"PTRIX") S DL=$P(DPP(DJ),U),Y=$P(DPP(DJ),U,2,3)
- . D DTYP^DIP1,STXT^DIP1(DJ,$G(DPP(DJ,"F")),$G(DPP(DJ,"T")),DITYP)
- .; Save off old "IX" node to preserve it if template is hand-edited.
- . I DJ=1 N DISAVIX,DIRECSRT S DISAVIX=$G(DPP(DJ,"IX")),DIRECSRT=0
- . K DPP(DJ,"IX")
- . I $P(DPP(DJ),U,4)'["-",'$D(DPP(DJ,"SRTTXT")),$P($G(DPP(DJ,"F")),U)'="?z",$P($G(DPP(DJ,"T")),U)'="@" D XR^DIP I DJ=1,DISAVIX]"",DISAVIX'=$G(DPP(DJ,"IX")) D
- .. N I,X,Y,Z S X=$P(DISAVIX,U,3),Z=$P(DISAVIX,U,2) I $E(Z,1,$L(X))'=X S DIRECSRT=1 G T12
- .. S Z=$E(Z,($L(X)+1),99),Z=$P(Z,"""",2) Q:Z="" I '$D(^DD(S,0,"IX",Z)) D Q:Z=""
- ... Q:S=405&(Z="ATT3") S Z="" Q
- T12 .. S DPP(DJ,"IX")=DISAVIX,DPP(DJ,"SER")="998^998"
- .. I DIRECSRT=1,$P(DPP(DJ),U,2)="",'($P($P(DPP(DJ),U,4),"""",2)),'$D(DPP(DJ,"CM")) S $P(DPP(DJ),U,2)=0
- PROMPT . I $D(DPP(DJ,"ASK")) S DPP(DJ,"ASK")=1 I $G(DICNVDPP)'=1 D DIP11^DIP1 Q ;GFT PATCH 97
- . I DJ=1,DISAVIX=1 Q
- . D OPT^DIP12 Q
- Q:$G(DICNVDPP)=1
- D DPQ^DIP1 S X="["_DIBT2 K DIARE,DIARS,DIARB Q
- ;
- CNVCM ;Convert V20 DPP array to V21 DPP array (for prints queued in V20 to run in V21)
- N D,I,J,X,Y,Z,N
- F D=0:0 S D=$O(DPP(D)) Q:'D S X=$G(DPP(D,"CM")) I X["S X(" D
- . S (I,Z)=0 F S Y=$F(X,"S X(",Z) Q:'Y S Z=Y,I=I+1
- . Q:'Z S N=+$E(X,Z) Q:'N
- . I $L(X)+16>248 D Q
- .. S Z="OVF",I=-1 F S Z=$O(DPP(D,Z)) Q:$E(Z,1,3)'="OVF" S I=$E(Z,4,99)
- .. S Z="OVF"_(I+1),Y=$P(X," S X=",1) S:Y]"" Y=Y_" "
- .. S DPP(D,"CM")=Y_"X DPP("_D_","""_Z_""",9.2) I $G(X("_N_"))]"""" S DISX("_N_")=X("_N_")"
- .. S Y=$P(X," S X=",2,99),DPP(D,Z,9.2)=$P("S X=",U,(Y]""))_Y Q
- . S DPP(D,"CM")=$P(X,"S X(",1,I)_"S DISX("_$P(X,"S X(",I+1,99)
- . Q
- Q
- ;
- Q S:$D(DUOUT)!($D(DTOUT)) X="^" G Q^DIP
- ;DIALOG #8030 'Because...sort template...linked w/Print template...
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIP11 5468 printed Feb 19, 2025@00:18:54 Page 2
- DIP11 ;SFISC/XAK,TKW-GET SORT TEMPLATE ;23JULY2014
- +1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- +4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- +5 ;;Licensed under the terms of the Apache License, Version 2.0.
- +6 ;
- SCREENTM(Z,D2) ;Z=ZERO NODE OF SORT TEMPLATE; D2 = THERE IS SORT-BY LOGIC
- +1 ;TEMPLATE MUST BE FOR THIS FILE
- IF $PIECE(Z,U,4)-DL
- QUIT 0
- +2 ;IN SILENT MODE, DON'T PICK SEARCH OR INQUIRY TYPE IF THERE'S A SORT TYPE OF SAME NAME
- IF 'D2&'L
- Begin DoDot:1
- +3 NEW NAME,I
- SET NAME=$PIECE(Z,U)
- FOR I=0:0
- SET I=$ORDER(^DIBT("B",NAME,I))
- if 'I
- QUIT
- IF I-Y
- IF $PIECE($GET(^DIBT(I,0)),U,4)=DL
- IF $DATA(^(2))
- KILL Z
- QUIT
- End DoDot:1
- QUIT $DATA(Z)
- +4 IF DUZ(0)="@"
- QUIT 1
- +5 ;IF A SORT TEMPLATE, ACCESS CODES MUST MATCH
- IF D2
- if 'L
- QUIT 1
- if $PIECE(Z,U,3)=""
- QUIT 1
- QUIT $TRANSLATE($PIECE(Z,U,3),DUZ(0))'=$PIECE(Z,U,3)
- +6 IF '$PIECE(Z,U,5)
- QUIT 1
- +7 ;If a SEARCH or INQUIRY TEMPLATE, USER MUST MATCH
- IF $PIECE(Z,U,5)=DUZ
- QUIT 1
- +8 QUIT 0
- +9 ;
- TEM ;
- +1 if DJ-1
- GOTO B^DIP
- KILL DPP,DIC
- +2 SET X=$PIECE($EXTRACT(X,2,99),"]",1)
- SET DIC(0)="ZQS"_$EXTRACT("E",'($DATA(BY)#2)!''L)
- SET DIC="^DIBT("
- SET D="F"_DL
- +3 SET DIC("S")="I $$SCREENTM^DIP11(^(0),$D(^(2)))"
- +4 IF X?."?"
- if X'?1"???"
- SET X="??"
- DO IX^DIC
- SET DJ=0
- QUIT
- +5 ;LOOK UP THE SORT TEMPLATE
- DO ^DIC
- IF Y<0
- SET DJ=0
- QUIT
- EMPTY ;SORT TEMPLATE HAS NO VALUES
- IF '$DATA(^DIBT(+Y,2))
- IF '$DATA(^(1))
- IF '$DATA(^("BY0"))
- if '$GET(DIQUIET)
- WRITE !,$$EZBLD^DIALOG(1509)
- SET DJ=0
- QUIT
- +1 ;*CCO/NI SORT TEMPLATE 'NUMBER'
- SET DPP(DJ)=DL_"^^'"_$PIECE(Y,U,2)_"' "_$$EZBLD^DIALOG(7099)_"^@'"_P
- SET (DIBT1,X)=+Y
- SET DIBT2=$PIECE(Y(0),U)
- SET D=DIC_X_","
- KILL DIC
- +2 IF '$DATA(FLDS)
- IF $GET(^DIBT(X,"DIPT"))]""
- SET FLDS="["_^("DIPT")_"]"
- IF L
- Begin DoDot:1
- +3 ;N %,A S %(1)=^("DIPT") D BLD^DIALOG(8030,.%,"","A") W ! F %=0:0 S %=$O(A(%)) Q:'% W A(%),!
- +4 ;??
- SET L=0
- QUIT
- End DoDot:1
- +5 IF $DATA(^DIBT(X,1))
- SET DIC=D_1_C
- SET DPP(DJ,"SER")="998^998"
- DO ENT^DIP10(DJ,DIBT1)
- IF $DATA(^DIBT(X,1))
- SET Y=1
- Begin DoDot:1
- +6 FOR DY=1:1
- SET Y=$ORDER(^(Y,-1))
- if Y=""
- SET Y=-1
- if $ORDER(^(Y))
- SET Y=$ORDER(^(Y))
- IF $DATA(^(Y))<9
- SET DPP(DJ,"IX")=DIC_DI_U_DY
- SET DIBT=X
- QUIT
- +7 QUIT
- End DoDot:1
- ENDIPT IF $GET(^DIBT(X,"BY0"))=""
- IF '$DATA(^DIBT(X,2))
- QUIT
- +1 IF $GET(^DIBT(X,"BY0"))=""
- IF $GET(^DIBT(X,2,0))=""
- SET %Y="DPP("
- SET %X=D_"2,"
- DO %XY^%RCR
- SET DIBTOLD=""
- DO CNVCM
- GOTO T0
- +2 SET D=$GET(^DIBT(X,"BY0"))
- IF $PIECE(D,U)]""
- IF $PIECE(D,U,2)
- Begin DoDot:1
- +3 NEW Y
- KILL DISPAR(0)
- SET BY(0)="^"_$PIECE(D,U)
- SET L(0)=$PIECE(D,U,2)
- +4 FOR D=1:1:(L(0)-1)
- Begin DoDot:2
- +5 SET Y=$GET(^DIBT(X,"BY0D",D,0))
- +6 IF '$DATA(FR(0,D))#2
- IF $PIECE(Y,U,2)]""
- SET FR(0,D)=$PIECE(Y,U,2)
- +7 IF '$DATA(TO(0,D))#2
- IF $PIECE(Y,U,3)]""
- SET TO(0,D)=$PIECE(Y,U,3)
- +8 IF $GET(^DIBT(X,"BY0D",D,1))]""
- SET DISPAR(0,D)=^(1)
- if $GET(^DIBT(X,"BY0D",D,2))]""
- SET DISPAR(0,D,"OUT")=^(2)
- +9 QUIT
- End DoDot:2
- +10 NEW X
- DO EN^DIP10
- QUIT
- End DoDot:1
- +11 ;S DJ=$O(DPP(999),-1)+1
- +12 ;GO THRU THE SORT LEVELS OF THE STORED TEMPLATE
- FOR D=0:0
- SET D=$ORDER(^DIBT(X,2,D))
- if 'D
- QUIT
- Begin DoDot:1
- +13 NEW A,B,C
- SET DPP(DJ)=$GET(^DIBT(X,2,D,0))
- BRINGIN SET A="A"
- FOR
- SET A=$ORDER(^DIBT(X,2,D,A))
- if A=""
- QUIT
- IF A'="SER"
- SET DPP(DJ,A)=^(A)
- IF A["COMPUTED"
- MERGE DPP(DJ,A)=^(A)
- +1 FOR B=1,2,3
- FOR A=0:0
- SET A=$ORDER(^DIBT(X,2,D,B,A))
- if 'A
- QUIT
- SET C=$GET(^(A,0))
- Begin DoDot:2
- +2 IF B=1
- if $PIECE(C,U)=+C
- SET DPP(DJ,+C)=$PIECE(C,U,2)
- QUIT
- +3 IF B=2
- if ($PIECE(C,U)=+C)&($PIECE(C,U,2)=+$PIECE(C,U,2))
- SET DPP(DJ,+C,$PIECE(C,U,2))=$PIECE(C,U,3,7)_U_$GET(^DIBT(X,2,D,2,A,"RCOD"))
- QUIT
- +4 IF $PIECE(C,U,1)]""
- IF $PIECE(C,U,2)]""
- SET DPP(DJ,$PIECE(C,U,1),$PIECE(C,U,2))=$GET(^DIBT(X,2,D,3,A,"OVF0"))
- +5 QUIT
- End DoDot:2
- +6 SET DJ=DJ+1
- QUIT
- End DoDot:1
- T0 if $DATA(DIBTRPT)
- QUIT
- +1 ;I '$P(DIARB,U,2) S $P(DIARB,U,2)=DIARU
- IF $DATA(DIAR)
- SET DIARU=X
- +2 FOR D=0:0
- SET D=$ORDER(^DIBT(X,3,D))
- if D=""
- QUIT
- SET DSC(D)=^(D)
- +3 IF 'L!($DATA(DPP(0))&(DUZ(0)'="@"))!$DATA(^DIBT(X,"CANONIC"))
- GOTO T1
- +4 ;CHECK WRITE ACCESS TO SORT TEMPLATE
- SET %=$PIECE(^DIBT(X,0),U,6)
- +5 IF %]""
- FOR D=1:1:$LENGTH(%)
- IF DUZ(0)[$EXTRACT(%,D)!(DUZ(0)="@")
- SET %=""
- QUIT
- +6 IF %=""
- IF X'<1
- SET %=$PIECE(Y(0),U,1)
- Begin DoDot:1
- +7 NEW X,Y
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("A")="WANT TO EDIT '"_%_"' TEMPLATE"
- DO ^DIR
- KILL DIR
- +8 SET %=Y
- QUIT
- End DoDot:1
- if $DATA(DIRUT)
- GOTO Q
- IF %=1
- KILL DIBTOLD
- GOTO EDT^DIP0
- +9 ;DON'T WANT TO EDIT
- T1 FOR DJ=$GET(DPP(0))+1:1
- if '$DATA(DPP(DJ))
- QUIT
- Begin DoDot:1
- +1 NEW DL,DU,DV,X,Y,Z,DIFLD,DIFLDREG
- KILL DPP(DJ,"PTRIX")
- SET DL=$PIECE(DPP(DJ),U)
- SET Y=$PIECE(DPP(DJ),U,2,3)
- +2 DO DTYP^DIP1
- DO STXT^DIP1(DJ,$GET(DPP(DJ,"F")),$GET(DPP(DJ,"T")),DITYP)
- +3 ; Save off old "IX" node to preserve it if template is hand-edited.
- +4 IF DJ=1
- NEW DISAVIX,DIRECSRT
- SET DISAVIX=$GET(DPP(DJ,"IX"))
- SET DIRECSRT=0
- +5 KILL DPP(DJ,"IX")
- +6 IF $PIECE(DPP(DJ),U,4)'["-"
- IF '$DATA(DPP(DJ,"SRTTXT"))
- IF $PIECE($GET(DPP(DJ,"F")),U)'="?z"
- IF $PIECE($GET(DPP(DJ,"T")),U)'="@"
- DO XR^DIP
- IF DJ=1
- IF DISAVIX]""
- IF DISAVIX'=$GET(DPP(DJ,"IX"))
- Begin DoDot:2
- +7 NEW I,X,Y,Z
- SET X=$PIECE(DISAVIX,U,3)
- SET Z=$PIECE(DISAVIX,U,2)
- IF $EXTRACT(Z,1,$LENGTH(X))'=X
- SET DIRECSRT=1
- GOTO T12
- +8 SET Z=$EXTRACT(Z,($LENGTH(X)+1),99)
- SET Z=$PIECE(Z,"""",2)
- if Z=""
- QUIT
- IF '$DATA(^DD(S,0,"IX",Z))
- Begin DoDot:3
- +9 if S=405&(Z="ATT3")
- QUIT
- SET Z=""
- QUIT
- End DoDot:3
- if Z=""
- QUIT
- T12 SET DPP(DJ,"IX")=DISAVIX
- SET DPP(DJ,"SER")="998^998"
- +1 IF DIRECSRT=1
- IF $PIECE(DPP(DJ),U,2)=""
- IF '($PIECE($PIECE(DPP(DJ),U,4),"""",2))
- IF '$DATA(DPP(DJ,"CM"))
- SET $PIECE(DPP(DJ),U,2)=0
- End DoDot:2
- PROMPT ;GFT PATCH 97
- IF $DATA(DPP(DJ,"ASK"))
- SET DPP(DJ,"ASK")=1
- IF $GET(DICNVDPP)'=1
- DO DIP11^DIP1
- QUIT
- +1 IF DJ=1
- IF DISAVIX=1
- QUIT
- +2 DO OPT^DIP12
- QUIT
- End DoDot:1
- IF '$DATA(DJ)!($DATA(DTOUT))!($DATA(DIRUT))
- GOTO Q
- +3 if $GET(DICNVDPP)=1
- QUIT
- +4 DO DPQ^DIP1
- SET X="["_DIBT2
- KILL DIARE,DIARS,DIARB
- QUIT
- +5 ;
- CNVCM ;Convert V20 DPP array to V21 DPP array (for prints queued in V20 to run in V21)
- +1 NEW D,I,J,X,Y,Z,N
- +2 FOR D=0:0
- SET D=$ORDER(DPP(D))
- if 'D
- QUIT
- SET X=$GET(DPP(D,"CM"))
- IF X["S X("
- Begin DoDot:1
- +3 SET (I,Z)=0
- FOR
- SET Y=$FIND(X,"S X(",Z)
- if 'Y
- QUIT
- SET Z=Y
- SET I=I+1
- +4 if 'Z
- QUIT
- SET N=+$EXTRACT(X,Z)
- if 'N
- QUIT
- +5 IF $LENGTH(X)+16>248
- Begin DoDot:2
- +6 SET Z="OVF"
- SET I=-1
- FOR
- SET Z=$ORDER(DPP(D,Z))
- if $EXTRACT(Z,1,3)'="OVF"
- QUIT
- SET I=$EXTRACT(Z,4,99)
- +7 SET Z="OVF"_(I+1)
- SET Y=$PIECE(X," S X=",1)
- if Y]""
- SET Y=Y_" "
- +8 SET DPP(D,"CM")=Y_"X DPP("_D_","""_Z_""",9.2) I $G(X("_N_"))]"""" S DISX("_N_")=X("_N_")"
- +9 SET Y=$PIECE(X," S X=",2,99)
- SET DPP(D,Z,9.2)=$PIECE("S X=",U,(Y]""))_Y
- QUIT
- End DoDot:2
- QUIT
- +10 SET DPP(D,"CM")=$PIECE(X,"S X(",1,I)_"S DISX("_$PIECE(X,"S X(",I+1,99)
- +11 QUIT
- End DoDot:1
- +12 QUIT
- +13 ;
- Q if $DATA(DUOUT)!($DATA(DTOUT))
- SET X="^"
- GOTO Q^DIP
- +1 ;DIALOG #8030 'Because...sort template...linked w/Print template...