- DDD ;O-OIFO/GFT - Build Meta Data Dictionary ;20JAN2013
- ;;22.2;VA FileMan;**2**;Jan 05, 2016;Build 139
- ;;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.
- ;;GFT;**1045**
- ;;12/8/2015 lg modifications to accomodate OBJECT NAME field
- ;;12/8/2015 lg added CAMCASE module
- ;;12/17/2015 removed line MAKE+2 - I '$D(^DDD(0)) D ^DDDINIT Q:'$D(^DDD(0)) ; before 12/17/2015 -lg
- ;;PARTIAL,CLEAN,ADD,GETFILES,F1,XREF modules added for partial updates ; 12/28/2015 -lg
- ;;PART(ARRAY) entry point added to send a specific list of files to update ; 12/28/15 -lg
- ;;ADDED variable STDT for start date/time to stamp LAST UPDATED field #.07 that was added to ^DD ; 12/28/15 -lg
- ;;Rearranged and separated FILELIST and PARTIAL1 code, ADDED PARTIAL2 12/29/2015
- ;
- MAKE ;
- N DDD,FLD,Z,I,L,F,STDT D DT^DICRW,NOW^%DTC S STDT=% ; 12/28/15 -lg
- I '$D(^DDD(0)) W !!,"Your Meta Data Dictionary files are missing.",!,"Please contact your IRM to fix the problem and then try again.",!! Q ;D ^DDDINIT Q:'$D(^DDD(0))
- G AC:$D(^DIC("AC","DDD")) W !,"SINCE NO FILE IS IN APPLICATION GROUP 'DDD',",!,"the entire FileMan database will be scanned, and"
- D OK Q:'$D(%)
- F DDD=1.99:0 S DDD=$O(^DIC(DDD)) Q:'DDD D BLD
- G END
- ;
- AC W !,"Based on all Files identified as belonging to the 'DDD' Application Group," D OK Q:'$D(%)
- F DDD=0:0 S DDD=$O(^DIC("AC","DDD",DDD)) Q:DDD="" D BLD
- END S DIK="^DDD(" D IXALL^DIK W !,"<DONE>"
- D NOW^%DTC S ^DDD("MSC")=% ; stamp last run date 12/22/15 -lg
- Q
- ;
- BLD N FILE S FILE=DDD,F=$P(^DIC(DDD,0),"^")_"_"
- FILE W "." F FLD=0:0 S FLD=$O(^DD(FILE,FLD)) Q:'FLD S I=I+1 D FLD,XREF:$D(PARTIAL) ; added XREF during PARTIAL 12/23/15 -lg
- I $D(FILE)>9 S FILE=$O(FILE(0)) S F=FILE(FILE) K FILE(FILE) G FILE
- Q:$D(PARTIAL) ; 12/22/15 -lg
- DDDA N FN,IEN Q:'$D(^DIC("AC","DDDA",DDD))
- S FN=$$CREF^DILF(^DIC(DDD,0,"GL")),F=$P(^DIC(DDD,0),U)
- F IEN=0:0 S IEN=$O(@FN@(IEN)) Q:'IEN S L=$P(@FN@(IEN,0),U),I=$O(^DDD("A"),-1)+1,^DDD(I,0)=F_"_"_L_U_L_U_DDD_U_.01_U_1_U_$$CAMCASE(F_L) ; lg 12/22/15 see FLD+1 change
- Q
- ;
- FLD Q:'$D(^DD(FILE,FLD,0)) S Z=^(0),%=$P(Z,U,2) I % Q:'$D(^DD(+%,.01,0)) S:$P(^(0),U,2)'["W" FILE(+%)=F_$P(Z,U)_"_"
- S ^DDD(I,0)=F_$P(Z,U)_U_$P(Z,U)_U_FILE_U_FLD_U_U_$$CAMCASE(F_$P(Z,U))_U_STDT ; lg 12/28/15
- S L=0
- DESCR I $D(^DD(FILE,FLD,3)),^(3)]"" S L=1,^DDD(I,1,1,0)=^(3)
- F Z=0:0 S Z=$O(^DD(FILE,FLD,21,Z)) Q:'Z S L=L+1,^DDD(I,1,L,0)=$E(" ",L=2)_^(Z,0)
- I L=0,%["P" S Z=+$P(%,"P",2) I $D(^DD(Z,.01,0)) S %=$P(^(0),U,2) N FILE,FLD S FILE=Z,FLD=.01 D DESCR
- S ^DDD(I,1,0)="^^"_L_U_L_U_DT
- Q
- ;
- OK W !,"a Central Data Dictionary will now be compiled."
- K %
- N DIR
- S DIR(0)="Y"
- S DIR("A")="OK"
- S DIR("B")="No"
- S DIR("?",1)="If you say YES, File .9 will be re-constructed, "
- S DIR("?",2)="using the existing field definitions in your FileMan files."
- S DIR("?")="This process will take some time and use system resources."
- D ^DIR Q:Y'=1 S %=Y
- S I=0
- S ^DDD(0)=$P(^DDD(0),U,1,2)
- N J F J=0:0 S J=$O(^DDD(J)) Q:J="" K ^(J) ; Kill all nodes including indexes.
- Q
- ;
- BUILDS(FILE,FIELD) ;BUILDs in which a field appears
- Q:'FILE!'FIELD
- N D,I,J D IJ^DIUTL(FILE) F D=0:0 S D=$O(^XPD(9.6,D)) Q:'D I $D(^(D,4,J(0),2,FILE,1,FIELD)) N D0 S D0=D,X=$P(^XPD(9.6,D,0),U) X DICMX Q:'$D(D)
- Q ; lg 12/08/15
- ;
- FILELIST(ARRAY) ; entry point to send a specific list of files by reference to update in array(file#)=""
- ; 12/28/15
- Q:$D(ARRAY)<9
- N DDD,FLD,Z,I,L,F,PARTIAL,UFILE,KREF,STDT
- D DT^DICRW,NOW^%DTC S STDT=% ; 12/28/15 -lg
- S PARTIAL="" ; flag indicating this process is a "PARTIAL" update
- S DDD=0 F S DDD=$O(ARRAY(DDD)) Q:'DDD S (UFILE(DDD),KREF(DDD))="" D GETFILES(DDD) K ARRAY(DDD)
- D CLEAN,ADD
- Q
- ;
- PARTIAL1 ; entry point for a partial build 12/28/15 -lg
- N DDD,FLD,Z,I,L,F,PARTIAL,UFILE,KREF,STDT D DT^DICRW,NOW^%DTC S STDT=% ; 12/28/15 -lg
- S PARTIAL="" ; flag indicating this process is a "PARTIAL" update
- S DTCHK=$G(^DDD("MSC")) ; date of last ^DDD run (full or partial)
- F DDD=1.99:0 S DDD=$O(^DIC(DDD)) Q:'DDD I $G(^DIC(DDD,"%MSC"))>DTCHK S (UFILE(DDD),KREF(DDD))="" D GETFILES(DDD)
- Q:'$D(UFILE)
- D CLEAN,ADD
- D NOW^%DTC S ^DDD("MSC")=% ; stamp last run date
- Q
- ;
- PARTIAL2 ; Entry point for a partial build using ^DD(FILE,FIELD,"DT") 12/29/2015 BI
- N FILE,FIELD,DTCHK,CHGDATE,TOP
- S DTCHK=$P($G(^DDD("MSC")),".",1) ; date of last ^DDD run (FULL, PARTIAL1, or PARTIAL2)
- S FILE=$O(^DD(2),-1)
- F S FILE=$O(^DD(FILE)) Q:'FILE D
- . S FIELD=0
- . F S FIELD=$O(^DD(FILE,FIELD)) Q:'FIELD D
- .. S CHGDATE=$G(^DD(FILE,FIELD,"DT"))
- .. I (CHGDATE>DTCHK)!(CHGDATE=DTCHK) D
- ... S TOP=FILE
- ... I '$D(^DIC(TOP,0)) F S TOP=$G(^DD(TOP,0,"UP")) Q:TOP="" Q:$D(^DIC(TOP,0))
- ... S:TOP ARRAY(TOP)=""
- D FILELIST(.ARRAY)
- D NOW^%DTC S ^DDD("MSC")=% ; stamp last run date
- Q
- ;
- GETFILES(FILE) ; get the sub-files for the parent file during a PARTIAL update
- F1 ; 12/28/15 -lg
- F FLD=0:0 S FLD=$O(^DD(FILE,FLD)) Q:'FLD S Z=$G(^(FLD,0)),%=$P(Z,U,2) I % Q:'$D(^DD(+%,.01,0)) S:$P(^(0),U,2)'["W" (KREF(+%),FILE(+%))=""
- I $D(FILE)>9 S FILE=$O(FILE(0)) K FILE(FILE) G F1
- Q
- ;
- XREF ; cross-references individual field and update the ^DDD(0) with record ien and count during PARTIAL update
- ; 12/28/15 -lg
- N DIK,DA S DA=I,DIK="^DDD(" D IX1^DIK
- S $P(^DDD(0),U,3)=I,$P(^(0),U,4)=$P(^DDD(0),U,4)+1
- Q
- ;
- ADD ; add records back to MDD during a PARTIAL update
- ; 12/28/15 -lg
- N FILE S I=$O(^DDD("A"),-1)
- S DDD=0 F S DDD=$O(UFILE(DDD)) Q:'DDD D BLD
- Q
- CLEAN ; remove existing record entries and cross-references during a PARTIAL update
- ; new records will be added for the changed file at the end of the MDD.
- ; 12/28/15 -lg
- N NODE,DIK,DA
- S DDD=0,DIK="^DDD("
- F S DDD=$O(KREF(DDD)) Q:'DDD S NODE="^DDD(""AFF"",DDD)" F S NODE=$Q(@NODE) Q:$QS(NODE,2)'=DDD S DA=$QS(NODE,4) D ^DIK
- Q
- ;
- CAMCASE(INTEXT) ; lg 12/08/15
- N X,OUTTEXT
- S INTEXT=$TR(INTEXT,".","")
- S INTEXT=$TR(INTEXT,"/\-#?$()&[]"," ")
- S OUTTEXT=""
- F X=1:1:$L(INTEXT,"_") D
- . S:X'=$L(INTEXT,"_") OUTTEXT=OUTTEXT_$$CONVERT($P(INTEXT,"_",X))_"."
- . S:X=$L(INTEXT,"_") OUTTEXT=OUTTEXT_$$CONVERT($P(INTEXT,"_",X))
- Q OUTTEXT
- ;
- CONVERT(INTEXT) ; lg 12/08/15
- N X,OUTTEXT
- S INTEXT=$$TRIM^XLFSTR(INTEXT)
- S INTEXT=$$LOW^XLFSTR(INTEXT)
- S OUTTEXT=""
- F X=1:1:$L(INTEXT," ") D
- . I X=1,$P(INTEXT," ",X)'="" S OUTTEXT=OUTTEXT_$P(INTEXT," ",X)
- . I X'=1,$P(INTEXT," ",X)'="" S OUTTEXT=OUTTEXT_$$UP^XLFSTR($E($P(INTEXT," ",X),1))_$E($P(INTEXT," ",X),2,999)
- Q OUTTEXT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDD 6714 printed Feb 19, 2025@00:08:15 Page 2
- DDD ;O-OIFO/GFT - Build Meta Data Dictionary ;20JAN2013
- +1 ;;22.2;VA FileMan;**2**;Jan 05, 2016;Build 139
- +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 ;;GFT;**1045**
- +7 ;;12/8/2015 lg modifications to accomodate OBJECT NAME field
- +8 ;;12/8/2015 lg added CAMCASE module
- +9 ;;12/17/2015 removed line MAKE+2 - I '$D(^DDD(0)) D ^DDDINIT Q:'$D(^DDD(0)) ; before 12/17/2015 -lg
- +10 ;;PARTIAL,CLEAN,ADD,GETFILES,F1,XREF modules added for partial updates ; 12/28/2015 -lg
- +11 ;;PART(ARRAY) entry point added to send a specific list of files to update ; 12/28/15 -lg
- +12 ;;ADDED variable STDT for start date/time to stamp LAST UPDATED field #.07 that was added to ^DD ; 12/28/15 -lg
- +13 ;;Rearranged and separated FILELIST and PARTIAL1 code, ADDED PARTIAL2 12/29/2015
- +14 ;
- MAKE ;
- +1 ; 12/28/15 -lg
- NEW DDD,FLD,Z,I,L,F,STDT
- DO DT^DICRW
- DO NOW^%DTC
- SET STDT=%
- +2 ;D ^DDDINIT Q:'$D(^DDD(0))
- IF '$DATA(^DDD(0))
- WRITE !!,"Your Meta Data Dictionary files are missing.",!,"Please contact your IRM to fix the problem and then try again.",!!
- QUIT
- +3 if $DATA(^DIC("AC","DDD"))
- GOTO AC
- WRITE !,"SINCE NO FILE IS IN APPLICATION GROUP 'DDD',",!,"the entire FileMan database will be scanned, and"
- +4 DO OK
- if '$DATA(%)
- QUIT
- +5 FOR DDD=1.99:0
- SET DDD=$ORDER(^DIC(DDD))
- if 'DDD
- QUIT
- DO BLD
- +6 GOTO END
- +7 ;
- AC WRITE !,"Based on all Files identified as belonging to the 'DDD' Application Group,"
- DO OK
- if '$DATA(%)
- QUIT
- +1 FOR DDD=0:0
- SET DDD=$ORDER(^DIC("AC","DDD",DDD))
- if DDD=""
- QUIT
- DO BLD
- END SET DIK="^DDD("
- DO IXALL^DIK
- WRITE !,"<DONE>"
- +1 ; stamp last run date 12/22/15 -lg
- DO NOW^%DTC
- SET ^DDD("MSC")=%
- +2 QUIT
- +3 ;
- BLD NEW FILE
- SET FILE=DDD
- SET F=$PIECE(^DIC(DDD,0),"^")_"_"
- FILE ; added XREF during PARTIAL 12/23/15 -lg
- WRITE "."
- FOR FLD=0:0
- SET FLD=$ORDER(^DD(FILE,FLD))
- if 'FLD
- QUIT
- SET I=I+1
- DO FLD
- if $DATA(PARTIAL)
- DO XREF
- +1 IF $DATA(FILE)>9
- SET FILE=$ORDER(FILE(0))
- SET F=FILE(FILE)
- KILL FILE(FILE)
- GOTO FILE
- +2 ; 12/22/15 -lg
- if $DATA(PARTIAL)
- QUIT
- DDDA NEW FN,IEN
- if '$DATA(^DIC("AC","DDDA",DDD))
- QUIT
- +1 SET FN=$$CREF^DILF(^DIC(DDD,0,"GL"))
- SET F=$PIECE(^DIC(DDD,0),U)
- +2 ; lg 12/22/15 see FLD+1 change
- FOR IEN=0:0
- SET IEN=$ORDER(@FN@(IEN))
- if 'IEN
- QUIT
- SET L=$PIECE(@FN@(IEN,0),U)
- SET I=$ORDER(^DDD("A"),-1)+1
- SET ^DDD(I,0)=F_"_"_L_U_L_U_DDD_U_.01_U_1_U_$$CAMCASE(F_L)
- +3 QUIT
- +4 ;
- FLD if '$DATA(^DD(FILE,FLD,0))
- QUIT
- SET Z=^(0)
- SET %=$PIECE(Z,U,2)
- IF %
- if '$DATA(^DD(+%,.01,0))
- QUIT
- if $PIECE(^(0),U,2)'["W"
- SET FILE(+%)=F_$PIECE(Z,U)_"_"
- +1 ; lg 12/28/15
- SET ^DDD(I,0)=F_$PIECE(Z,U)_U_$PIECE(Z,U)_U_FILE_U_FLD_U_U_$$CAMCASE(F_$PIECE(Z,U))_U_STDT
- +2 SET L=0
- DESCR IF $DATA(^DD(FILE,FLD,3))
- IF ^(3)]""
- SET L=1
- SET ^DDD(I,1,1,0)=^(3)
- +1 FOR Z=0:0
- SET Z=$ORDER(^DD(FILE,FLD,21,Z))
- if 'Z
- QUIT
- SET L=L+1
- SET ^DDD(I,1,L,0)=$EXTRACT(" ",L=2)_^(Z,0)
- +2 IF L=0
- IF %["P"
- SET Z=+$PIECE(%,"P",2)
- IF $DATA(^DD(Z,.01,0))
- SET %=$PIECE(^(0),U,2)
- NEW FILE,FLD
- SET FILE=Z
- SET FLD=.01
- DO DESCR
- +3 SET ^DDD(I,1,0)="^^"_L_U_L_U_DT
- +4 QUIT
- +5 ;
- OK WRITE !,"a Central Data Dictionary will now be compiled."
- +1 KILL %
- +2 NEW DIR
- +3 SET DIR(0)="Y"
- +4 SET DIR("A")="OK"
- +5 SET DIR("B")="No"
- +6 SET DIR("?",1)="If you say YES, File .9 will be re-constructed, "
- +7 SET DIR("?",2)="using the existing field definitions in your FileMan files."
- +8 SET DIR("?")="This process will take some time and use system resources."
- +9 DO ^DIR
- if Y'=1
- QUIT
- SET %=Y
- +10 SET I=0
- +11 SET ^DDD(0)=$PIECE(^DDD(0),U,1,2)
- +12 ; Kill all nodes including indexes.
- NEW J
- FOR J=0:0
- SET J=$ORDER(^DDD(J))
- if J=""
- QUIT
- KILL ^(J)
- +13 QUIT
- +14 ;
- BUILDS(FILE,FIELD) ;BUILDs in which a field appears
- +1 if 'FILE!'FIELD
- QUIT
- +2 NEW D,I,J
- DO IJ^DIUTL(FILE)
- FOR D=0:0
- SET D=$ORDER(^XPD(9.6,D))
- if 'D
- QUIT
- IF $DATA(^(D,4,J(0),2,FILE,1,FIELD))
- NEW D0
- SET D0=D
- SET X=$PIECE(^XPD(9.6,D,0),U)
- XECUTE DICMX
- if '$DATA(D)
- QUIT
- +3 ; lg 12/08/15
- QUIT
- +4 ;
- FILELIST(ARRAY) ; entry point to send a specific list of files by reference to update in array(file#)=""
- +1 ; 12/28/15
- +2 if $DATA(ARRAY)<9
- QUIT
- +3 NEW DDD,FLD,Z,I,L,F,PARTIAL,UFILE,KREF,STDT
- +4 ; 12/28/15 -lg
- DO DT^DICRW
- DO NOW^%DTC
- SET STDT=%
- +5 ; flag indicating this process is a "PARTIAL" update
- SET PARTIAL=""
- +6 SET DDD=0
- FOR
- SET DDD=$ORDER(ARRAY(DDD))
- if 'DDD
- QUIT
- SET (UFILE(DDD),KREF(DDD))=""
- DO GETFILES(DDD)
- KILL ARRAY(DDD)
- +7 DO CLEAN
- DO ADD
- +8 QUIT
- +9 ;
- PARTIAL1 ; entry point for a partial build 12/28/15 -lg
- +1 ; 12/28/15 -lg
- NEW DDD,FLD,Z,I,L,F,PARTIAL,UFILE,KREF,STDT
- DO DT^DICRW
- DO NOW^%DTC
- SET STDT=%
- +2 ; flag indicating this process is a "PARTIAL" update
- SET PARTIAL=""
- +3 ; date of last ^DDD run (full or partial)
- SET DTCHK=$GET(^DDD("MSC"))
- +4 FOR DDD=1.99:0
- SET DDD=$ORDER(^DIC(DDD))
- if 'DDD
- QUIT
- IF $GET(^DIC(DDD,"%MSC"))>DTCHK
- SET (UFILE(DDD),KREF(DDD))=""
- DO GETFILES(DDD)
- +5 if '$DATA(UFILE)
- QUIT
- +6 DO CLEAN
- DO ADD
- +7 ; stamp last run date
- DO NOW^%DTC
- SET ^DDD("MSC")=%
- +8 QUIT
- +9 ;
- PARTIAL2 ; Entry point for a partial build using ^DD(FILE,FIELD,"DT") 12/29/2015 BI
- +1 NEW FILE,FIELD,DTCHK,CHGDATE,TOP
- +2 ; date of last ^DDD run (FULL, PARTIAL1, or PARTIAL2)
- SET DTCHK=$PIECE($GET(^DDD("MSC")),".",1)
- +3 SET FILE=$ORDER(^DD(2),-1)
- +4 FOR
- SET FILE=$ORDER(^DD(FILE))
- if 'FILE
- QUIT
- Begin DoDot:1
- +5 SET FIELD=0
- +6 FOR
- SET FIELD=$ORDER(^DD(FILE,FIELD))
- if 'FIELD
- QUIT
- Begin DoDot:2
- +7 SET CHGDATE=$GET(^DD(FILE,FIELD,"DT"))
- +8 IF (CHGDATE>DTCHK)!(CHGDATE=DTCHK)
- Begin DoDot:3
- +9 SET TOP=FILE
- +10 IF '$DATA(^DIC(TOP,0))
- FOR
- SET TOP=$GET(^DD(TOP,0,"UP"))
- if TOP=""
- QUIT
- if $DATA(^DIC(TOP,0))
- QUIT
- +11 if TOP
- SET ARRAY(TOP)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +12 DO FILELIST(.ARRAY)
- +13 ; stamp last run date
- DO NOW^%DTC
- SET ^DDD("MSC")=%
- +14 QUIT
- +15 ;
- GETFILES(FILE) ; get the sub-files for the parent file during a PARTIAL update
- F1 ; 12/28/15 -lg
- +1 FOR FLD=0:0
- SET FLD=$ORDER(^DD(FILE,FLD))
- if 'FLD
- QUIT
- SET Z=$GET(^(FLD,0))
- SET %=$PIECE(Z,U,2)
- IF %
- if '$DATA(^DD(+%,.01,0))
- QUIT
- if $PIECE(^(0),U,2)'["W"
- SET (KREF(+%),FILE(+%))=""
- +2 IF $DATA(FILE)>9
- SET FILE=$ORDER(FILE(0))
- KILL FILE(FILE)
- GOTO F1
- +3 QUIT
- +4 ;
- XREF ; cross-references individual field and update the ^DDD(0) with record ien and count during PARTIAL update
- +1 ; 12/28/15 -lg
- +2 NEW DIK,DA
- SET DA=I
- SET DIK="^DDD("
- DO IX1^DIK
- +3 SET $PIECE(^DDD(0),U,3)=I
- SET $PIECE(^(0),U,4)=$PIECE(^DDD(0),U,4)+1
- +4 QUIT
- +5 ;
- ADD ; add records back to MDD during a PARTIAL update
- +1 ; 12/28/15 -lg
- +2 NEW FILE
- SET I=$ORDER(^DDD("A"),-1)
- +3 SET DDD=0
- FOR
- SET DDD=$ORDER(UFILE(DDD))
- if 'DDD
- QUIT
- DO BLD
- +4 QUIT
- CLEAN ; remove existing record entries and cross-references during a PARTIAL update
- +1 ; new records will be added for the changed file at the end of the MDD.
- +2 ; 12/28/15 -lg
- +3 NEW NODE,DIK,DA
- +4 SET DDD=0
- SET DIK="^DDD("
- +5 FOR
- SET DDD=$ORDER(KREF(DDD))
- if 'DDD
- QUIT
- SET NODE="^DDD(""AFF"",DDD)"
- FOR
- SET NODE=$QUERY(@NODE)
- if $QSUBSCRIPT(NODE,2)'=DDD
- QUIT
- SET DA=$QSUBSCRIPT(NODE,4)
- DO ^DIK
- +6 QUIT
- +7 ;
- CAMCASE(INTEXT) ; lg 12/08/15
- +1 NEW X,OUTTEXT
- +2 SET INTEXT=$TRANSLATE(INTEXT,".","")
- +3 SET INTEXT=$TRANSLATE(INTEXT,"/\-#?$()&[]"," ")
- +4 SET OUTTEXT=""
- +5 FOR X=1:1:$LENGTH(INTEXT,"_")
- Begin DoDot:1
- +6 if X'=$LENGTH(INTEXT,"_")
- SET OUTTEXT=OUTTEXT_$$CONVERT($PIECE(INTEXT,"_",X))_"."
- +7 if X=$LENGTH(INTEXT,"_")
- SET OUTTEXT=OUTTEXT_$$CONVERT($PIECE(INTEXT,"_",X))
- End DoDot:1
- +8 QUIT OUTTEXT
- +9 ;
- CONVERT(INTEXT) ; lg 12/08/15
- +1 NEW X,OUTTEXT
- +2 SET INTEXT=$$TRIM^XLFSTR(INTEXT)
- +3 SET INTEXT=$$LOW^XLFSTR(INTEXT)
- +4 SET OUTTEXT=""
- +5 FOR X=1:1:$LENGTH(INTEXT," ")
- Begin DoDot:1
- +6 IF X=1
- IF $PIECE(INTEXT," ",X)'=""
- SET OUTTEXT=OUTTEXT_$PIECE(INTEXT," ",X)
- +7 IF X'=1
- IF $PIECE(INTEXT," ",X)'=""
- SET OUTTEXT=OUTTEXT_$$UP^XLFSTR($EXTRACT($PIECE(INTEXT," ",X),1))_$EXTRACT($PIECE(INTEXT," ",X),2,999)
- End DoDot:1
- +8 QUIT OUTTEXT