FSCXPOST ;SLC/STAFF-NOIS Xrefs Client ;9/6/98 22:21
;;1.1;NOIS;;Sep 06, 1998
;;
ALL ; from FSCTASKA
D SITE,OFFICE,MOD,PACK,LTYPE,PACKG,TASK,SYSTEM,FIELD
Q
;
SITE ;
N ABBREV,CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
;W !,"NOIS LOCATION"
K ^FSC("SITE","ACL")
S IEN=0 F S IEN=$O(^FSC("SITE",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
.K ^FSC("SITE",IEN,99)
.S NUM=1,NAME=$$MIXCASE($P(ZERO,U)),ABBREV=$P(ZERO,U,3)
.D SETUP("^FSC(""SITE"",",IEN,NUM,NAME)
.I $L(ABBREV) S NUM=NUM+1 D SETUP("^FSC(""SITE"",",IEN,NUM,ABBREV_" - "_NAME)
.S CNT=0 F S CNT=$O(^FSC("SITE",IEN,2,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
..D SETUP("^FSC(""SITE"",",IEN,NUM,VALUE)
.S ^FSC("SITE",IEN,99,0)="^7105.199^"_NUM_U_NUM
Q
;
OFFICE ;
N CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
;W !,"NOIS OFFICE"
K ^FSC("ISC","ACL")
S IEN=0 F S IEN=$O(^FSC("ISC",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
.K ^FSC("ISC",IEN,99)
.S NUM=1,NAME=$$MIXCASE($P(ZERO,U))
.D SETUP("^FSC(""ISC"",",IEN,NUM,NAME)
.S CNT=0 F S CNT=$O(^FSC("ISC",IEN,1,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
..D SETUP("^FSC(""ISC"",",IEN,NUM,VALUE)
.S ^FSC("ISC",IEN,99,0)="^7105.399^"_NUM_U_NUM
Q
;
MOD ;
N CNT,IEN,NAME,NAMECONV,NAMESP,NUM,SYN,VALUE,ZERO
;W !,"NOIS MODULE/VERSION"
K ^FSC("MOD","ACL")
S IEN=0 F S IEN=$O(^FSC("MOD",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
.K ^FSC("MOD",IEN,99)
.S NUM=1,NAME=$$MIXCASE($P(ZERO,U)),NAMECONV=$P(ZERO,U,7),NAMESP=$P(ZERO,U,4)
.I $P(ZERO,U,3)=1 S NAME=$TR(NAME,"/"," ")
.I $P(ZERO,U,3)=2 S NAME=$TR(NAME,"/","+")
.I $P(ZERO,U,3)=3 S NAME=$TR(NAME,"/","-")
.D SETUP("^FSC(""MOD"",",IEN,NUM,NAME)
.I $L(NAMECONV) S NUM=NUM+1 D SETUP("^FSC(""MOD"",",IEN,NUM,NAMECONV_" - "_NAME)
.I $L(NAMESP) S NUM=NUM+1 D SETUP("^FSC(""MOD"",",IEN,NUM,NAMESP_" - "_NAME)
.S CNT=0 F S CNT=$O(^FSC("MOD",IEN,2,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
..D SETUP("^FSC(""MOD"",",IEN,NUM,VALUE)
.S ^FSC("MOD",IEN,99,0)="^7105.499^"_NUM_U_NUM
Q
;
PACK ;
N CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
;W !,"NOIS PACKAGE"
K ^FSC("PACK","ACL")
S IEN=0 F S IEN=$O(^FSC("PACK",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
.K ^FSC("PACK",IEN,99)
.S NUM=1,NAME=$$MIXCASE($P(ZERO,U))
.D SETUP("^FSC(""PACK"",",IEN,NUM,NAME)
.S CNT=0 F S CNT=$O(^FSC("PACK",IEN,1,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
..D SETUP("^FSC(""PACK"",",IEN,NUM,VALUE)
.S ^FSC("PACK",IEN,99,0)="^7105.599^"_NUM_U_NUM
Q
;
LTYPE ;
N CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
;W !,"NOIS LOCATION TYPE"
K ^FSC("LTYPE","ACL")
S IEN=0 F S IEN=$O(^FSC("LTYPE",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
.K ^FSC("LTYPE",IEN,99)
.S NUM=1,NAME=$$MIXCASE($P(ZERO,U))
.D SETUP("^FSC(""LTYPE"",",IEN,NUM,NAME)
.S CNT=0 F S CNT=$O(^FSC("LTYPE",IEN,1,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
..D SETUP("^FSC(""LTYPE"",",IEN,NUM,VALUE)
.S ^FSC("LTYPE",IEN,99,0)="^7105.799^"_NUM_U_NUM
Q
;
PACKG ;
N CNT,IEN,NAME,NUM,SHNAME,SYN,VALUE,ZERO
;W !,"NOIS PACKAGE GROUP"
K ^FSC("PACKG","ACL")
S IEN=0 F S IEN=$O(^FSC("PACKG",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
.K ^FSC("PACKG",IEN,99)
.S NUM=1,NAME=$$MIXCASE($P(ZERO,U)),SHNAME=$P(ZERO,U,3)
.D SETUP("^FSC(""PACKG"",",IEN,NUM,NAME)
.I $L(SHNAME) S NUM=NUM+1 D SETUP("^FSC(""PACKG"",",IEN,NUM,SHNAME_" - "_NAME)
.S CNT=0 F S CNT=$O(^FSC("PACKG",IEN,1,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
..D SETUP("^FSC(""PACKG"",",IEN,NUM,VALUE)
.S ^FSC("PACKG",IEN,99,0)="^7105.899^"_NUM_U_NUM
Q
;
TASK ;
N CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
;W !,"NOIS TASK"
K ^FSC("TASK","ACL")
S IEN=0 F S IEN=$O(^FSC("TASK",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
.K ^FSC("TASK",IEN,99)
.S NUM=1,NAME=$$MIXCASE($P(ZERO,U))
.D SETUP("^FSC(""TASK"",",IEN,NUM,NAME)
.S CNT=0 F S CNT=$O(^FSC("TASK",IEN,2,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
..D SETUP("^FSC(""TASK"",",IEN,NUM,VALUE)
.S ^FSC("TASK",IEN,99,0)="^7106.399^"_NUM_U_NUM
Q
;
SYSTEM ;
N CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
;W !,"NOIS SYSTEM"
K ^FSC("SYSTEM","ACL")
S IEN=0 F S IEN=$O(^FSC("SYSTEM",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
.K ^FSC("SYSTEM",IEN,99)
.S NUM=1,NAME=$$MIXCASE($P(ZERO,U))
.D SETUP("^FSC(""SYSTEM"",",IEN,NUM,NAME)
.S CNT=0 F S CNT=$O(^FSC("SYSTEM",IEN,1,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
..D SETUP("^FSC(""SYSTEM"",",IEN,NUM,VALUE)
.S ^FSC("SYSTEM",IEN,99,0)="^7106.799^"_NUM_U_NUM
Q
;
FIELD ;
N CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
;W !,"NOIS FIELD"
K ^FSC("FLD","ACL")
S IEN=0 F S IEN=$O(^FSC("FLD",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
.K ^FSC("FLD",IEN,99)
.S NUM=1,NAME=$$MIXCASE($P(ZERO,U))
.D SETUP("^FSC(""FLD"",",IEN,NUM,NAME)
.S CNT=0 F S CNT=$O(^FSC("FLD",IEN,1,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
..D SETUP("^FSC(""FLD"",",IEN,NUM,VALUE)
.S ^FSC("FLD",IEN,99,0)="^7107.299^"_NUM_U_NUM
Q
;
SETUP(FILE,IEN,NUM,VALUE) ;
N GBL
S GBL=FILE_IEN_",99,"_NUM_",0)"
S @GBL=VALUE
S GBL=FILE_IEN_",99,""B"","""_VALUE_""","_NUM_")"
S @GBL=""
S GBL=FILE_"""ACL"","""_$$UP^XLFSTR(VALUE)_""","_IEN_","_NUM_")"
S @GBL=""
;W "."
Q
MIXCASE(TEXT) ; $$(text) -> mixed case format
N CHAR
S TEXT=$$LOW^XLFSTR(TEXT)
S $E(TEXT)=$$UP^XLFSTR($E(TEXT))
F CHAR=1:1:$L(TEXT) D
.I " ,-'/(&"[$E(TEXT,CHAR) S $E(TEXT,CHAR+1)=$$UP^XLFSTR($E(TEXT,CHAR+1))
Q TEXT
;
PRI ; populate primary calls with themselves
N CALL,CNT,DA,DIE,DR,X,Y
S CNT=0,DIE="^FSCD(""CALL"","
S CALL=0 F S CALL=$O(^FSCD("CALL",CALL)) Q:CALL<1 I $D(^(CALL,120)) D
.S DA=CALL
.S DR="101///`"_DA
.D ^DIE
.K ^FSCD("CALL",CALL,103)
.S CNT=CNT+1 I CNT#100=0 W "."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCXPOST 5897 printed Jan 18, 2025@03:21:47 Page 2
FSCXPOST ;SLC/STAFF-NOIS Xrefs Client ;9/6/98 22:21
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;;
ALL ; from FSCTASKA
+1 DO SITE
DO OFFICE
DO MOD
DO PACK
DO LTYPE
DO PACKG
DO TASK
DO SYSTEM
DO FIELD
+2 QUIT
+3 ;
SITE ;
+1 NEW ABBREV,CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
+2 ;W !,"NOIS LOCATION"
+3 KILL ^FSC("SITE","ACL")
+4 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("SITE",IEN))
if IEN<1
QUIT
SET ZERO=^(IEN,0)
Begin DoDot:1
+5 KILL ^FSC("SITE",IEN,99)
+6 SET NUM=1
SET NAME=$$MIXCASE($PIECE(ZERO,U))
SET ABBREV=$PIECE(ZERO,U,3)
+7 DO SETUP("^FSC(""SITE"",",IEN,NUM,NAME)
+8 IF $LENGTH(ABBREV)
SET NUM=NUM+1
DO SETUP("^FSC(""SITE"",",IEN,NUM,ABBREV_" - "_NAME)
+9 SET CNT=0
FOR
SET CNT=$ORDER(^FSC("SITE",IEN,2,CNT))
if CNT<1
QUIT
SET SYN=^(CNT,0)
Begin DoDot:2
+10 SET NUM=NUM+1
SET VALUE=$$MIXCASE(SYN_" - "_NAME)
+11 DO SETUP("^FSC(""SITE"",",IEN,NUM,VALUE)
End DoDot:2
+12 SET ^FSC("SITE",IEN,99,0)="^7105.199^"_NUM_U_NUM
End DoDot:1
+13 QUIT
+14 ;
OFFICE ;
+1 NEW CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
+2 ;W !,"NOIS OFFICE"
+3 KILL ^FSC("ISC","ACL")
+4 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("ISC",IEN))
if IEN<1
QUIT
SET ZERO=^(IEN,0)
Begin DoDot:1
+5 KILL ^FSC("ISC",IEN,99)
+6 SET NUM=1
SET NAME=$$MIXCASE($PIECE(ZERO,U))
+7 DO SETUP("^FSC(""ISC"",",IEN,NUM,NAME)
+8 SET CNT=0
FOR
SET CNT=$ORDER(^FSC("ISC",IEN,1,CNT))
if CNT<1
QUIT
SET SYN=^(CNT,0)
Begin DoDot:2
+9 SET NUM=NUM+1
SET VALUE=$$MIXCASE(SYN_" - "_NAME)
+10 DO SETUP("^FSC(""ISC"",",IEN,NUM,VALUE)
End DoDot:2
+11 SET ^FSC("ISC",IEN,99,0)="^7105.399^"_NUM_U_NUM
End DoDot:1
+12 QUIT
+13 ;
MOD ;
+1 NEW CNT,IEN,NAME,NAMECONV,NAMESP,NUM,SYN,VALUE,ZERO
+2 ;W !,"NOIS MODULE/VERSION"
+3 KILL ^FSC("MOD","ACL")
+4 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("MOD",IEN))
if IEN<1
QUIT
SET ZERO=^(IEN,0)
Begin DoDot:1
+5 KILL ^FSC("MOD",IEN,99)
+6 SET NUM=1
SET NAME=$$MIXCASE($PIECE(ZERO,U))
SET NAMECONV=$PIECE(ZERO,U,7)
SET NAMESP=$PIECE(ZERO,U,4)
+7 IF $PIECE(ZERO,U,3)=1
SET NAME=$TRANSLATE(NAME,"/"," ")
+8 IF $PIECE(ZERO,U,3)=2
SET NAME=$TRANSLATE(NAME,"/","+")
+9 IF $PIECE(ZERO,U,3)=3
SET NAME=$TRANSLATE(NAME,"/","-")
+10 DO SETUP("^FSC(""MOD"",",IEN,NUM,NAME)
+11 IF $LENGTH(NAMECONV)
SET NUM=NUM+1
DO SETUP("^FSC(""MOD"",",IEN,NUM,NAMECONV_" - "_NAME)
+12 IF $LENGTH(NAMESP)
SET NUM=NUM+1
DO SETUP("^FSC(""MOD"",",IEN,NUM,NAMESP_" - "_NAME)
+13 SET CNT=0
FOR
SET CNT=$ORDER(^FSC("MOD",IEN,2,CNT))
if CNT<1
QUIT
SET SYN=^(CNT,0)
Begin DoDot:2
+14 SET NUM=NUM+1
SET VALUE=$$MIXCASE(SYN_" - "_NAME)
+15 DO SETUP("^FSC(""MOD"",",IEN,NUM,VALUE)
End DoDot:2
+16 SET ^FSC("MOD",IEN,99,0)="^7105.499^"_NUM_U_NUM
End DoDot:1
+17 QUIT
+18 ;
PACK ;
+1 NEW CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
+2 ;W !,"NOIS PACKAGE"
+3 KILL ^FSC("PACK","ACL")
+4 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("PACK",IEN))
if IEN<1
QUIT
SET ZERO=^(IEN,0)
Begin DoDot:1
+5 KILL ^FSC("PACK",IEN,99)
+6 SET NUM=1
SET NAME=$$MIXCASE($PIECE(ZERO,U))
+7 DO SETUP("^FSC(""PACK"",",IEN,NUM,NAME)
+8 SET CNT=0
FOR
SET CNT=$ORDER(^FSC("PACK",IEN,1,CNT))
if CNT<1
QUIT
SET SYN=^(CNT,0)
Begin DoDot:2
+9 SET NUM=NUM+1
SET VALUE=$$MIXCASE(SYN_" - "_NAME)
+10 DO SETUP("^FSC(""PACK"",",IEN,NUM,VALUE)
End DoDot:2
+11 SET ^FSC("PACK",IEN,99,0)="^7105.599^"_NUM_U_NUM
End DoDot:1
+12 QUIT
+13 ;
LTYPE ;
+1 NEW CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
+2 ;W !,"NOIS LOCATION TYPE"
+3 KILL ^FSC("LTYPE","ACL")
+4 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("LTYPE",IEN))
if IEN<1
QUIT
SET ZERO=^(IEN,0)
Begin DoDot:1
+5 KILL ^FSC("LTYPE",IEN,99)
+6 SET NUM=1
SET NAME=$$MIXCASE($PIECE(ZERO,U))
+7 DO SETUP("^FSC(""LTYPE"",",IEN,NUM,NAME)
+8 SET CNT=0
FOR
SET CNT=$ORDER(^FSC("LTYPE",IEN,1,CNT))
if CNT<1
QUIT
SET SYN=^(CNT,0)
Begin DoDot:2
+9 SET NUM=NUM+1
SET VALUE=$$MIXCASE(SYN_" - "_NAME)
+10 DO SETUP("^FSC(""LTYPE"",",IEN,NUM,VALUE)
End DoDot:2
+11 SET ^FSC("LTYPE",IEN,99,0)="^7105.799^"_NUM_U_NUM
End DoDot:1
+12 QUIT
+13 ;
PACKG ;
+1 NEW CNT,IEN,NAME,NUM,SHNAME,SYN,VALUE,ZERO
+2 ;W !,"NOIS PACKAGE GROUP"
+3 KILL ^FSC("PACKG","ACL")
+4 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("PACKG",IEN))
if IEN<1
QUIT
SET ZERO=^(IEN,0)
Begin DoDot:1
+5 KILL ^FSC("PACKG",IEN,99)
+6 SET NUM=1
SET NAME=$$MIXCASE($PIECE(ZERO,U))
SET SHNAME=$PIECE(ZERO,U,3)
+7 DO SETUP("^FSC(""PACKG"",",IEN,NUM,NAME)
+8 IF $LENGTH(SHNAME)
SET NUM=NUM+1
DO SETUP("^FSC(""PACKG"",",IEN,NUM,SHNAME_" - "_NAME)
+9 SET CNT=0
FOR
SET CNT=$ORDER(^FSC("PACKG",IEN,1,CNT))
if CNT<1
QUIT
SET SYN=^(CNT,0)
Begin DoDot:2
+10 SET NUM=NUM+1
SET VALUE=$$MIXCASE(SYN_" - "_NAME)
+11 DO SETUP("^FSC(""PACKG"",",IEN,NUM,VALUE)
End DoDot:2
+12 SET ^FSC("PACKG",IEN,99,0)="^7105.899^"_NUM_U_NUM
End DoDot:1
+13 QUIT
+14 ;
TASK ;
+1 NEW CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
+2 ;W !,"NOIS TASK"
+3 KILL ^FSC("TASK","ACL")
+4 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("TASK",IEN))
if IEN<1
QUIT
SET ZERO=^(IEN,0)
Begin DoDot:1
+5 KILL ^FSC("TASK",IEN,99)
+6 SET NUM=1
SET NAME=$$MIXCASE($PIECE(ZERO,U))
+7 DO SETUP("^FSC(""TASK"",",IEN,NUM,NAME)
+8 SET CNT=0
FOR
SET CNT=$ORDER(^FSC("TASK",IEN,2,CNT))
if CNT<1
QUIT
SET SYN=^(CNT,0)
Begin DoDot:2
+9 SET NUM=NUM+1
SET VALUE=$$MIXCASE(SYN_" - "_NAME)
+10 DO SETUP("^FSC(""TASK"",",IEN,NUM,VALUE)
End DoDot:2
+11 SET ^FSC("TASK",IEN,99,0)="^7106.399^"_NUM_U_NUM
End DoDot:1
+12 QUIT
+13 ;
SYSTEM ;
+1 NEW CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
+2 ;W !,"NOIS SYSTEM"
+3 KILL ^FSC("SYSTEM","ACL")
+4 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("SYSTEM",IEN))
if IEN<1
QUIT
SET ZERO=^(IEN,0)
Begin DoDot:1
+5 KILL ^FSC("SYSTEM",IEN,99)
+6 SET NUM=1
SET NAME=$$MIXCASE($PIECE(ZERO,U))
+7 DO SETUP("^FSC(""SYSTEM"",",IEN,NUM,NAME)
+8 SET CNT=0
FOR
SET CNT=$ORDER(^FSC("SYSTEM",IEN,1,CNT))
if CNT<1
QUIT
SET SYN=^(CNT,0)
Begin DoDot:2
+9 SET NUM=NUM+1
SET VALUE=$$MIXCASE(SYN_" - "_NAME)
+10 DO SETUP("^FSC(""SYSTEM"",",IEN,NUM,VALUE)
End DoDot:2
+11 SET ^FSC("SYSTEM",IEN,99,0)="^7106.799^"_NUM_U_NUM
End DoDot:1
+12 QUIT
+13 ;
FIELD ;
+1 NEW CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
+2 ;W !,"NOIS FIELD"
+3 KILL ^FSC("FLD","ACL")
+4 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("FLD",IEN))
if IEN<1
QUIT
SET ZERO=^(IEN,0)
Begin DoDot:1
+5 KILL ^FSC("FLD",IEN,99)
+6 SET NUM=1
SET NAME=$$MIXCASE($PIECE(ZERO,U))
+7 DO SETUP("^FSC(""FLD"",",IEN,NUM,NAME)
+8 SET CNT=0
FOR
SET CNT=$ORDER(^FSC("FLD",IEN,1,CNT))
if CNT<1
QUIT
SET SYN=^(CNT,0)
Begin DoDot:2
+9 SET NUM=NUM+1
SET VALUE=$$MIXCASE(SYN_" - "_NAME)
+10 DO SETUP("^FSC(""FLD"",",IEN,NUM,VALUE)
End DoDot:2
+11 SET ^FSC("FLD",IEN,99,0)="^7107.299^"_NUM_U_NUM
End DoDot:1
+12 QUIT
+13 ;
SETUP(FILE,IEN,NUM,VALUE) ;
+1 NEW GBL
+2 SET GBL=FILE_IEN_",99,"_NUM_",0)"
+3 SET @GBL=VALUE
+4 SET GBL=FILE_IEN_",99,""B"","""_VALUE_""","_NUM_")"
+5 SET @GBL=""
+6 SET GBL=FILE_"""ACL"","""_$$UP^XLFSTR(VALUE)_""","_IEN_","_NUM_")"
+7 SET @GBL=""
+8 ;W "."
+9 QUIT
MIXCASE(TEXT) ; $$(text) -> mixed case format
+1 NEW CHAR
+2 SET TEXT=$$LOW^XLFSTR(TEXT)
+3 SET $EXTRACT(TEXT)=$$UP^XLFSTR($EXTRACT(TEXT))
+4 FOR CHAR=1:1:$LENGTH(TEXT)
Begin DoDot:1
+5 IF " ,-'/(&"[$EXTRACT(TEXT,CHAR)
SET $EXTRACT(TEXT,CHAR+1)=$$UP^XLFSTR($EXTRACT(TEXT,CHAR+1))
End DoDot:1
+6 QUIT TEXT
+7 ;
PRI ; populate primary calls with themselves
+1 NEW CALL,CNT,DA,DIE,DR,X,Y
+2 SET CNT=0
SET DIE="^FSCD(""CALL"","
+3 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("CALL",CALL))
if CALL<1
QUIT
IF $DATA(^(CALL,120))
Begin DoDot:1
+4 SET DA=CALL
+5 SET DR="101///`"_DA
+6 DO ^DIE
+7 KILL ^FSCD("CALL",CALL,103)
+8 SET CNT=CNT+1
IF CNT#100=0
WRITE "."
End DoDot:1
+9 QUIT
