XPDANLYZ4 ;OAK/RSF- BUILD ANALYZER ;10/28/22
;;8.0;KERNEL;**782**;Jul 10, 1995;Build 4
;;Per VHA Directive 2004-038, this routine should not be modified.
;
FCHK(BNUM,XPD) ;FILE CHECK
; BNUM = build number
I $P(^XPD(9.6,BNUM,4,XPD,222),"^",3)="f" D FSEQ(XPD) Q
N FXX,XP1 S XP1=0 F S XP1=$O(^XPD(9.6,BNUM,4,XPD,2,XP1)) Q:'$G(XP1) S FXX=XP1 D
. N J,FLDNUM S (FLDNUM,J)=0 F S J=$O(^XPD(9.6,BNUM,4,XPD,2,XP1,J)) Q:'$G(J) F S FLDNUM=$O(^XPD(9.6,BNUM,4,XPD,2,XP1,J,FLDNUM)) Q:'(FLDNUM) D SDES
Q
FSEQ(FXX) ;
;Get basic file info
N XPDFARR
D FILE^DID(FXX,"","NAME;GLOBAL NAME;DESCRIPTION;DISTRIBUTION PACKAGE","XPDFARR")
;check if name is in capitals:
N CAPS S CAPS=0
I XPDFARR("NAME")'=$$UP^XLFSTR(XPDFARR("NAME")) S CAPS=1 ; if caps=1 not capitalized
S XPDARR("FILE",FXX,"NAME")=XPDFARR("NAME")
S:CAPS XPDARR("FILE",FXX,"WARNING","ANAME")="FILE NAME must be in UPPERCASE." ;XPDFARR("NAME")_" ("_FXX_") must be in UPPERCASE."
;check global
I XPDFARR("GLOBAL NAME")["^DIC" S XPDARR("FILE",FXX,"WARNING","ADIC")=XPDFARR("GLOBAL NAME")
I XPDFARR("GLOBAL NAME")["^DIZ" S XPDARR("FILE",FXX,"WARNING","ADIZ")=XPDFARR("GLOBAL NAME")
;check file description
N XT S XT=$O(XPDFARR("DESCRIPTION"," "),-1) S:'$G(XT) XT=0
N JJ S JJ=0 F S JJ=$O(XPDFARR("DESCRIPTION",JJ)) Q:'JJ S XPDARR("FILE",FXX,"DESCRIPTION",JJ)=XPDFARR("DESCRIPTION",JJ)
I XT=0 S XPDARR("FILE",FXX,"WARNING","DESCRIPTION")="File DESCRIPTION missing.",XPDARR("FILE",FXX,"DESCRIPT")="No"
S:XT=1 XPDARR("FILE",FXX,"WARNING","DESCRIPTION")="File has minimal File description."
S:XT>0 XPDARR("FILE",FXX,"DESCRIPT")="Yes"
I $G(XPDFARR("DISTRIBUTION PACKAGE"))]"" S XPDARR("FILE",FXX,"PKG")=XPDFARR("DISTRIBUTION PACKAGE")
I $G(XPDFARR("DISTRIBUTION PACKAGE"))']"" S XPDARR("FILE",FXX,"WARNING","PACKAGE")="DISTRIBUTION PACKAGE is not defined for this file."
;ZW XPDARR
;check fields for help prompt, description, name
N FCNT,ICNT S (FCNT,ICNT)=0
N FNM1,FLD1 S FLD1=0,FNM1="" F S FNM1=$O(^DD(FXX,"B",FNM1)) Q:FNM1']"" F S FLD1=$O(^DD(FXX,"B",FNM1,FLD1)) Q:'FLD1 D
. N XPFF1 D FIELD^DID(FXX,FLD1,"","LABEL;HELP-PROMPT;DESCRIPTION","XPFF1") Q:'$D(XPFF1)
. N FNN S FNN=FNM1_" (#"_FLD1_")"
. S XPDARR("FILE",FXX,"FIELD",FNN,"AA",0)=" Field - "_FNN_":"
. I '$D(XPFF1("DESCRIPTION")) S XPDARR("FILE",FXX,"FIELD",FNN,"DESCRIPTION",0)=" Description missing."
. I $D(XPFF1("DESCRIPTION")) S XPDARR("FILE",FXX,"FIELD",FNN,"DESCRIPTION",0)=" Description:" D
.. N JJ S JJ=0 F S JJ=$O(XPFF1("DESCRIPTION",JJ)) Q:'JJ S XPDARR("FILE",FXX,"FIELD",FNN,"DESCRIPTION",JJ)=$J(" ",5)_XPFF1("DESCRIPTION",JJ)
. I '$D(XPFF1("HELP-PROMPT")) S XPDARR("FILE",FXX,"FIELD",FNN,"HELP-PROMPT",0)=" Help-Prompt: missing."
. I $D(XPFF1("HELP-PROMPT")) S XPDARR("FILE",FXX,"FIELD",FNN,"HELP-PROMPT",0)=" Help-Prompt:" D
.. N HTXT S HTXT=XPFF1("HELP-PROMPT") I $L(HTXT)<75 S XPDARR("FILE",FXX,"FIELD",FNN,"HELP-PROMPT",1)=$J(" ",5)_HTXT
.. I $L(HTXT)>74 N HPARR D CUTL(74,HTXT) I $D(HPARR) S XPDARR("FILE",FXX,"FIELD",FNN,"HELP-PROMPT",1)=$J(" ",5)_HPARR(1),XPDARR("FILE",FXX,"FIELD",FNN,"HELP-PROMPT",2)=$J(" ",5)_HPARR(2)
; xref check
D XREF^XPDANLYZ2
;SUBFILE CHECK
N XPDSARR,XPDSUB S XPDSUB=0 I $D(^DD(FXX,"SB")) F S XPDSUB=$O(^DD(FXX,"SB",XPDSUB)) Q:'XPDSUB D
. S XPDSARR($O(^DD(FXX,"SB",XPDSUB,0)))=XPDSUB
. N FLDNUM,FLDARR S FLDNUM=0 F S FLDNUM=$O(^DD(XPDSUB,FLDNUM)) Q:'FLDNUM D
.. D FIELD^DID(XPDSUB,FLDNUM,"","LABEL;HELP-PROMPT;DESCRIPTION;EXECUTABLE HELP","FLDARR") Q:'$D(FLDARR)
.. S FCNT=FCNT+1,CAPS=0
.. N FNAME S FNAME=FLDARR("LABEL") I FNAME'=$$UP^XLFSTR(FNAME) S CAPS=1
.. S:CAPS XPDARR("FILE",FXX,FLDNUM,"WARNING","NAME")=FNAME_" (# "_FLDNUM_") should be UPPERCASE."
.. S:FLDARR("HELP-PROMPT")']"" XPDARR("FILE",FXX,FLDNUM,"WARNING","HELP-PROMPT")=FNAME_" (#"_FLDNUM_") - Help Prompt missing.",XPDARR("FILE",FXX,"FIELD",FNAME,"HELP-PROMPT",0)=" Help Prompt missing."
.. S:FLDARR("DESCRIPTION")']"" XPDARR("FILE",FXX,FLDNUM,"WARNING","DESCRIPTION")=FNAME_" (#"_FLDNUM_") - Field Description missing.",XPDARR("FILE",FXX,"FIELD",FNAME,"DESCRIPTION",0)=" Description missing."
.. S XPDARR("FILE",FXX,"FIELD",FNAME,"AA",0)=" "_FNAME_" (#"_FLDNUM_"):"
.. I FLDARR("HELP-PROMPT")]"" S XPDARR("FILE",FXX,"FIELD",FNAME,"HELP-PROMPT",0)=" Help Prompt:" D
... N HTXT S HTXT=FLDARR("HELP-PROMPT") I $L(HTXT)<75 S XPDARR("FILE",FXX,"FIELD",FNAME,"HELP-PROMPT",1)=$J(" ",5)_HTXT
... I $L(HTXT)>74 N HPARR D CUTL(74,HTXT) I $D(HPARR) S XPDARR("FILE",FXX,"FIELD",FNAME,"HELP-PROMPT",1)=$J(" ",5)_HPARR(1),XPDARR("FILE",FXX,"FIELD",FNAME,"HELP-PROMPT",2)=$J(" ",5)_HPARR(2)
.. I FLDARR("DESCRIPTION")]"" S XPDARR("FILE",FXX,"FIELD",FNAME,"DESCRIPTION",0)=" Field Description:" D
... N JJ S JJ=0 F S JJ=$O(FLDARR("DESCRIPTION",JJ)) Q:'JJ S XPDARR("FILE",FXX,"FIELD",FNAME,"DESCRIPTION",JJ)=$J(" ",5)_FLDARR("DESCRIPTION",JJ)
.. I FLDARR("HELP-PROMPT")]"",FLDARR("DESCRIPTION")]"" D
... N SHP,SDES S SHP=$TR(FLDARR("HELP-PROMPT")," ",""),SDES=" "
... N KK S KK=0 F S KK=$O(FLDARR("DESCRIPTION",KK)) Q:'KK S SDES=SDES_" "_FLDARR("DESCRIPTION",KK)
... S SDES=$TR(SDES," ","")
... I SDES=SHP S XPDARR("FILE",FXX,FLDNUM,"WARNING","Duplicate")=FNAME_" (#"_FLDNUM_") - Help and Description are identical"
.. I $D(XPDARR("FILE",FXX,FLDNUM)) S ICNT=ICNT+1
. I $D(XPDARR("FILE",FXX,FLDNUM)) S ICNT=ICNT+1
I ICNT>0 S XPDARR("FILE",FXX,"FIELD-WARNING")=""
K FXX
Q
;
SDES ;gets build description
N XPDFLD,FXX1 S XPDFLD=0 ;
TA K XPDFARR D FILE^DID(FXX,"","NAME","XPDFARR")
I '$D(XPDFARR) S FXX1=FXX,FXX=^DD(FXX,0,"UP"),XPDFLD=XPDFLD+1 Q:$G(XPDFLD)>1 G TA
S XPDARR("FILE",FXX,"NAME")=XPDFARR("NAME")
I '$G(FXX1) S FXX1=FXX
K FLDARR D FIELD^DID(FXX1,FLDNUM,"","*","FLDARR") ;D FIELD^DID(FXX,FLDNUM,"","LABEL;HELP-PROMPT;DESCRIPTION","FLDARR")
Q:'$D(FLDARR)
N CAPS S CAPS=0 ;FCNT=FCNT+1,
N FNAME,FNN S FNAME=FLDARR("LABEL"),FNN=FNAME_" (#"_FLDNUM_")" I FNAME'=$$UP^XLFSTR(FNAME) S CAPS=1
S:CAPS XPDARR("FILE",FXX,FLDNUM,"WARNING","NAME")="NAME (#.01) should be UPPERCASE." ;FNAME_" (# "_FLDNUM_") should be UPPERCASE."
S:FLDARR("HELP-PROMPT")']"" XPDARR("FILE",FXX,FLDNUM,"WARNING","HELP-PROMPT")=FNN_" - Help Prompt missing.",XPDARR("FILE",FXX,"FIELD-WARNING")=""
S:FLDARR("DESCRIPTION")']"" XPDARR("FILE",FXX,FLDNUM,"WARNING","DESCRIPTION")=FNN_" - Field Description missing.",XPDARR("FILE",FXX,"DESCRIPT")="No",XPDARR("FILE",FXX,"FIELD-WARNING")=""
I FLDARR("HELP-PROMPT")]"",FLDARR("DESCRIPTION")]"" D
. N SHP,SDES S SHP=$TR(FLDARR("HELP-PROMPT")," ",""),SDES=" "
. N KK S KK=0 F S KK=$O(FLDARR("DESCRIPTION",KK)) Q:'KK S SDES=SDES_" "_FLDARR("DESCRIPTION",KK)
. S SDES=$TR(SDES," ","")
. I SDES=SHP S XPDARR("FILE",FXX,FLDNUM,"WARNING","Duplicate")=FNN_" - Help and Description are identical"
I FLDARR("DESCRIPTION")]"" D
. S XPDARR("FILE",FXX,"DESCRIPT")="Yes"
. S XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",.1)=""
. N XTXT S XTXT="FIELD: " S:FXX'=FXX1 XTXT="SUBFILE "_FXX1_"; FIELD: "
. S XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",.5)=XTXT_FLDNUM_": "_FLDARR("LABEL"),XPDARR("FILE",FXX,"DESCRIPT")="Yes"
. N JJ S JJ=0 F S JJ=$O(FLDARR("DESCRIPTION",JJ)) Q:'JJ S XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",JJ)=FLDARR("DESCRIPTION",JJ)
;ADDING HELP-PROMPT AND TECH DESCRIPTION UNDER DESCRIPTION FOR SPELL CHECK FUNCTION
N XXP S XXP=$O(XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",999),-1) I '$G(XXP) S XXP=0
I FLDARR("HELP-PROMPT")']"" S XXP=XXP+1,XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",XXP)="HELP-PROMPT: missing."
I FLDARR("HELP-PROMPT")]"" D
. S XXP=XXP+1,XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",XXP)="HELP-PROMPT:",XXP=XXP+1,XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",XXP)=FLDARR("HELP-PROMPT")
I XXP>0 S XPDARR("FILE",FXX,"FIELD DESCRIPTIONS")=""
I FLDARR("TECHNICAL DESCRIPTION")]"" D
. S XXP=XXP+1,XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",XXP)="TECHNICAL DESCRIPTION:" D
.. N JJ S JJ=0 S JJ=$O(FLDARR("DESCRIPTION",JJ)) Q:'JJ S XXP=XXP+JJ,XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",XXP)=FLDARR("TECHNICAL DESCRIPTION",JJ)
K FLDARR
Q
;File Analysis FILENUM is called from START^XPDANLYZ1 with file as the choice
FILENUM ; ;get a file number (either from a BUILD check, or from a file range or from an individual file check)
W ! N DIRUT K DIR S DIR(0)="LCA^2:9999999.99:2",DIR("A")="Enter file number(s) separated by commas, or a range like 130-139.99: "
D ^DIR I $D(DIRUT) S END=1 Q
N FNUM S FNUM=$$TRIM^XLFSTR(Y,"R",",") ;DIR adds a comma at the end of the string
I '+$G(FNUM) S END=1 Q
N FARR,FSTRL S FSTRL=$L(FNUM,",") N K F K=1:1:FSTRL S:$P(FNUM,",",K)'["-" FARR("S",K)=$P(FNUM,",",K) S:$P(FNUM,",",K)["-" FARR("R",K)=$P(FNUM,",",K)
N FF,J F K="S","R" I $D(FARR(K)) S FF=0 F S FF=$O(FARR(K,FF)) Q:'FF D FILECHK(FARR(K,FF),K)
K DIR ;S XTFS=FSTRL
Q
FILECHK(FIEN,INX) ;INX=s is single file number, = R is a range of files
I INX="S" D FSEQ(+FIEN)
I INX="R" N FSTART,FEND S FSTART=$P(FIEN,"-")-.1,FEND=$P(FIEN,"-",2) I +$G(FSTART),+$G(FEND) D
. F S FSTART=$O(^DIC(FSTART)) Q:('+FSTART)!(FSTART>FEND) D FSEQ(FSTART)
Q
CUTL(LEN,XLINE) ;LEN IS LENGTH TO CUT NEAR, XLINE IS THE LINE TO CUT
N T1,T2 S T1="",T2=""
N I F I=LEN:-1:(LEN-20) D Q:T1]""
. I $E(XLINE,I)?1P S T1=$E(XLINE,1,I),T2=$E(XLINE,(I+1),9999) Q
. Q:T1]""
Q:T1']""
S HPARR(1)=T1,HPARR(2)=T2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDANLYZ4 9324 printed Apr 09, 2024@21:18:12 Page 2
XPDANLYZ4 ;OAK/RSF- BUILD ANALYZER ;10/28/22
+1 ;;8.0;KERNEL;**782**;Jul 10, 1995;Build 4
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
FCHK(BNUM,XPD) ;FILE CHECK
+1 ; BNUM = build number
+2 IF $PIECE(^XPD(9.6,BNUM,4,XPD,222),"^",3)="f"
DO FSEQ(XPD)
QUIT
+3 NEW FXX,XP1
SET XP1=0
FOR
SET XP1=$ORDER(^XPD(9.6,BNUM,4,XPD,2,XP1))
if '$GET(XP1)
QUIT
SET FXX=XP1
Begin DoDot:1
+4 NEW J,FLDNUM
SET (FLDNUM,J)=0
FOR
SET J=$ORDER(^XPD(9.6,BNUM,4,XPD,2,XP1,J))
if '$GET(J)
QUIT
FOR
SET FLDNUM=$ORDER(^XPD(9.6,BNUM,4,XPD,2,XP1,J,FLDNUM))
if '(FLDNUM)
QUIT
DO SDES
End DoDot:1
+5 QUIT
FSEQ(FXX) ;
+1 ;Get basic file info
+2 NEW XPDFARR
+3 DO FILE^DID(FXX,"","NAME;GLOBAL NAME;DESCRIPTION;DISTRIBUTION PACKAGE","XPDFARR")
+4 ;check if name is in capitals:
+5 NEW CAPS
SET CAPS=0
+6 ; if caps=1 not capitalized
IF XPDFARR("NAME")'=$$UP^XLFSTR(XPDFARR("NAME"))
SET CAPS=1
+7 SET XPDARR("FILE",FXX,"NAME")=XPDFARR("NAME")
+8 ;XPDFARR("NAME")_" ("_FXX_") must be in UPPERCASE."
if CAPS
SET XPDARR("FILE",FXX,"WARNING","ANAME")="FILE NAME must be in UPPERCASE."
+9 ;check global
+10 IF XPDFARR("GLOBAL NAME")["^DIC"
SET XPDARR("FILE",FXX,"WARNING","ADIC")=XPDFARR("GLOBAL NAME")
+11 IF XPDFARR("GLOBAL NAME")["^DIZ"
SET XPDARR("FILE",FXX,"WARNING","ADIZ")=XPDFARR("GLOBAL NAME")
+12 ;check file description
+13 NEW XT
SET XT=$ORDER(XPDFARR("DESCRIPTION"," "),-1)
if '$GET(XT)
SET XT=0
+14 NEW JJ
SET JJ=0
FOR
SET JJ=$ORDER(XPDFARR("DESCRIPTION",JJ))
if 'JJ
QUIT
SET XPDARR("FILE",FXX,"DESCRIPTION",JJ)=XPDFARR("DESCRIPTION",JJ)
+15 IF XT=0
SET XPDARR("FILE",FXX,"WARNING","DESCRIPTION")="File DESCRIPTION missing."
SET XPDARR("FILE",FXX,"DESCRIPT")="No"
+16 if XT=1
SET XPDARR("FILE",FXX,"WARNING","DESCRIPTION")="File has minimal File description."
+17 if XT>0
SET XPDARR("FILE",FXX,"DESCRIPT")="Yes"
+18 IF $GET(XPDFARR("DISTRIBUTION PACKAGE"))]""
SET XPDARR("FILE",FXX,"PKG")=XPDFARR("DISTRIBUTION PACKAGE")
+19 IF $GET(XPDFARR("DISTRIBUTION PACKAGE"))']""
SET XPDARR("FILE",FXX,"WARNING","PACKAGE")="DISTRIBUTION PACKAGE is not defined for this file."
+20 ;ZW XPDARR
+21 ;check fields for help prompt, description, name
+22 NEW FCNT,ICNT
SET (FCNT,ICNT)=0
+23 NEW FNM1,FLD1
SET FLD1=0
SET FNM1=""
FOR
SET FNM1=$ORDER(^DD(FXX,"B",FNM1))
if FNM1']""
QUIT
FOR
SET FLD1=$ORDER(^DD(FXX,"B",FNM1,FLD1))
if 'FLD1
QUIT
Begin DoDot:1
+24 NEW XPFF1
DO FIELD^DID(FXX,FLD1,"","LABEL;HELP-PROMPT;DESCRIPTION","XPFF1")
if '$DATA(XPFF1)
QUIT
+25 NEW FNN
SET FNN=FNM1_" (#"_FLD1_")"
+26 SET XPDARR("FILE",FXX,"FIELD",FNN,"AA",0)=" Field - "_FNN_":"
+27 IF '$DATA(XPFF1("DESCRIPTION"))
SET XPDARR("FILE",FXX,"FIELD",FNN,"DESCRIPTION",0)=" Description missing."
+28 IF $DATA(XPFF1("DESCRIPTION"))
SET XPDARR("FILE",FXX,"FIELD",FNN,"DESCRIPTION",0)=" Description:"
Begin DoDot:2
+29 NEW JJ
SET JJ=0
FOR
SET JJ=$ORDER(XPFF1("DESCRIPTION",JJ))
if 'JJ
QUIT
SET XPDARR("FILE",FXX,"FIELD",FNN,"DESCRIPTION",JJ)=$JUSTIFY(" ",5)_XPFF1("DESCRIPTION",JJ)
End DoDot:2
+30 IF '$DATA(XPFF1("HELP-PROMPT"))
SET XPDARR("FILE",FXX,"FIELD",FNN,"HELP-PROMPT",0)=" Help-Prompt: missing."
+31 IF $DATA(XPFF1("HELP-PROMPT"))
SET XPDARR("FILE",FXX,"FIELD",FNN,"HELP-PROMPT",0)=" Help-Prompt:"
Begin DoDot:2
+32 NEW HTXT
SET HTXT=XPFF1("HELP-PROMPT")
IF $LENGTH(HTXT)<75
SET XPDARR("FILE",FXX,"FIELD",FNN,"HELP-PROMPT",1)=$JUSTIFY(" ",5)_HTXT
+33 IF $LENGTH(HTXT)>74
NEW HPARR
DO CUTL(74,HTXT)
IF $DATA(HPARR)
SET XPDARR("FILE",FXX,"FIELD",FNN,"HELP-PROMPT",1)=$JUSTIFY(" ",5)_HPARR(1)
SET XPDARR("FILE",FXX,"FIELD",FNN,"HELP-PROMPT",2)=$JUSTIFY(" ",5)_HPARR(2)
End DoDot:2
End DoDot:1
+34 ; xref check
+35 DO XREF^XPDANLYZ2
+36 ;SUBFILE CHECK
+37 NEW XPDSARR,XPDSUB
SET XPDSUB=0
IF $DATA(^DD(FXX,"SB"))
FOR
SET XPDSUB=$ORDER(^DD(FXX,"SB",XPDSUB))
if 'XPDSUB
QUIT
Begin DoDot:1
+38 SET XPDSARR($ORDER(^DD(FXX,"SB",XPDSUB,0)))=XPDSUB
+39 NEW FLDNUM,FLDARR
SET FLDNUM=0
FOR
SET FLDNUM=$ORDER(^DD(XPDSUB,FLDNUM))
if 'FLDNUM
QUIT
Begin DoDot:2
+40 DO FIELD^DID(XPDSUB,FLDNUM,"","LABEL;HELP-PROMPT;DESCRIPTION;EXECUTABLE HELP","FLDARR")
if '$DATA(FLDARR)
QUIT
+41 SET FCNT=FCNT+1
SET CAPS=0
+42 NEW FNAME
SET FNAME=FLDARR("LABEL")
IF FNAME'=$$UP^XLFSTR(FNAME)
SET CAPS=1
+43 if CAPS
SET XPDARR("FILE",FXX,FLDNUM,"WARNING","NAME")=FNAME_" (# "_FLDNUM_") should be UPPERCASE."
+44 if FLDARR("HELP-PROMPT")']""
SET XPDARR("FILE",FXX,FLDNUM,"WARNING","HELP-PROMPT")=FNAME_" (#"_FLDNUM_") - Help Prompt missing."
SET XPDARR("FILE",FXX,"FIELD",FNAME,"HELP-PROMPT",0)=" Help Prompt missing."
+45 if FLDARR("DESCRIPTION")']""
SET XPDARR("FILE",FXX,FLDNUM,"WARNING","DESCRIPTION")=FNAME_" (#"_FLDNUM_") - Field Description missing."
SET XPDARR("FILE",FXX,"FIELD",FNAME,"DESCRIPTION",0)=" Description missing."
+46 SET XPDARR("FILE",FXX,"FIELD",FNAME,"AA",0)=" "_FNAME_" (#"_FLDNUM_"):"
+47 IF FLDARR("HELP-PROMPT")]""
SET XPDARR("FILE",FXX,"FIELD",FNAME,"HELP-PROMPT",0)=" Help Prompt:"
Begin DoDot:3
+48 NEW HTXT
SET HTXT=FLDARR("HELP-PROMPT")
IF $LENGTH(HTXT)<75
SET XPDARR("FILE",FXX,"FIELD",FNAME,"HELP-PROMPT",1)=$JUSTIFY(" ",5)_HTXT
+49 IF $LENGTH(HTXT)>74
NEW HPARR
DO CUTL(74,HTXT)
IF $DATA(HPARR)
SET XPDARR("FILE",FXX,"FIELD",FNAME,"HELP-PROMPT",1)=$JUSTIFY(" ",5)_HPARR(1)
SET XPDARR("FILE",FXX,"FIELD",FNAME,"HELP-PROMPT",2)=$JUSTIFY(" ",5)_HPARR(2)
End DoDot:3
+50 IF FLDARR("DESCRIPTION")]""
SET XPDARR("FILE",FXX,"FIELD",FNAME,"DESCRIPTION",0)=" Field Description:"
Begin DoDot:3
+51 NEW JJ
SET JJ=0
FOR
SET JJ=$ORDER(FLDARR("DESCRIPTION",JJ))
if 'JJ
QUIT
SET XPDARR("FILE",FXX,"FIELD",FNAME,"DESCRIPTION",JJ)=$JUSTIFY(" ",5)_FLDARR("DESCRIPTION",JJ)
End DoDot:3
+52 IF FLDARR("HELP-PROMPT")]""
IF FLDARR("DESCRIPTION")]""
Begin DoDot:3
+53 NEW SHP,SDES
SET SHP=$TRANSLATE(FLDARR("HELP-PROMPT")," ","")
SET SDES=" "
+54 NEW KK
SET KK=0
FOR
SET KK=$ORDER(FLDARR("DESCRIPTION",KK))
if 'KK
QUIT
SET SDES=SDES_" "_FLDARR("DESCRIPTION",KK)
+55 SET SDES=$TRANSLATE(SDES," ","")
+56 IF SDES=SHP
SET XPDARR("FILE",FXX,FLDNUM,"WARNING","Duplicate")=FNAME_" (#"_FLDNUM_") - Help and Description are identical"
End DoDot:3
+57 IF $DATA(XPDARR("FILE",FXX,FLDNUM))
SET ICNT=ICNT+1
End DoDot:2
+58 IF $DATA(XPDARR("FILE",FXX,FLDNUM))
SET ICNT=ICNT+1
End DoDot:1
+59 IF ICNT>0
SET XPDARR("FILE",FXX,"FIELD-WARNING")=""
+60 KILL FXX
+61 QUIT
+62 ;
SDES ;gets build description
+1 ;
NEW XPDFLD,FXX1
SET XPDFLD=0
TA KILL XPDFARR
DO FILE^DID(FXX,"","NAME","XPDFARR")
+1 IF '$DATA(XPDFARR)
SET FXX1=FXX
SET FXX=^DD(FXX,0,"UP")
SET XPDFLD=XPDFLD+1
if $GET(XPDFLD)>1
QUIT
GOTO TA
+2 SET XPDARR("FILE",FXX,"NAME")=XPDFARR("NAME")
+3 IF '$GET(FXX1)
SET FXX1=FXX
+4 ;D FIELD^DID(FXX,FLDNUM,"","LABEL;HELP-PROMPT;DESCRIPTION","FLDARR")
KILL FLDARR
DO FIELD^DID(FXX1,FLDNUM,"","*","FLDARR")
+5 if '$DATA(FLDARR)
QUIT
+6 ;FCNT=FCNT+1,
NEW CAPS
SET CAPS=0
+7 NEW FNAME,FNN
SET FNAME=FLDARR("LABEL")
SET FNN=FNAME_" (#"_FLDNUM_")"
IF FNAME'=$$UP^XLFSTR(FNAME)
SET CAPS=1
+8 ;FNAME_" (# "_FLDNUM_") should be UPPERCASE."
if CAPS
SET XPDARR("FILE",FXX,FLDNUM,"WARNING","NAME")="NAME (#.01) should be UPPERCASE."
+9 if FLDARR("HELP-PROMPT")']""
SET XPDARR("FILE",FXX,FLDNUM,"WARNING","HELP-PROMPT")=FNN_" - Help Prompt missing."
SET XPDARR("FILE",FXX,"FIELD-WARNING")=""
+10 if FLDARR("DESCRIPTION")']""
SET XPDARR("FILE",FXX,FLDNUM,"WARNING","DESCRIPTION")=FNN_" - Field Description missing."
SET XPDARR("FILE",FXX,"DESCRIPT")="No"
SET XPDARR("FILE",FXX,"FIELD-WARNING")=""
+11 IF FLDARR("HELP-PROMPT")]""
IF FLDARR("DESCRIPTION")]""
Begin DoDot:1
+12 NEW SHP,SDES
SET SHP=$TRANSLATE(FLDARR("HELP-PROMPT")," ","")
SET SDES=" "
+13 NEW KK
SET KK=0
FOR
SET KK=$ORDER(FLDARR("DESCRIPTION",KK))
if 'KK
QUIT
SET SDES=SDES_" "_FLDARR("DESCRIPTION",KK)
+14 SET SDES=$TRANSLATE(SDES," ","")
+15 IF SDES=SHP
SET XPDARR("FILE",FXX,FLDNUM,"WARNING","Duplicate")=FNN_" - Help and Description are identical"
End DoDot:1
+16 IF FLDARR("DESCRIPTION")]""
Begin DoDot:1
+17 SET XPDARR("FILE",FXX,"DESCRIPT")="Yes"
+18 SET XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",.1)=""
+19 NEW XTXT
SET XTXT="FIELD: "
if FXX'=FXX1
SET XTXT="SUBFILE "_FXX1_"; FIELD: "
+20 SET XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",.5)=XTXT_FLDNUM_": "_FLDARR("LABEL")
SET XPDARR("FILE",FXX,"DESCRIPT")="Yes"
+21 NEW JJ
SET JJ=0
FOR
SET JJ=$ORDER(FLDARR("DESCRIPTION",JJ))
if 'JJ
QUIT
SET XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",JJ)=FLDARR("DESCRIPTION",JJ)
End DoDot:1
+22 ;ADDING HELP-PROMPT AND TECH DESCRIPTION UNDER DESCRIPTION FOR SPELL CHECK FUNCTION
+23 NEW XXP
SET XXP=$ORDER(XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",999),-1)
IF '$GET(XXP)
SET XXP=0
+24 IF FLDARR("HELP-PROMPT")']""
SET XXP=XXP+1
SET XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",XXP)="HELP-PROMPT: missing."
+25 IF FLDARR("HELP-PROMPT")]""
Begin DoDot:1
+26 SET XXP=XXP+1
SET XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",XXP)="HELP-PROMPT:"
SET XXP=XXP+1
SET XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",XXP)=FLDARR("HELP-PROMPT")
End DoDot:1
+27 IF XXP>0
SET XPDARR("FILE",FXX,"FIELD DESCRIPTIONS")=""
+28 IF FLDARR("TECHNICAL DESCRIPTION")]""
Begin DoDot:1
+29 SET XXP=XXP+1
SET XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",XXP)="TECHNICAL DESCRIPTION:"
Begin DoDot:2
+30 NEW JJ
SET JJ=0
SET JJ=$ORDER(FLDARR("DESCRIPTION",JJ))
if 'JJ
QUIT
SET XXP=XXP+JJ
SET XPDARR("FILE",FXX,FLDNUM,"DESCRIPTION",XXP)=FLDARR("TECHNICAL DESCRIPTION",JJ)
End DoDot:2
End DoDot:1
+31 KILL FLDARR
+32 QUIT
+33 ;File Analysis FILENUM is called from START^XPDANLYZ1 with file as the choice
FILENUM ; ;get a file number (either from a BUILD check, or from a file range or from an individual file check)
+1 WRITE !
NEW DIRUT
KILL DIR
SET DIR(0)="LCA^2:9999999.99:2"
SET DIR("A")="Enter file number(s) separated by commas, or a range like 130-139.99: "
+2 DO ^DIR
IF $DATA(DIRUT)
SET END=1
QUIT
+3 ;DIR adds a comma at the end of the string
NEW FNUM
SET FNUM=$$TRIM^XLFSTR(Y,"R",",")
+4 IF '+$GET(FNUM)
SET END=1
QUIT
+5 NEW FARR,FSTRL
SET FSTRL=$LENGTH(FNUM,",")
NEW K
FOR K=1:1:FSTRL
if $PIECE(FNUM,",",K)'["-"
SET FARR("S",K)=$PIECE(FNUM,",",K)
if $PIECE(FNUM,",",K)["-"
SET FARR("R",K)=$PIECE(FNUM,",",K)
+6 NEW FF,J
FOR K="S","R"
IF $DATA(FARR(K))
SET FF=0
FOR
SET FF=$ORDER(FARR(K,FF))
if 'FF
QUIT
DO FILECHK(FARR(K,FF),K)
+7 ;S XTFS=FSTRL
KILL DIR
+8 QUIT
FILECHK(FIEN,INX) ;INX=s is single file number, = R is a range of files
+1 IF INX="S"
DO FSEQ(+FIEN)
+2 IF INX="R"
NEW FSTART,FEND
SET FSTART=$PIECE(FIEN,"-")-.1
SET FEND=$PIECE(FIEN,"-",2)
IF +$GET(FSTART)
IF +$GET(FEND)
Begin DoDot:1
+3 FOR
SET FSTART=$ORDER(^DIC(FSTART))
if ('+FSTART)!(FSTART>FEND)
QUIT
DO FSEQ(FSTART)
End DoDot:1
+4 QUIT
CUTL(LEN,XLINE) ;LEN IS LENGTH TO CUT NEAR, XLINE IS THE LINE TO CUT
+1 NEW T1,T2
SET T1=""
SET T2=""
+2 NEW I
FOR I=LEN:-1:(LEN-20)
Begin DoDot:1
+3 IF $EXTRACT(XLINE,I)?1P
SET T1=$EXTRACT(XLINE,1,I)
SET T2=$EXTRACT(XLINE,(I+1),9999)
QUIT
+4 if T1]""
QUIT
End DoDot:1
if T1]""
QUIT
+5 if T1']""
QUIT
+6 SET HPARR(1)=T1
SET HPARR(2)=T2
+7 QUIT
