XPDANLYZ2.m

XPDANLYZ2 ;OAK/RSF- BUILD ANALYZER ;10/28/22

 ;;8.0;KERNEL;**782,792**;Jul 10, 1995;Build 4

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 ;

XREF ;XREF

 Q:'FXX

 S XPDARR("FILE",FXX,"XREF")="No"

 I $D(^DD(FXX,0,"IX")) D

 . S XPDARR("FILE",FXX,"XREF")="Yes"

 . N JJ,LL,MM,RSF S JJ="",(LL,MM)=0 F  S JJ=$O(^DD(FXX,0,"IX",JJ)) Q:$G(JJ)']""  F  S LL=$O(^DD(FXX,0,"IX",JJ,LL)) Q:'$G(LL)  D

 .. F  S MM=$O(^DD(FXX,0,"IX",JJ,LL,MM)) Q:'$G(MM)  D

 ... Q:(JJ="B")  ;&(MM=.01)

 ... N PP S PP=0,RSF="field" F  S PP=$O(^DD(LL,MM,1,PP)) Q:'PP  S:LL'=FXX RSF="subfield "  D

 .... I JJ=$P(^DD(LL,MM,1,PP,0),"^",2),'$D(^DD(LL,MM,1,PP,"%D")) S XPDARR("FILE",FXX,MM,"WARNING","XREF")=$P(^DD(LL,MM,1,PP,0),"^",2)_" cross-reference ("_RSF_" #"_MM_") - DESCRIPTION missing."

 Q

 ;

 ;OPTION

OPTME ;Option Analysis called from START^XPDANLYZ1

 N XPDOARR,KK S KK=0 ;XPDRC=2 IS OPTION

 N DIRUT,Y K DIR S DIR(0)="YO",DIR("A")="Do you want to analyze all options for a namespace"

 S DIR("?")="Will use a range of options whose name starts with a series of letters - usually the namespace (i.e. TIU)"

 D ^DIR I $D(DIRUT) S END=1 Q

 N XPDY S XPDY=Y

G1 I XPDY=0 W ! D

 . N DIC,Y S DIC=19,DIC(0)="QEAM",DIC("A")="Select individual options by name: "

 . D ^DIC I Y=-1 K DIC S XPDY=99,END=1 Q

 . ;I $D(DUOUT) K DIC Q ;-1 LIKE ABOVE

 . I $D(DTOUT) S XPDY=99,END=1 Q

 . I $G(Y)]"" S XPDOARR($P(Y,"^"))=$P(Y,"^",2),KK=KK+1 ;OPTION ien ^ NAME

 G:XPDY=0 G1

 I XPDY=1 N XPDPKG,XPDPKGL D  G:END X1^XPDANLYZ1

 . W ! N DIRUT K DIR S DIR(0)="FO^2:10",DIR("?")="Enter the Package for the options to include"

 . S DIR("A")="Enter the package abbreviation or leading characters of options to include"

 . D ^DIR

 . I $D(DIRUT) S END=1 Q

 . I $G(Y)]"" S XPDPKG=$$UP^XLFSTR(Y),XPDPKGL=$L(XPDPKG) Q:'$G(XPDPKGL)  ;** CONFRIM ALL SHOULD BE UPPERCASE

 . N JJ S JJ="",KK=0 F  S JJ=$O(^DIC(19,"B",JJ)) Q:$G(JJ)']""  I $E(JJ,1,XPDPKGL)=XPDPKG S XPDOARR($O(^DIC(19,"B",JJ,0)))=JJ,KK=KK+1

 I $G(KK)>1 D

 . W !!,"Will check these ",KK," options:"

 . N JJ S JJ=0 F  S JJ=$O(XPDOARR(JJ)) Q:'JJ  W !,?5,XPDOARR(JJ) I ($Y+5)>IOSL D HDR^XPDANLYZ1("Options (continued): ") Q:END

 . W !!,?5,",, WORKING .."

 I $D(XPDOARR) D OCHK(.XPDOARR)

 Q

OCHK(XPDORR) ;setting up information to check OPTIONS ENTRY/EXIT for files and routines.

 N JJ,XPDIENS S JJ=0 F  S JJ=$O(XPDORR(JJ)) Q:'JJ  D

 . N TARR S XPDIENS=JJ_"," D GETS^DIQ(19,XPDIENS,"**","N","TARR")  I $D(TARR) D

 .. S XPDARR("OPTION",JJ,"NAME")=XPDORR(JJ)

 .. I '$D(TARR(19,XPDIENS,3.5)) S XPDARR("OPTION",JJ,"DESCRIPT")="No",XPDARR("OPTION",JJ,"WARNING","DESCRIPTION")="DESCRIPTION field (#3.5) missing."

 .. I $D(TARR(19,XPDIENS,3.5)) S XPDARR("OPTION",JJ,"DESCRIPT")="Yes" N LL S LL=0 F  S LL=$O(TARR(19,XPDIENS,3.5,LL)) Q:'LL  S XPDARR("OPTION",JJ,"DESCRIPTION",LL)=TARR(19,XPDIENS,3.5,LL)

 .. I $D(TARR(19,XPDIENS,1)) S XPDARR("OPTION",JJ,"Menu")=TARR(19,XPDIENS,1)

 .. I '$D(TARR(19,XPDIENS,1)) S XPDARR("OPTION",JJ,"WARNING","MENU TXT")="MENU TEXT field (#1) missing."

 .. I '$D(TARR(19,XPDIENS,12)) S XPDARR("OPTION",JJ,"WARNING","PKG")="PACKAGE field (#12) missing."

 .. I $D(TARR(19,XPDIENS,12)) S XPDARR("OPTION",JJ,"PKG")=TARR(19,XPDIENS,12)

 .. ; 25 IS ROUTINE AND IS TAG^ROUTINE

 .. I $D(TARR(19,XPDIENS,25)) N TT,RR S TT=$L(TARR(19,XPDIENS,25),"^") Q:$G(TT)']""  S RR=$P(TARR(19,XPDIENS,25),"^",TT) S:RR["(" RR=$P(RR,"(") D

 ... S XPOPT(JJ,"ROU",RR)="ROUTINE field(#25):"

 ... ;S XPDARR("OPTION",JJ,"WARNING",RR)="Calls routine "_RR_" not found in build"

 ... ;I $E(RR,1,$L(XPDSPC))'=XPDSPC S XPDARR("OPTION",JJ,"WARNING",RR_"Z")="Calls routine "_RR_" not in patch namespace."

 Q:XPDRC=4

 S XPDCS("OPTION")=19

OPX K DIC Q

 ;

RPCHK ; RPC Analysis called XPDANLYZ1

 N XPDCARR,KK S KK=0 ;XPDRC=4 IS RPC

 N DIRUT K DIR S DIR(0)="YO",DIR("A")="Do you want to analyze all RPCs for a namespace"

 S DIR("?")="Will use a range of RPCs whose name starts with a series of letters - usually the namespace (i.e. TIU)"

 D ^DIR I $D(DIRUT) S END=1 Q

 N XPDY S XPDY=Y

RPC1 I XPDY=0 W ! D

 . N DIC S DIC=8994,DIC(0)="QEAM",DIC("A")="Select individual RPCs by name: "

 . D ^DIC I Y=-1 K DIC S XPDY=99 Q

 . I $D(DTOUT) S XPDY=99 Q

 . I $G(Y)]"" S XPDCARR($P(Y,"^"))=$P(Y,"^",2),KK=KK+1 ;RPC ien ^ NAME

 G:XPDY=0 RPC1

 I XPDY=1 N XPDPKG,XPDPKGL D  G:END X1^XPDANLYZ1

 . W ! N DIRUT K DIR S DIR(0)="FO^2:10",DIR("?")="Enter the Package for the RPCs"

 . S DIR("A")="Enter the package abbreviation or leading characters of RPCs to include"

 . D ^DIR

 . I $D(DIRUT) Q

 . I $G(Y)]"" S XPDPKG=$$UP^XLFSTR(Y),XPDPKGL=$L(XPDPKG) Q:'$G(XPDPKGL)  ;** CONFRIM ALL SHOULD BE UPPERCASE

 . N JJ S JJ="",KK=0 F  S JJ=$O(^XWB(8994,"B",JJ)) Q:$G(JJ)']""  I $E(JJ,1,XPDPKGL)=XPDPKG S XPDCARR($O(^XWB(8994,"B",JJ,0)))=JJ,KK=KK+1

 I $G(KK)>1 D

 . W !!,"Will check these ",KK," Remote Procedure Calls"

 . N JJ S JJ=0 F  S JJ=$O(XPDCARR(JJ)) Q:'JJ  W !,?5,XPDCARR(JJ) I ($Y+5)>IOSL D HDR^XPDANLYZ1("RPC (continued): ") Q:END

 . W !!,?5,",, WORKING .."

 I $D(XPDCARR) D RPC2(.XPDCARR)

 Q

RPC2(XPDRPC) ;^XWB(8994,; Remote Procedure check

 Q:'$D(XPDRPC)

 N JJ,XPDIENS S JJ=0 F  S JJ=$O(XPDRPC(JJ)) Q:'JJ  D

 . N TARR S XPDIENS=JJ_"," D GETS^DIQ(8994,XPDIENS,"**","NR","TARR") I $D(TARR) D

 .. S XPDARR("REMOTE PROCEDURE",JJ,"NAME")=XPDRPC(JJ)

 .. I '$D(TARR(8994,XPDIENS,"DESCRIPTION")) S XPDARR("REMOTE PROCEDURE",JJ,"DESCRIPT")="No",XPDARR("REMOTE PROCEDURE",JJ,"WARNING","DESCRIPTION")="DESCRIPTION field (#1) missing."

 .. I $D(TARR(8994,XPDIENS,"DESCRIPTION")) S XPDARR("REMOTE PROCEDURE",JJ,"DESCRIPT")="Yes" N LL S LL=0 F  S LL=$O(TARR(8994,XPDIENS,"DESCRIPTION",LL)) Q:'LL  S XPDARR("REMOTE PROCEDURE",JJ,"DESCRIPTION",LL)=TARR(8994,XPDIENS,"DESCRIPTION",LL)

 .. ;RETURN PARAMETERS

 .. I $D(TARR(8994,XPDIENS,"RETURN VALUE TYPE")),'$D(TARR(8994,XPDIENS,"RETURN PARAMETER DESCRIPTION")) S XPDARR("REMOTE PROCEDURE",JJ,"WARNING","RETURN DESCRIPTION")="RPC RETURN DESCRIPTION field (#3) missing."

 .. ;INPUT

 .. I $D(^XWB(8994,JJ,2,0)) N XPDIP S XPDIP=$P(^XWB(8994,JJ,2,0),"^",4) Q:$G(XPDIP)<1  D

 ... N MM F MM=1:1:XPDIP I '$D(TARR(8994.02,MM_","_XPDIENS,"DESCRIPTION")) N LL D  ;p792

 .... S LL=MM I '$D(TARR(8994.02,MM_","_XPDIENS)) S LL=$P($O(TARR(8994.02,MM_","_XPDIENS)),",") S:LL="" LL=MM I $D(TARR(8994.02,LL_","_XPDIENS,"DESCRIPTION")) Q

 .... S XPDARR("REMOTE PROCEDURE",JJ,"WARNING","INPUT DESCRIPTION")="RPC Input Description for "_$G(TARR(8994.02,LL_","_XPDIENS,"INPUT PARAMETER"))_" missing."

 .. I $D(TARR(8994,XPDIENS,"ROUTINE")) N RRR S RRR=TARR(8994,XPDIENS,"ROUTINE") D

 ... S XPDARR("REMOTE PROCEDURE",JJ,"ROUTINE",RRR)="Routine field (#.03): Calls "_RRR_" not found in build."

 ... ;I $E(RRR,1,$L(XPDSPC))'=XPDSPC S XPDARR("REMOTE PROCEDURE",JJ,"WARNING",RRR_"Z")="Routine field (#.03): Calls "_RRR_" not in patch namespace."

 Q:XPDRC=4

 S XPDCS("REMOTE PROCEDURE")=8994

RPCX K DIC Q

 ;

SQA(RR) ;Sets SQA CL array XPDARRR

 S XPDARRR("////",RR,0)=""

 S XPDARRR("DIC(0)",RR,0)=""

 S XPDARRR("^UTILITY",RR,0)=""

 S XPDARRR("^TMP",RR,0)=""

 S XPDARRR("^XTMP",RR,0)=""

 S XPDARRR("%",RR,0)=""

 S XPDARRR("$I",RR,0)=""

 S XPDARRR("U=",RR,0)=""

 S XPDARRR("K ^",RR,0)=""

 S XPDARRR("K:",RR,0)=""

 S XPDARRR("K @",RR,0)=""

 S XPDARRR("^(",RR,0)=""

 S XPDARRR("IO",RR,0)=""

 Q

 ;

FMSG(XPDBT) ;

 N XPDUZ S XPDUZ=$G(DUZ) Q:'$G(DUZ)

 K ^TMP("XPDEM",$J)

 N XMCRIT S XMCRIT("SUBJ")=XPDBT

 D LISTMSGS^XMXAPIB(XPDUZ,"*","SUBJ;DATE;F","B",,,.XMCRIT,"^TMP(""XPDEM"",$J)")

 I $D(^TMP("XPDEM",$J)) D

 . N JKL,XPDNIEN S JKL=$O(^TMP("XPDEM",$J,"XMLIST",0)) Q:'$G(JKL)    S XPDNIEN=^TMP("XPDEM",$J,"XMLIST",JKL)

 . ;W !,XPDNIEN

 . N XPDMTXT,XPD,XEND S XPD=$$GET1^DIQ(3.9,288988_",",3,"","XPDMTXT"),XEND=0

 . Q:'$D(XPDMTXT)  Q:'$D(XPDMTXT(.006))

 . ; NOT SURE THIS IS CONSISTENT...Q:XPDMTXT(.006)'["FORUM"

 . W !!,"Description from FORUM patch:",!

 . S JKL=.9 F  S JKL=$O(XPDMTXT(JKL)) Q:('$G(JKL))!(+$G(XEND))!(XPDMTXT(JKL)="Packman Mail Message:")  D  Q:+$G(XEND)

 .. I XPDMTXT(JKL)="$END TXT" S XEND=1 Q

 .. W !,XPDMTXT(JKL)

 Q

 ; 

COMP1 ;SETS THE COMPONENTS USED BY BUILD PROGRAM From <https://www.domain.ext/vdl/documents/Infrastructure/Kernel/krn8_0dg.docx> 

 S XPDCS("APPLICATION ACTION")=1.61

 S XPDCS("BULLETIN")=3.6

 S XPDCS("DIALOG")=.84

 S XPDCS("ENTITY")=1.5

 S XPDCS("FORM")=.403

 S XPDCS("FUNCTION")=.5

 S XPDCS("HELP FRAME")=9.2

 S XPDCS("HL7 APPLICATION PARAMETER")=771

 S XPDCS("HLO APPLICATION REGISTRY")=779.2

 S XPDCS("HL LOGICAL LINK")=870

 ;S XPDCS("HL LOWER LEVEL PROTOCOL")=""

 S XPDCS("INPUT TEMPLATE")=.402

 S XPDCS("LIST TEMPLATE")=409.61

 S XPDCS("MAIL GROUP")=3.8

 S XPDCS("OPTION")=19

 S XPDCS("PARAMETER DEFINITION")=8989.51

 S XPDCS("PARAMETER TEMPLATE")=8989.52

 S XPDCS("POLICY")=1.6

 S XPDCS("POLICY FUNCTION")=1.62

 S XPDCS("PRINT TEMPLATE")=.4

 S XPDCS("PROTOCOL")=101

 S XPDCS("REMOTE PROCEDURE")=8994

 S XPDCS("ROUTINE")=9.8

 S XPDCS("SECURITY KEY")=19.1

 S XPDCS("SORT TEMPLATE")=.401

 S XPDCS("XULM LOCK DICTIONARY")=8993

 Q

 ;

RLINES ;CAPTURES ROUTINE INFO; XPDSQA ARRAY OF SQA ROUTINE LINES

 N JJ,X,RTN,ROU,DIF,XCNP,XPDARRR,XPDPNUM,PNUM,XPCNT,X2,BROU S XPDPNUM=$P(XPDARR("BUILD",XPDBIEN,"NAME"),"*",3),PNUM="",XPCNT=5,XPTL=0

 N TCNT S (JJ,TCNT)=0 F  S JJ=$O(XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ)) Q:'JJ  S ROU=XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ) D

 . S XPCNT=XPCNT+1,XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)=""

 . I ROU'=$$UP^XLFSTR(ROU) S XPCNT=XPCNT+1,XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)="* NAME (#.01) must be in UPPERCASE."  ;ROU

 . D SQA^XPDANLYZ2(JJ)  ;SETS SQA CL ARRAY XPDARRR

 . D RSPELL(ROU) ;SETS SPELL CHECK ARRAY XPRSPL

 . ;I $E(ROU,1,$L(XPDSPC))'=XPDSPC S XPCNT=XPCNT+1,XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)="* "_ROU_" is not in the Package namespace."

 . I '$$NSPACE^XPDANLYZ6(ROU) S XPCNT=XPCNT+1,XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)="* "_ROU_" is not in the Package namespace."

 . N XRIEN S XRIEN=$O(^DIC(9.8,"B",ROU,0)) Q:'XRIEN  D

 .. N XPDINX S XPDINX=$$GET1^DIQ(9.8,XRIEN_",",1.4)

 .. I XPDINX]"" S XPCNT=XPCNT+1,XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)="* Date of Last ^XINDEX: "_XPDINX

 .. I XPDINX']"" S XPCNT=XPCNT+1,XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)="* Date ^XINDEX last run was not found."

 . N X S X=ROU X ^%ZOSF("TEST") Q:'$T

 . K RTN S XCNP=0,DIF="RTN(" X ^%ZOSF("LOAD")

 . N K,SQAC,ZTAG,TCHK S (TCHK,K)=0 F  S K=$O(RTN(K)) Q:'K  D

 .. I $E(RTN(K,0),1)'=" " S ZTAG=$P($P(RTN(K,0)," "),"(")_"^"_K I $L($P(ZTAG,"^"))>XPTL S XPTL=$L($P(ZTAG,"^"))

 .. I K=1 S XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,1)=RTN(K,0) Q

 .. I K=2 D

 ... S XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,2)=RTN(K,0)

 ... N QL S PNUM=$P(RTN(K,0),"**",2),X2=","_PNUM_",",QL=$L(PNUM,",") I $P(PNUM,",",QL)'=XPDPNUM S XPCNT=XPCNT+1,XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)="* Missing current patch number on second line."

 ... ;D BCHK^XPDANLYZ3(ROU) I $D(BROU(ROU)) D  ;RESOURCE INTENSIVE FOR LITTLE USEFUL INFO

 ... ;. S XPCNT=XPCNT+1,XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)="* BUILD file also lists this routine in these patches:"

 ... ;. S XPCNT=XPCNT+1,XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)=BROU(ROU)

 .. I K=3,$E(RTN(K,0),1,6)[";",$L(RTN(K,0))>3,$E(RTN(K,0),1)'?1U S XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,3)=RTN(K,0) ;,XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,4)="" Q

 .. I K>3,$TR($E(RTN(K,0),1,10)," ",".")?."."1";".E Q  ;QUITS IF BEGINS WITH SPACES OR SPACES AND .. FOLLOWED BY ";"

 .. N XPD1,EXT S XPD1=" ",EXT=0 F  S XPD1=$O(XPDARRR(XPD1)) Q:$G(XPD1)']""  D

 ... N TAGME S TAGME=$P(ZTAG,"^")_" +"_(K-$P(ZTAG,"^",2))

 ... I XPD1="K:",RTN(K,0)[XPD1 D KCOLON^XPDANLYZ5(RTN(K,0)) Q

 ... Q:EXT

 ... I XPD1="^XTMP",RTN(K,0)[XPD1 D TMPX^XPDANLYZ5(RTN(K,0)) I 'XPDIS2 Q:TCHK  ;TMPX^ZZSRABA

 ... I XPD1="^TMP",'XPDIS2,RTN(K,0)[XPD1 D TMP^XPDANLYZ5(RTN(K,0)) I 'XPDIS2 Q:TCHK

 ... I (XPD1="K ^"),'XPDIS2,RTN(K,0)[XPD1 S TCHK=$$KCHK^XPDANLYZ5(RTN(K,0),XPD1) Q:TCHK'=3

 ... I (XPD1="%"),'XPDIS2,RTN(K,0)[XPD1 S TCHK=$$MSQA^XPDANLYZ5(RTN(K,0),XPD1) Q:'TCHK  ;$$GCHK^XPDANLYZ5(RTN(K,0),XPD1) D 

 ... I (XPD1="IO"),'XPDIS2,RTN(K,0)[XPD1 S TCHK=$$MSQA^XPDANLYZ5(RTN(K,0),XPD1) Q:'TCHK

 ... I (XPD1="$I"),'XPDIS2,RTN(K,0)[XPD1 S TCHK=$$MSQA^XPDANLYZ5(RTN(K,0),XPD1) Q:'TCHK

 ... I (XPD1="DIC(0)"),'XPDIS2,RTN(K,0)[XPD1 S TCHK=$$MSQA^XPDANLYZ5(RTN(K,0),XPD1) Q:'TCHK

 ... I XPD1="U=",'XPDIS2,(RTN(K,0)["U=""^""")!(RTN(K,0)'?.E1P1"U=") Q

 ... I RTN(K,0)[XPD1 S XPDSQA(ROU,XPD1,K,TAGME)=RTN(K,0) I XTOG S:XPDARRR(XPD1,JJ,0)]"" XPDARRR(XPD1,JJ,0)=XPDARRR(XPD1,JJ,0)_" "_K_"," S:XPDARRR(XPD1,JJ,0)']"" XPDARRR(XPD1,JJ,0)="Lines: "_K_","

 . I XTOG D

 .. S XPCNT=XPCNT+1,XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)="* The SQA Checklist identifies the following specific code "

 .. S XPCNT=XPCNT+1,XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)="  references to check in this routine:",SQAC=XPCNT

 .. N MM S MM=" " F  S MM=$O(XPDARRR(MM)) Q:MM']""  D

 ... I XPDARRR(MM,JJ,0)]"" S XPCNT=XPCNT+1,XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)=$J(MM,8)_$J(" ",5)_$$TRIM^XLFSTR(XPDARRR(MM,JJ,0),"R",",")

 ... I $L(XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT))>73 D CUT^XPDANLYZ3

 .. S:SQAC=XPCNT XPCNT=XPCNT+1,XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)=$J(" ",2)_"-  No specific code references from the SQA Checklist were found."

 . S XPCNT=XPCNT+1,XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)=" "

 . S XPCNT=XPCNT+1,XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)=$$CJ^XLFSTR("<><><>",50)

 Q

RSPELL(ROU) ;FIND TEXT IN ROUTINE BETWEEN QUOTES and after ";;"

 N X S X=ROU X ^%ZOSF("TEST") Q:'$T

 K RTN S XCNP=0,DIF="RTN(" X ^%ZOSF("LOAD")

 N K,CNT S (CNT,K)=0 F  S K=$O(RTN(K)) Q:'K  D

 . I RTN(K,0)[$C(34) N I,XTXT,TMP S TMP=RTN(K,0) F I=2:2:$L(TMP) D

 .. I $TR($E(TMP,1,10)," ",".")?."."1";".E Q  ;DO NOT LOOK AT LINE THAT BEGINS WITH ';'

 .. S XTXT=$$TRIM^XLFSTR($P(TMP,$C(34),I)) I $L(XTXT)>2,XTXT?.E3A.E D

 ... I $L(XTXT)>14,XTXT'[$C(32) Q  ;QUIT IF 15 OR MORE CHARACTERS WITHOUT A SPACE...PROBABLY CODE.

 ... I XTXT[("I "_$P(XTXT," ",2)) Q  ;IF STATEMENT, NOT FOR SPELL CHECK

 ... N J,CLTXT S CLTXT="" I XTXT'[$C(32) Q:$E(XTXT,$L(XTXT))="("  F J=1:1:$L(XTXT) S:$E(XTXT,J)?1A CLTXT=CLTXT_$E(XTXT,J)

 ... I CLTXT]"" I $L(XTXT)>(2*$L(CLTXT)) Q  ;NUMBER,PUNCUATION, FEW LETTERS

 ... Q:TMP[("("_$C(34)_XTXT)  Q:TMP[("$J,"_$C(34)_XTXT)  Q:TMP[(XTXT_$C(34)_",$J")

 ... Q:TMP[("DIC="_$C(34)_XTXT)  Q:TMP[("DIC(0)="_$C(34)_XTXT)  Q:TMP[("DR="_$C(34)_XTXT)  Q:TMP[("DIE="_$C(34)_XTXT)  Q:TMP[("DIC(""S"")="_$C(34)_XTXT)

 ... S XTXT=$J(K,3)_": "_XTXT S:$L(XTXT)<81 CNT=CNT+1,XPRSPL(ROU,CNT)=XTXT

 ... I $L(XTXT)>80 N L1,L2 S L1="",L2="" D LWRAP(XTXT,($L($P(XTXT,":"))+2)) S:L1]"" CNT=CNT+1,XPRSPL(ROU,CNT)=L1 S:L2]"" CNT=CNT+1,XPRSPL(ROU,CNT)=L2

 . I K>2,RTN(K,0)[";;" Q:RTN(K,0)[$C(34)_";;"_$C(34)  Q:$L(RTN(K,0))<5  N XPT81 S XPT81=$J(K,3)_": "_$P(RTN(K,0),";;",2,99) D

 .. S:$L(XPT81)<81 CNT=CNT+1,XPRSPL(ROU,CNT)=XPT81 I $L(XPT81)>80 D

 ... N L1,L2 S L1="",L2="" D LWRAP(XPT81,($L($P(XPT81,":"))+2)) S:L1]"" CNT=CNT+1,XPRSPL(ROU,CNT)=L1 S:L2]"" CNT=CNT+1,XPRSPL(ROU,CNT)=L2

 Q

LWRAP(LTXT,LW) ;

 N T0 S T0=LTXT

 F I=80:-1:60 D  Q:L1]""

 . I $E(T0,I)?1P S L1=$E(T0,1,I),L2=$J(" ",LW)_$E(T0,(I+1),9999)

 . Q:L1]""

 S:L1']"" L1=LTXT

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XPDANLYZ2   15179     printed  Mar 13, 2025@21:08:02                                                                                                                                                                                                  Page 2

XPDANLYZ2 ;OAK/RSF- BUILD ANALYZER ;10/28/22

 +1       ;;8.0;KERNEL;**782,792**;Jul 10, 1995;Build 4

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

XREF      ;XREF

 +1        if 'FXX

               QUIT 

 +2        SET XPDARR("FILE",FXX,"XREF")="No"

 +3        IF $DATA(^DD(FXX,0,"IX"))

               Begin DoDot:1

 +4                SET XPDARR("FILE",FXX,"XREF")="Yes"

 +5                NEW JJ,LL,MM,RSF

                   SET JJ=""

                   SET (LL,MM)=0

                   FOR 

                       SET JJ=$ORDER(^DD(FXX,0,"IX",JJ))

                       if $GET(JJ)']""

                           QUIT 

                       FOR 

                           SET LL=$ORDER(^DD(FXX,0,"IX",JJ,LL))

                           if '$GET(LL)

                               QUIT 

                           Begin DoDot:2

 +6                            FOR 

                                   SET MM=$ORDER(^DD(FXX,0,"IX",JJ,LL,MM))

                                   if '$GET(MM)

                                       QUIT 

                                   Begin DoDot:3

 +7       ;&(MM=.01)

                                       if (JJ="B")

                                           QUIT 

 +8                                    NEW PP

                                       SET PP=0

                                       SET RSF="field"

                                       FOR 

                                           SET PP=$ORDER(^DD(LL,MM,1,PP))

                                           if 'PP

                                               QUIT 

                                           if LL'=FXX

                                               SET RSF="subfield "

                                           Begin DoDot:4

 +9                                            IF JJ=$PIECE(^DD(LL,MM,1,PP,0),"^",2)

                                                   IF '$DATA(^DD(LL,MM,1,PP,"%D"))

                                                       SET XPDARR("FILE",FXX,MM,"WARNING","XREF")=$PIECE(^DD(LL,MM,1,PP,0),"^",2)_" cross-reference ("_RSF_" #"_MM_") - DESCRIPTION missing."

                                           End DoDot:4

                                   End DoDot:3

                           End DoDot:2

               End DoDot:1

 +10       QUIT 

 +11      ;

 +12      ;OPTION

OPTME     ;Option Analysis called from START^XPDANLYZ1

 +1       ;XPDRC=2 IS OPTION

           NEW XPDOARR,KK

           SET KK=0

 +2        NEW DIRUT,Y

           KILL DIR

           SET DIR(0)="YO"

           SET DIR("A")="Do you want to analyze all options for a namespace"

 +3        SET DIR("?")="Will use a range of options whose name starts with a series of letters - usually the namespace (i.e. TIU)"

 +4        DO ^DIR

           IF $DATA(DIRUT)

               SET END=1

               QUIT 

 +5        NEW XPDY

           SET XPDY=Y

G1         IF XPDY=0

               WRITE !

               Begin DoDot:1

 +1                NEW DIC,Y

                   SET DIC=19

                   SET DIC(0)="QEAM"

                   SET DIC("A")="Select individual options by name: "

 +2                DO ^DIC

                   IF Y=-1

                       KILL DIC

                       SET XPDY=99

                       SET END=1

                       QUIT 

 +3       ;I $D(DUOUT) K DIC Q ;-1 LIKE ABOVE

 +4                IF $DATA(DTOUT)

                       SET XPDY=99

                       SET END=1

                       QUIT 

 +5       ;OPTION ien ^ NAME

                   IF $GET(Y)]""

                       SET XPDOARR($PIECE(Y,"^"))=$PIECE(Y,"^",2)

                       SET KK=KK+1

               End DoDot:1

 +6        if XPDY=0

               GOTO G1

 +7        IF XPDY=1

               NEW XPDPKG,XPDPKGL

               Begin DoDot:1

 +8                WRITE !

                   NEW DIRUT

                   KILL DIR

                   SET DIR(0)="FO^2:10"

                   SET DIR("?")="Enter the Package for the options to include"

 +9                SET DIR("A")="Enter the package abbreviation or leading characters of options to include"

 +10               DO ^DIR

 +11               IF $DATA(DIRUT)

                       SET END=1

                       QUIT 

 +12      ;** CONFRIM ALL SHOULD BE UPPERCASE

                   IF $GET(Y)]""

                       SET XPDPKG=$$UP^XLFSTR(Y)

                       SET XPDPKGL=$LENGTH(XPDPKG)

                       if '$GET(XPDPKGL)

                           QUIT 

 +13               NEW JJ

                   SET JJ=""

                   SET KK=0

                   FOR 

                       SET JJ=$ORDER(^DIC(19,"B",JJ))

                       if $GET(JJ)']""

                           QUIT 

                       IF $EXTRACT(JJ,1,XPDPKGL)=XPDPKG

                           SET XPDOARR($ORDER(^DIC(19,"B",JJ,0)))=JJ

                           SET KK=KK+1

               End DoDot:1

               if END

                   GOTO X1^XPDANLYZ1

 +14       IF $GET(KK)>1

               Begin DoDot:1

 +15               WRITE !!,"Will check these ",KK," options:"

 +16               NEW JJ

                   SET JJ=0

                   FOR 

                       SET JJ=$ORDER(XPDOARR(JJ))

                       if 'JJ

                           QUIT 

                       WRITE !,?5,XPDOARR(JJ)

                       IF ($Y+5)>IOSL

                           DO HDR^XPDANLYZ1("Options (continued): ")

                           if END

                               QUIT 

 +17               WRITE !!,?5,",, WORKING .."

               End DoDot:1

 +18       IF $DATA(XPDOARR)

               DO OCHK(.XPDOARR)

 +19       QUIT 

OCHK(XPDORR) ;setting up information to check OPTIONS ENTRY/EXIT for files and routines.

 +1        NEW JJ,XPDIENS

           SET JJ=0

           FOR 

               SET JJ=$ORDER(XPDORR(JJ))

               if 'JJ

                   QUIT 

               Begin DoDot:1

 +2                NEW TARR

                   SET XPDIENS=JJ_","

                   DO GETS^DIQ(19,XPDIENS,"**","N","TARR")

                   IF $DATA(TARR)

                       Begin DoDot:2

 +3                        SET XPDARR("OPTION",JJ,"NAME")=XPDORR(JJ)

 +4                        IF '$DATA(TARR(19,XPDIENS,3.5))

                               SET XPDARR("OPTION",JJ,"DESCRIPT")="No"

                               SET XPDARR("OPTION",JJ,"WARNING","DESCRIPTION")="DESCRIPTION field (#3.5) missing."

 +5                        IF $DATA(TARR(19,XPDIENS,3.5))

                               SET XPDARR("OPTION",JJ,"DESCRIPT")="Yes"

                               NEW LL

                               SET LL=0

                               FOR 

                                   SET LL=$ORDER(TARR(19,XPDIENS,3.5,LL))

                                   if 'LL

                                       QUIT 

                                   SET XPDARR("OPTION",JJ,"DESCRIPTION",LL)=TARR(19,XPDIENS,3.5,LL)

 +6                        IF $DATA(TARR(19,XPDIENS,1))

                               SET XPDARR("OPTION",JJ,"Menu")=TARR(19,XPDIENS,1)

 +7                        IF '$DATA(TARR(19,XPDIENS,1))

                               SET XPDARR("OPTION",JJ,"WARNING","MENU TXT")="MENU TEXT field (#1) missing."

 +8                        IF '$DATA(TARR(19,XPDIENS,12))

                               SET XPDARR("OPTION",JJ,"WARNING","PKG")="PACKAGE field (#12) missing."

 +9                        IF $DATA(TARR(19,XPDIENS,12))

                               SET XPDARR("OPTION",JJ,"PKG")=TARR(19,XPDIENS,12)

 +10      ; 25 IS ROUTINE AND IS TAG^ROUTINE

 +11                       IF $DATA(TARR(19,XPDIENS,25))

                               NEW TT,RR

                               SET TT=$LENGTH(TARR(19,XPDIENS,25),"^")

                               if $GET(TT)']""

                                   QUIT 

                               SET RR=$PIECE(TARR(19,XPDIENS,25),"^",TT)

                               if RR["("

                                   SET RR=$PIECE(RR,"(")

                               Begin DoDot:3

 +12                               SET XPOPT(JJ,"ROU",RR)="ROUTINE field(#25):"

 +13      ;S XPDARR("OPTION",JJ,"WARNING",RR)="Calls routine "_RR_" not found in build"

 +14      ;I $E(RR,1,$L(XPDSPC))'=XPDSPC S XPDARR("OPTION",JJ,"WARNING",RR_"Z")="Calls routine "_RR_" not in patch namespace."

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +15       if XPDRC=4

               QUIT 

 +16       SET XPDCS("OPTION")=19

OPX        KILL DIC

           QUIT 

 +1       ;

RPCHK     ; RPC Analysis called XPDANLYZ1

 +1       ;XPDRC=4 IS RPC

           NEW XPDCARR,KK

           SET KK=0

 +2        NEW DIRUT

           KILL DIR

           SET DIR(0)="YO"

           SET DIR("A")="Do you want to analyze all RPCs for a namespace"

 +3        SET DIR("?")="Will use a range of RPCs whose name starts with a series of letters - usually the namespace (i.e. TIU)"

 +4        DO ^DIR

           IF $DATA(DIRUT)

               SET END=1

               QUIT 

 +5        NEW XPDY

           SET XPDY=Y

RPC1       IF XPDY=0

               WRITE !

               Begin DoDot:1

 +1                NEW DIC

                   SET DIC=8994

                   SET DIC(0)="QEAM"

                   SET DIC("A")="Select individual RPCs by name: "

 +2                DO ^DIC

                   IF Y=-1

                       KILL DIC

                       SET XPDY=99

                       QUIT 

 +3                IF $DATA(DTOUT)

                       SET XPDY=99

                       QUIT 

 +4       ;RPC ien ^ NAME

                   IF $GET(Y)]""

                       SET XPDCARR($PIECE(Y,"^"))=$PIECE(Y,"^",2)

                       SET KK=KK+1

               End DoDot:1

 +5        if XPDY=0