XPDANLYZ3 ;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.
;
OPT ;CONSIDER REMOVING
W @IOF,"Select product to perform a basic review of components.",!
N DIRUT K DIR S DIR(0)="S^1:File Analysis;2:Option Analysis;3:Remote Procedure Call (RPC) Analysis;4:KIDS Build"
S DIR("?")="Select the type of product you want analyze"
S DIR("A")="Select product to analyze" D ^DIR I $D(DIRUT) G Q1
N XPDOPT S XPDOPT=Y
D START^XPDANLYZ1(XPDOPT)
Q1 Q
;
RTE1 ;ADD FIRST/SECOND ROUTINE LINES TO DISPLAY
N XPDNN S XPDNN=$O(XPDARR("BUILD",0))
Q:'$D(XPDARR("BUILD",XPDNN,"ROUTINE"))
S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=$TR($J("-",79)," ","-"),XPDCNT=XPDCNT+1,XPDW(XPDCNT)="",XPDCNT=XPDCNT+1,XPDW(XPDCNT)="ROUTINES",XPDHR(XPDCNT)="Routine information"
S XPDCNT=XPDCNT+1,XPDW(XPDCNT)="",XPDCNT=XPDCNT+1,XPDW(XPDCNT)="Routines can be analyzed using ^XINDEX. This section displays"
S XPDCNT=XPDCNT+1,XPDW(XPDCNT)="first two lines of routines so they can be validated."
S XPDCNT=XPDCNT+1,XPDW(XPDCNT)="The third line will be included if it begins with a "";"""
S XPDCNT=XPDCNT+1,XPDW(XPDCNT)="It also lists the date ^XINDEX was last run."
S XPDCNT=XPDCNT+1,XPDW(XPDCNT)="",XPDCNT=XPDCNT+1,XPDW(XPDCNT)="Routine information:"
N XPD99 S XPD99=0 F S XPD99=$O(XPDARR("BUILD",XPDNN,"ROUTINE",XPD99)) Q:'XPD99 D
. S XPDCNT=XPDCNT+1,XPDW(XPDCNT)="" N XPDSP1 S XPDSP1=" "
. N XPDKK S XPDKK=0 F S XPDKK=$O(XPDARR("BUILD",XPDNN,"ROUTINE",XPD99,XPDKK)) Q:'XPDKK S:XPDKK>3 XPDSP1=$J(" ",5) S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=XPDSP1_XPDARR("BUILD",XPDNN,"ROUTINE",XPD99,XPDKK)
N XPDNN S XPDNN=0 F S XPDNN=$O(XPDARR("REMOTE PROCEDURE",XPDNN)) Q:'XPDNN D
. Q:'$D(XPDARR("REMOTE PROCEDURE",XPDNN,"LINE"))
. N XPD99 S XPD99=0 F S XPD99=$O(XPDARR("REMOTE PROCEDURE",XPDNN,"LINE",XPD99)) Q:'XPD99 D
. S XPDCNT=XPDCNT+1,XPDW(XPDCNT)="",XPDCNT=XPDCNT+1,XPDW(XPDCNT)=XPDARR("REMOTE PROCEDURE",XPDNN,"LINE",XPD99)
Q
;
NSST(XPDX1) ;set up components into XPDARR build
N XPDCARR,XPDNOM S XPDNOM=XPDCAR(XPDX1,0)
S XPDARR("BUILD",XPDBIEN,XPDNOM,0)=""
N XPDCIEN,XPDNAM1
N RSF S RSF=0 F S RSF=$O(XPDCAR(XPDX1,RSF)) Q:'RSF S XPDNAM1=XPDCAR(XPDX1,RSF) Q:XPDNAM1']"" D
. I XPDNAM1[" FILE" S XPDNAM1=$$TRIM^XLFSTR($P(XPDNAM1,"FILE"),"R"," ")
. I XPDNOM="APPLICATION ACTION" S XPDCIEN=$O(^DIAC(1.61,"B",XPDNAM1,0))
. I XPDNOM="OPTION" S XPDCIEN=$O(^DIC(19,"B",XPDNAM1,0))
. I XPDNOM="REMOTE PROCEDURE" S XPDCIEN=$O(^XWB(8994,"B",XPDNAM1,0))
. I XPDNOM="BULLETIN" S XPDCIEN=$O(^XMB(3.6,"B",XPDNAM1,0))
. I XPDNOM="MAIL GROUP" S XPDCIEN=$O(^XMB(3.8,"B",XPDNAM1,0))
. I XPDNOM="SECURITY KEY" S XPDCIEN=$O(^DIC(19.1,"B",XPDNAM1,0))
. I XPDNOM="DIALOG" S XPDCIEN=$O(^DI(.84,"B",XPDNAM1,0))
. I XPDNOM="ENTITY" S XPDCIEN=$O(^DDE("B",XPDNAM1,0))
. I XPDNOM="FUNCTION" S XPDCIEN=$O(^DD("FUNC","B",XPDNAM1,0))
. I XPDNOM="FORM" S XPDCIEN=$O(^DIST(.403,"B",XPDNAM1,0))
. I XPDNOM="HELP FRAME" S XPDCIEN=$O(^DIC(9.2,"B",XPDNAM1,0))
. I XPDNOM="HL7 APPLICATION PARAMETER" S XPDCIEN=$O(^HL(771,"B",XPDNAM1,0))
. I XPDNOM="HLO APPLICATION REGISTRY" S XPDCIEN=$O(^HLD(779.2,"B",XPDNAM1,0))
. I XPDNOM="HL LOGICAL LINK" S XPDCIEN=$O(^HLCS(870,"B",XPDNAM1,0))
. I XPDNOM="INPUT TEMPLATE" S XPDCIEN=$O(^DIE("B",XPDNAM1,0))
. I XPDNOM="LIST TEMPLATE" S XPDCIEN=$O(^SD(409.61,"B",XPDNAM1,0))
. I XPDNOM="PARAMETER DEFINITION" S XPDCIEN=$O(^XTV(8989.51,"B",XPDNAM1,0))
. I XPDNOM="PARAMETER TEMPLATE" S XPDCIEN=$O(^XTV(8989.52,"B",XPDNAM1,0))
. I XPDNOM="POLICY" S XPDCIEN=$O(^DIAC(1.6,"B",XPDNAM1,0))
. I XPDNOM="POLICY FUNCTION" S XPDCIEN=$O(^DIAC(1.62,"B",XPDNAM1,0))
. I XPDNOM="PRINT TEMPLATE" S XPDCIEN=$O(^DIPT("B",XPDNAM1,0))
. I XPDNOM="PROTOCOL" S XPDCIEN=$O(^ORD(101,"B",XPDNAM1,0))
. I XPDNOM="SORT TEMPLATE" S XPDCIEN=$O(^DIBT("B",XPDNAM1,0))
. I XPDNOM="XULM LOCK DICTIONARY" S XPDCIEN=$O(^XLM(8993,"B",XPDNAM1,0))
. S XPDARR("BUILD",XPDBIEN,XPDNOM,RSF)=XPDNAM1
. Q:XPDNOM="ROUTINE" ;DEALT WITH DIFFERENTLY: RLINES)
. I XPDCIEN D
.. S XPDCARR(XPDCIEN)=XPDNAM1 S:XPDNAM1'=$$UP^XLFSTR(XPDNAM1) XPDARR(XPDNOM,XPDCIEN,"WARNING","1"_XPDNAM1)="NAME (#.01) should be UPPERCASE." ;XPDNAM1_" must be uppercase."
.. I XPDNOM'="DIALOG",'$$NSPACE^XPDANLYZ6(XPDNAM1) S XPDARR(XPDNOM,XPDCIEN,"WARNING","2"_XPDNAM1)="The "_XPDNOM_" name might be incorrectly namespaced."
.. ;I XPDNOM'="DIALOG",$E(XPDNAM1,1,$L(XPDSPC))'=XPDSPC S XPDARR(XPDNOM,XPDCIEN,"WARNING","2"_XPDNAM1)="The "_XPDNOM_" name might be incorrectly namespaced."
I $D(XPDCARR) D
. I XPDNOM="OPTION" D OCHK^XPDANLYZ2(.XPDCARR) D CEE(.XPDCARR) Q
. I XPDNOM="REMOTE PROCEDURE" D RPC2^XPDANLYZ2(.XPDCARR) Q ;,RPCARR(.XPDCARR) Q
. I XPDNOM="BULLETIN" D BULL^XPDANLYZ3(.XPDCARR) Q
. I XPDNOM="DIALOG" D DIA^XPDANLYZ3(.XPDCARR) Q
. I XPDNOM="HELP FRAME" D SKEY^XPDANLYZ3(.XPDCARR,XPDNOM,XPDX1,"TEXT") Q
. I XPDNOM["TEMPLATE" D TROU(.XPDCARR,XPDNOM,XPDX1) ;ARRAY OF NAMES,TYPE,FILE #
. ;REST BELOW WILL ALL HAVE BASIC DESCRIPTION AND CHECKS. FOR SPECIFICS, NEEDS TO BE BROKEN OUT
. D SKEY^XPDANLYZ3(.XPDCARR,XPDNOM,XPDX1,"DESCRIPTION") ;NAME ARRAY, COMPONENT NAME, COMPONENT FILE NUMBER
Q
;
TROU(XPDTMPT,XPDCX,ZZ) ;TEMPLATE ARRAY OF NAMES
Q:'$D(XPDTMPT) Q:'ZZ ;W !,">>",XPDCX,! ZW XPDTMPT
N JJ,XPDIENS S JJ=0 F S JJ=$O(XPDTMPT(JJ)) Q:'JJ D
. S XPDARR(XPDCX,JJ,"NAME")=XPDTMPT(JJ)
. N TARR S XPDIENS=JJ_"," D GETS^DIQ(ZZ,XPDIENS,"*","DESCRIPTION;ROUTINE INVOKED","TARR")
. I '$D(TARR) S XPDARR(XPDCX,JJ,"DESCRIPT")="No",XPDARR(ZZ,JJ,"WARNING","DESCRIPTION")="DESCRIPTION missing."
. I $D(TARR) D
.. I '$D(TARR(ZZ,XPDIENS,"DESCRIPTION")) S XPDARR(XPDCX,JJ,"DESCRIPT")="No",XPDARR(XPDCX,JJ,"WARNING","DESCRIPTION")="DESCRIPTION missing."
.. I $D(TARR(ZZ,XPDIENS,"DESCRIPTION")) S XPDARR(XPDCX,JJ,"DESCRIPT")="Yes" N LL S LL=0 F S LL=$O(TARR(ZZ,XPDIENS,"DESCRIPTION",LL)) Q:'LL S XPDARR(XPDCX,JJ,"DESCRIPTION",LL)=TARR(ZZ,XPDIENS,"DESCRIPTION",LL)
.. I $D(TARR(ZZ,XPDIENS,"ROUTINE INVOKED")) N RR S RR=$P(TARR(ZZ,XPDIENS,"ROUTINE INVOKED"),"^",2),XPDARR(XPDCX,JJ,"ROUTINE",RR)="ROUTINE INVOKED field (#1815): Calls "_RR
Q
BULL(XPDBULL) ;Bulletin Description
Q:'$D(XPDBULL)
N JJ,XPDIENS S JJ=0 F S JJ=$O(XPDBULL(JJ)) Q:'JJ D
. S XPDARR("BULLETIN",JJ,"NAME")=XPDBULL(JJ)
. N TARR S XPDIENS=JJ_"," D GETS^DIQ(3.6,XPDIENS,"DESCRIPTION","NR","TARR")
. I '$D(TARR) S XPDARR("BULLETIN",JJ,"DESCRIPT")="No",XPDARR("BULLETIN",JJ,"WARNING","DESCRIPTION")="DESCRIPTION field (#6) missing."
. I $D(TARR) D
.. I '$D(TARR(3.6,XPDIENS,"DESCRIPTION")) S XPDARR("BULLETIN",JJ,"DESCRIPT")="No",XPDARR("BULLETIN",JJ,"WARNING","DESCRIPTION")="DESCRIPTION field (#6) missing."
.. I $D(TARR(3.6,XPDIENS,"DESCRIPTION")) S XPDARR("BULLETIN",JJ,"DESCRIPT")="Yes" N LL S LL=0 F S LL=$O(TARR(3.6,XPDIENS,"DESCRIPTION",LL)) Q:'LL S XPDARR("BULLETIN",JJ,"DESCRIPTION",LL)=TARR(3.6,XPDIENS,"DESCRIPTION",LL)
. ;MAIL GROUP
. N XPDMG S XPDMG=$$GET1^DIQ(3.62,"1,"_XPDIENS_",",.01)
. I $G(XPDMG)']"" S XPDARR("BULLETIN",JJ,"WARNING","MAILGROUP")="MAIL GROUP field (#4) missing."
. E S XPDARR("BULLETIN",JJ,"MAILGROUP")=XPDBULL(JJ)_"("_JJ_") - MAIL GROUP: "_XPDMG
Q
CEE(XPDOPTEE) ;CHECK OPTIONS ENTRY/EXIT FOR FILES AND ROUTINES
Q:'$D(XPDOPTEE)
N XPDFILE,XPDTST,XPDON D FILES
N JJJ S JJJ=0 F S JJJ=$O(XPDOPTEE(JJJ)) Q:'JJJ S XPDON=$$GET1^DIQ(19,JJJ,.01) D
. N ENT,EXT,TRARR S ENT=$$GET1^DIQ(19,JJJ,20),EXT=$$GET1^DIQ(19,JJJ,15) ;gets Entry and Exit text from option
. F XPDTST=ENT,EXT D
.. N XPLOC S XPLOC=$S(XPDTST=ENT:"ENTRY ACTION field (#20):",XPDTST=EXT:"EXIT ACTION field (#15):",1:"Entry/Exit field:")
.. N XPEE S XPEE=$S(XPDTST=ENT:"ENT",XPDTST=EXT:"EXT",1:"EE")
.. Q:XPDTST'["^"
.. I XPDTST["$D(^" D
... N XPD7,JK,TTT S XPD7=$L(XPDTST,"$D(") F JK=2:1:XPD7 S TTT=$P($P($P(XPDTST,"$D(",JK),")"),",") I TTT]"" D
.... I $P(TTT,"(",2)'?.NP,$L($P(TTT,"("))>1 S XPOPT(JJJ,XPEE,TTT)=XPLOC_" References the global "_TTT_".",TRARR(TTT)=" " Q
.... S:$L($P(TTT,"(",2))>1 TTT=TTT_"," I $D(XPDFILE(TTT)) S XPOPT(JJJ,XPEE,$P(@(TTT_"0)"),"^"))=XPLOC_" Calls file: "_$P(@(TTT_"0)"),"^")_".",TRARR(TTT)=" " Q
.. I $D(TRARR) S XPDTST=$$REPLACE^XLFSTR(XPDTST,.TRARR)
.. N XPD1,TMP1,TMP S XPD1=$L(XPDTST,"^") F LL=2:1:XPD1 S TMP1=$P($P(XPDTST,"^",LL)," ") D
... Q:TMP1["TMP("
... N XPDF S XPDF="^"_$P(TMP1,",")_"," S:$L($P(XPDF,"(",2))<2 XPDF=$$TRIM^XLFSTR(XPDF,"R",",")
... I $D(XPDFILE(XPDF)) S XPOPT(JJJ,XPEE,$P(@(XPDF_"0)"),"^"))=XPLOC_" Calls file: "_$P(@(XPDF_"0)"),"^")_"." Q ;CHECK FOR FILES
... N XPDME S XPDME=0 I TMP1["(",XPDTST'?.E1(1."D ",1."X ",1."K ",1."G ").E1."^".E S XPDME=1
... N JKL,JS S JS=1,TMP="" I $E(TMP1,1)="%" S TMP="%",JS=2
... F JKL=JS:1:$L(TMP1) Q:'($E(TMP1,JKL)?1(1A,1N).E) S TMP=TMP_$E(TMP1,JKL) ;W ">> ",TMP," "
... I TMP]"",$L(TMP)>1 D
.... I XPDME S XPOPT(JJJ,XPEE,TMP)=XPLOC_" Calls file: "_TMP_"." Q
.... S XPOPT(JJJ,XPEE,TMP)=XPLOC
Q
FILES ;GET ALL FILE GLOBALS
S LL=0 F S LL=$O(^DIC(LL)) Q:'LL N XPD1 S XPD1=$$GET1^DIQ(1,LL,1) S:XPD1]"" XPDFILE(XPD1)=""
Q
;
MG1(XPDMARR) ;GET MAIL GROUP DESCRIPTION
Q:'$D(XPDMARR)
N JJ,XPDIENS S JJ=0 F S JJ=$O(XPDMARR(JJ)) Q:'JJ D
. S XPDARR("MAIL GROUP",JJ,"NAME")=XPDMARR(JJ)
. N TARR S XPDIENS=JJ_"," D GETS^DIQ(3.8,XPDIENS,"DESCRIPTION","NR","TARR")
. I '$D(TARR) S XPDARR("MAIL GROUP",JJ,"DESCRIPT")="No",XPDARR("MAIL GROUP",JJ,"WARNING","DESCRIPTION")="MAIL GROUP "_XPDMARR(JJ)_"("_JJ_") - DESCRIPTION field (#3) missing."
. I $D(TARR) D
.. I '$D(TARR(3.8,XPDIENS,"DESCRIPTION")) S XPDARR("MAIL GROUP",JJ,"DESCRIPT")="No",XPDARR("MAIL GROUP",JJ,"WARNING","DESCRIPTION")="MAIL GROUP "_XPDMARR(JJ)_"("_JJ_") - DESCRIPTION field (#3) missing."
.. I $D(TARR(3.8,XPDIENS,"DESCRIPTION")) S XPDARR("MAIL GROUP",JJ,"DESCRIPT")="Yes" N LL S LL=0 F S LL=$O(TARR(3.8,XPDIENS,"DESCRIPTION",LL)) Q:'LL S XPDARR("MAIL GROUP",JJ,"DESCRIPTION",LL)=TARR(3.8,XPDIENS,"DESCRIPTION",LL)
Q
DIA(XPDIA) ;DIALOG CHECK
Q:'$D(XPDIA)
N JJ,XPDIENS S JJ=0 F S JJ=$O(XPDIA(JJ)) Q:'JJ D
. S XPDARR("DIALOG",JJ,"NAME")=XPDIA(JJ)
. N TARR S XPDIENS=JJ_"," D GETS^DIQ(.84,XPDIENS,"**","NR","TARR")
. I '$D(TARR) S XPDARR("DIALOG",JJ,"DESCRIPT")="No",XPDARR("DIALOG",JJ,"WARNING","DESCRIPTION")="DIALOG "_XPDIA(JJ)_"("_JJ_") - TEXT field (#4) missing."
. I $D(TARR) D
.. I '$D(TARR(.84,XPDIENS,"TEXT")) S XPDARR("DIALOG",JJ,"DESCRIPT")="No",XPDARR("DIALOG",JJ,"WARNING","DESCRIPTION")="DIALOG "_XPDIA(JJ)_"("_JJ_") - TEXT field (#4) missing."
.. I $D(TARR(.84,XPDIENS,"TEXT")) S XPDARR("DIALOG",JJ,"DESCRIPT")="Yes" N LL S LL=0 F S LL=$O(TARR(.84,XPDIENS,"TEXT",LL)) Q:'LL S XPDARR("DIALOG",JJ,"DESCRIPTION",LL)=TARR(.84,XPDIENS,"TEXT",LL)
.. I $D(TARR(.84,XPDIENS,"PACKAGE")),$D(XPDN) S:TARR(.84,XPDIENS,"PACKAGE")'=XPDN XPDARR("DIALOG",JJ,"WARNING","1NMSP")="PACKAGE field (#1.2) entry "_TARR(.84,XPDIENS,"PACKAGE")_" is not the build namespace."
.. I $D(TARR(.841)) N XIEN S XIEN=" " F S XIEN=$O(TARR(.841,XIEN)) Q:XIEN']"" D
... N DRTN S DRTN=TARR(.841,XIEN,"ROUTINE NAME"),XPDARR("DIALOG",JJ,"ROUTINE",DRTN)="ROUTINE NAME (subfield #.01) within the CALLED FROM ENTRY POINTS sub-file (#8) calls "_DRTN_" not found in build."
... ;I $E(DRTN,1,$L(XPDSPC))'=XPDSPC S XPDARR("DIALOG",JJ,"WARNING",DRTN_"Z")="ROUTINE NAME (subfield #.01) within the CALLED FROM ENTRY POINTS sub-file (#8) calls "_DRTN_" not in the patch namespace."
Q
SKEY(XPDGC,XPDCX,XPDXN,DES) ;GENERIC COMPONENT INFO RECEIVING: NAME ARRAY, COMPONENT NAME, COMPONENT FILE NUMBER, DES=DESCRIPTION OR TEXT
Q:'$D(XPDGC) Q:XPDCX']""
N JJ,XPDIENS S JJ=0 F S JJ=$O(XPDGC(JJ)) Q:'JJ D
. S XPDARR(XPDCX,JJ,"NAME")=XPDGC(JJ)
. N TARR S XPDIENS=JJ_"," D GETS^DIQ(XPDXN,XPDIENS,DES,"NR","TARR")
. I '$D(TARR) S XPDARR(XPDCX,JJ,"DESCRIPT")="No",XPDARR(XPDCX,JJ,"WARNING","DESCRIPTION")=DES_" missing."
. I $D(TARR) D
.. I '$D(TARR(XPDXN,XPDIENS,DES)) S XPDARR(XPDCX,JJ,"DESCRIPT")="No",XPDARR(XPDCX,JJ,"WARNING","DESCRIPTION")=DES_" missing."
.. I $D(TARR(XPDXN,XPDIENS,DES)) S XPDARR(XPDCX,JJ,"DESCRIPT")="Yes" N LL S LL=0 F S LL=$O(TARR(XPDXN,XPDIENS,DES,LL)) Q:'LL S XPDARR(XPDCX,JJ,"DESCRIPTION",LL)=TARR(XPDXN,XPDIENS,DES,LL)
Q
;
PDESC ;
W !!,$TR($J("-",79)," ","-"),!!
N DIRUT K DIR S DIR(0)="Y",DIR("B")="YES"
S DIR("A",2)="them into a spell check program, would you like to print them",DIR("A",1)="To review component descriptions and make it easier to copy/paste",DIR("?")="Print descriptions in one place?"
S DIR("A")="at the end of the analysis"
D ^DIR G:$D(DTOUT) X1^XPDANLYZ1 G:$D(DIRUT) X1^XPDANLYZ1
I Y D PRNTME("DESCRIPTION")
Q
PRNTME(PTRM) ;
Q:'$D(PTRM)
W @IOF
N XPDTYP
I XPDRC=1 S XPDTYP="FILE" W "File Descriptions:"
I XPDRC=2 S XPDTYP="OPTION" W "Option Descriptions:"
I XPDRC=3 S XPDTYP="REMOTE PROCEDURE" W "Remote Procedure Call Descriptions:"
;I XPDRC=4 W "Descriptions associated with this build:" N II F II=1:1:CLEN S XPDTYP=$P(XPDCHK,",",II) D PM1
PM1 N TT S TT=0 F S TT=$O(XPDARR(XPDTYP,TT)) Q:'TT D
. ;I XPDTYP="BUILD" D FMSG^XPDANLYZ2(XPDARR(XPDTYP,TT,"NAME")) ;this looks for Forum msg and prints description for spell checking
. W !!,XPDTYP_": ",XPDARR(XPDTYP,TT,"NAME") ;," (#",TT,")"
. I PTRM="DESCRIPTION",XPDARR(XPDTYP,TT,"DESCRIPT")="No" W !,XPDTYP_" missing." Q
. N QQ S QQ=0 F S QQ=$O(XPDARR(XPDTYP,TT,PTRM,QQ)) Q:'QQ W !,XPDARR(XPDTYP,TT,PTRM,QQ)
. I $D(XPDARR("FILE",TT,"FIELD DESCRIPTIONS")) D
.. N UU,PP S (PP,UU)=0 F S UU=$O(XPDARR(XPDTYP,TT,UU)) Q:'UU F S PP=$O(XPDARR(XPDTYP,TT,UU,"DESCRIPTION",PP)) Q:'PP W !,XPDARR(XPDTYP,TT,UU,"DESCRIPTION",PP)
;I XPDRC=4 D PR1 Q
Q
MMT ;SET SPELL CHECK ARRAY
N XCNT S XCNT=0,XCNT=XCNT+1,XPDMM(XCNT)="Descriptions and other text associated with this build (for review and"
S XCNT=XCNT+1,XPDMM(XCNT)="spell check):" N II F II=1:1:CLEN S XPDTYP=$P(XPDCHK,",",II) D
. N TT S TT=0 F S TT=$O(XPDARR(XPDTYP,TT)) Q:'TT D
.. ;I XPDTYP="BUILD" D FMSG^XPDANLYZ2(XPDARR(XPDTYP,TT,"NAME")) ;this looks for Forum msg and prints description for spell checking
.. S XCNT=XCNT+1,XPDMM(XCNT)="",XCNT=XCNT+1,XPDMM(XCNT)="",XCNT=XCNT+1,XPDMM(XCNT)=XPDTYP_": "_XPDARR(XPDTYP,TT,"NAME") ;," (#",TT,")"
.. I XPDARR(XPDTYP,TT,"DESCRIPT")="No" S XCNT=XCNT+1,XPDMM(XCNT)=$J(" ",5)_"* Description missing." Q
.. N QQ S QQ=0 F S QQ=$O(XPDARR(XPDTYP,TT,"DESCRIPTION",QQ)) Q:'QQ S XCNT=XCNT+1,XPDMM(XCNT)=XPDARR(XPDTYP,TT,"DESCRIPTION",QQ)
.. I $D(XPDARR("FILE",TT,"FIELD")) S XCNT=XCNT+1,XPDMM(XCNT)="" D
... N UU,PP,YY S (UU,PP)=" ",YY=-1 F S UU=$O(XPDARR("FILE",TT,"FIELD",UU)) Q:UU']"" S XCNT=XCNT+1,XPDMM(XCNT)="" D
.... F S PP=$O(XPDARR("FILE",TT,"FIELD",UU,PP)) Q:PP']"" S XCNT=XCNT+1 F S YY=$O(XPDARR("FILE",TT,"FIELD",UU,PP,YY)) Q:YY']"" S XCNT=XCNT+1,XPDMM(XCNT)=XPDARR("FILE",TT,"FIELD",UU,PP,YY)
.. I $D(XPDARR("FILE",TT,"FIELD DESCRIPTIONS")) D
... N UU,PP S (PP,UU)=0 F S UU=$O(XPDARR(XPDTYP,TT,UU)) Q:'UU F S PP=$O(XPDARR(XPDTYP,TT,UU,"DESCRIPTION",PP)) Q:'PP S XCNT=XCNT+1,XPDMM(XCNT)=XPDARR(XPDTYP,TT,UU,"DESCRIPTION",PP)
I '$D(XPRSPL) S XCNT=XCNT+1,XPDMM(XCNT)="",XCNT=XCNT+1,XPDMM(XCNT)="*** No routine issues noted. ***" Q
S XCNT=XCNT+1,XPDMM(XCNT)="",XCNT=XCNT+1,XPDMM(XCNT)=$TR($J("=",79)," ","=")
S XCNT=XCNT+1,XPDMM(XCNT)="",XCNT=XCNT+1,XPDMM(XCNT)="Text in ROUTINES between quotes and/or after ;;, by line number:"
N RNME,ONME,CNT S (RNME,ONME)=" ",CNT=0 F S RNME=$O(XPRSPL(RNME)) Q:RNME']"" F S CNT=$O(XPRSPL(RNME,CNT)) Q:'CNT D
. I RNME'=ONME S ONME=RNME S XCNT=XCNT+1,XPDMM(XCNT)="",XCNT=XCNT+1,XPDMM(XCNT)="",XCNT=XCNT+1,XPDMM(XCNT)=RNME
. S XCNT=XCNT+1,XPDMM(XCNT)=XPRSPL(RNME,CNT)
Q
;
;BCHK(XPDR) ;CALLED FROM RLINES^XPDANLYZ2 <-- removed as resource intensive and probably not needed. It checked if routine was in patches not listed on line 2
;N QWE S QWE=0 F S QWE=$O(^XPD(9.6,QWE)) Q:'QWE N XPD1 S XPD1="" F S XPD1=$O(^XPD(9.6,QWE,"KRN",9.8,"NM","B",XPD1)) Q:$G(XPD1)']"" D
;. I XPD1=XPDR,$$GET1^DIQ(9.6,QWE_",",.02)]"" D
;.. N PNUM S PNUM=$$GET1^DIQ(9.6,QWE_",",.01) I X2'[(","_$P(PNUM,"*",3)_",") S:$D(BROU(XPDR)) BROU(XPDR)=BROU(XPDR)_", "_PNUM S:'$D(BROU(XPDR)) BROU(XPDR)=" "_PNUM
;Q
CUT ;CALLED FROM RLINES^XPDANLYZ2
N WMSG,ZZ,CC,ET S ET=0 S WMSG=XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)
C1 N I F I=71,72,73,74 S CC=$E(WMSG,I) I ", "[CC D Q:ET=1
. S XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)=$E(WMSG,1,I),WMSG=$J(" ",20)_$$TRIM^XLFSTR($E(WMSG,(I+1),9999),"L"," ")
. S XPCNT=XPCNT+1
. I $L(WMSG)<74 S XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)=WMSG,ET=1 Q
. E S ET=0 Q
I $L(WMSG)>73 D C1
Q
FADJ(SME,FTXT) ;CALLED FROM PME^XPDANLYZ1
I +$G(SME) S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=" "
I FTXT]"" S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=$J(" ",5)_FTXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDANLYZ3 16791 printed Dec 13, 2024@02:03:09 Page 2
XPDANLYZ3 ;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 ;
OPT ;CONSIDER REMOVING
+1 WRITE @IOF,"Select product to perform a basic review of components.",!
+2 NEW DIRUT
KILL DIR
SET DIR(0)="S^1:File Analysis;2:Option Analysis;3:Remote Procedure Call (RPC) Analysis;4:KIDS Build"
+3 SET DIR("?")="Select the type of product you want analyze"
+4 SET DIR("A")="Select product to analyze"
DO ^DIR
IF $DATA(DIRUT)
GOTO Q1
+5 NEW XPDOPT
SET XPDOPT=Y
+6 DO START^XPDANLYZ1(XPDOPT)
Q1 QUIT
+1 ;
RTE1 ;ADD FIRST/SECOND ROUTINE LINES TO DISPLAY
+1 NEW XPDNN
SET XPDNN=$ORDER(XPDARR("BUILD",0))
+2 if '$DATA(XPDARR("BUILD",XPDNN,"ROUTINE"))
QUIT
+3 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=$TRANSLATE($JUSTIFY("-",79)," ","-")
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)="ROUTINES"
SET XPDHR(XPDCNT)="Routine information"
+4 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)="Routines can be analyzed using ^XINDEX. This section displays"
+5 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)="first two lines of routines so they can be validated."
+6 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)="The third line will be included if it begins with a "";"""
+7 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)="It also lists the date ^XINDEX was last run."
+8 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)="Routine information:"
+9 NEW XPD99
SET XPD99=0
FOR
SET XPD99=$ORDER(XPDARR("BUILD",XPDNN,"ROUTINE",XPD99))
if 'XPD99
QUIT
Begin DoDot:1
+10 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
NEW XPDSP1
SET XPDSP1=" "
+11 NEW XPDKK
SET XPDKK=0
FOR
SET XPDKK=$ORDER(XPDARR("BUILD",XPDNN,"ROUTINE",XPD99,XPDKK))
if 'XPDKK
QUIT
if XPDKK>3
SET XPDSP1=$JUSTIFY(" ",5)
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=XPDSP1_XPDARR("BUILD",XPDNN,"ROUTINE",XPD99,XPDKK)
End DoDot:1
+12 NEW XPDNN
SET XPDNN=0
FOR
SET XPDNN=$ORDER(XPDARR("REMOTE PROCEDURE",XPDNN))
if 'XPDNN
QUIT
Begin DoDot:1
+13 if '$DATA(XPDARR("REMOTE PROCEDURE",XPDNN,"LINE"))
QUIT
+14 NEW XPD99
SET XPD99=0
FOR
SET XPD99=$ORDER(XPDARR("REMOTE PROCEDURE",XPDNN,"LINE",XPD99))
if 'XPD99
QUIT
Begin DoDot:2
End DoDot:2
+15 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=XPDARR("REMOTE PROCEDURE",XPDNN,"LINE",XPD99)
End DoDot:1
+16 QUIT
+17 ;
NSST(XPDX1) ;set up components into XPDARR build
+1 NEW XPDCARR,XPDNOM
SET XPDNOM=XPDCAR(XPDX1,0)
+2 SET XPDARR("BUILD",XPDBIEN,XPDNOM,0)=""
+3 NEW XPDCIEN,XPDNAM1
+4 NEW RSF
SET RSF=0
FOR
SET RSF=$ORDER(XPDCAR(XPDX1,RSF))
if 'RSF
QUIT
SET XPDNAM1=XPDCAR(XPDX1,RSF)
if XPDNAM1']""
QUIT
Begin DoDot:1
+5 IF XPDNAM1[" FILE"
SET XPDNAM1=$$TRIM^XLFSTR($PIECE(XPDNAM1,"FILE"),"R"," ")
+6 IF XPDNOM="APPLICATION ACTION"
SET XPDCIEN=$ORDER(^DIAC(1.61,"B",XPDNAM1,0))
+7 IF XPDNOM="OPTION"
SET XPDCIEN=$ORDER(^DIC(19,"B",XPDNAM1,0))
+8 IF XPDNOM="REMOTE PROCEDURE"
SET XPDCIEN=$ORDER(^XWB(8994,"B",XPDNAM1,0))
+9 IF XPDNOM="BULLETIN"
SET XPDCIEN=$ORDER(^XMB(3.6,"B",XPDNAM1,0))
+10 IF XPDNOM="MAIL GROUP"
SET XPDCIEN=$ORDER(^XMB(3.8,"B",XPDNAM1,0))
+11 IF XPDNOM="SECURITY KEY"
SET XPDCIEN=$ORDER(^DIC(19.1,"B",XPDNAM1,0))
+12 IF XPDNOM="DIALOG"
SET XPDCIEN=$ORDER(^DI(.84,"B",XPDNAM1,0))
+13 IF XPDNOM="ENTITY"
SET XPDCIEN=$ORDER(^DDE("B",XPDNAM1,0))
+14 IF XPDNOM="FUNCTION"
SET XPDCIEN=$ORDER(^DD("FUNC","B",XPDNAM1,0))
+15 IF XPDNOM="FORM"
SET XPDCIEN=$ORDER(^DIST(.403,"B",XPDNAM1,0))
+16 IF XPDNOM="HELP FRAME"
SET XPDCIEN=$ORDER(^DIC(9.2,"B",XPDNAM1,0))
+17 IF XPDNOM="HL7 APPLICATION PARAMETER"
SET XPDCIEN=$ORDER(^HL(771,"B",XPDNAM1,0))
+18 IF XPDNOM="HLO APPLICATION REGISTRY"
SET XPDCIEN=$ORDER(^HLD(779.2,"B",XPDNAM1,0))
+19 IF XPDNOM="HL LOGICAL LINK"
SET XPDCIEN=$ORDER(^HLCS(870,"B",XPDNAM1,0))
+20 IF XPDNOM="INPUT TEMPLATE"
SET XPDCIEN=$ORDER(^DIE("B",XPDNAM1,0))
+21 IF XPDNOM="LIST TEMPLATE"
SET XPDCIEN=$ORDER(^SD(409.61,"B",XPDNAM1,0))
+22 IF XPDNOM="PARAMETER DEFINITION"
SET XPDCIEN=$ORDER(^XTV(8989.51,"B",XPDNAM1,0))
+23 IF XPDNOM="PARAMETER TEMPLATE"
SET XPDCIEN=$ORDER(^XTV(8989.52,"B",XPDNAM1,0))
+24 IF XPDNOM="POLICY"
SET XPDCIEN=$ORDER(^DIAC(1.6,"B",XPDNAM1,0))
+25 IF XPDNOM="POLICY FUNCTION"
SET XPDCIEN=$ORDER(^DIAC(1.62,"B",XPDNAM1,0))
+26 IF XPDNOM="PRINT TEMPLATE"
SET XPDCIEN=$ORDER(^DIPT("B",XPDNAM1,0))
+27 IF XPDNOM="PROTOCOL"
SET XPDCIEN=$ORDER(^ORD(101,"B",XPDNAM1,0))
+28 IF XPDNOM="SORT TEMPLATE"
SET XPDCIEN=$ORDER(^DIBT("B",XPDNAM1,0))
+29 IF XPDNOM="XULM LOCK DICTIONARY"
SET XPDCIEN=$ORDER(^XLM(8993,"B",XPDNAM1,0))
+30 SET XPDARR("BUILD",XPDBIEN,XPDNOM,RSF)=XPDNAM1
+31 ;DEALT WITH DIFFERENTLY: RLINES)
if XPDNOM="ROUTINE"
QUIT
+32 IF XPDCIEN
Begin DoDot:2
+33 ;XPDNAM1_" must be uppercase."
SET XPDCARR(XPDCIEN)=XPDNAM1
if XPDNAM1'=$$UP^XLFSTR(XPDNAM1)
SET XPDARR(XPDNOM,XPDCIEN,"WARNING","1"_XPDNAM1)="NAME (#.01) should be UPPERCASE."
+34 IF XPDNOM'="DIALOG"
IF '$$NSPACE^XPDANLYZ6(XPDNAM1)
SET XPDARR(XPDNOM,XPDCIEN,"WARNING","2"_XPDNAM1)="The "_XPDNOM_" name might be incorrectly namespaced."
+35 ;I XPDNOM'="DIALOG",$E(XPDNAM1,1,$L(XPDSPC))'=XPDSPC S XPDARR(XPDNOM,XPDCIEN,"WARNING","2"_XPDNAM1)="The "_XPDNOM_" name might be incorrectly namespaced."
End DoDot:2
End DoDot:1
+36 IF $DATA(XPDCARR)
Begin DoDot:1
+37 IF XPDNOM="OPTION"
DO OCHK^XPDANLYZ2(.XPDCARR)
DO CEE(.XPDCARR)
QUIT
+38 ;,RPCARR(.XPDCARR) Q
IF XPDNOM="REMOTE PROCEDURE"
DO RPC2^XPDANLYZ2(.XPDCARR)
QUIT
+39 IF XPDNOM="BULLETIN"
DO BULL^XPDANLYZ3(.XPDCARR)
QUIT
+40 IF XPDNOM="DIALOG"
DO DIA^XPDANLYZ3(.XPDCARR)
QUIT
+41 IF XPDNOM="HELP FRAME"
DO SKEY^XPDANLYZ3(.XPDCARR,XPDNOM,XPDX1,"TEXT")
QUIT
+42 ;ARRAY OF NAMES,TYPE,FILE #
IF XPDNOM["TEMPLATE"
DO TROU(.XPDCARR,XPDNOM,XPDX1)
+43 ;REST BELOW WILL ALL HAVE BASIC DESCRIPTION AND CHECKS. FOR SPECIFICS, NEEDS TO BE BROKEN OUT
+44 ;NAME ARRAY, COMPONENT NAME, COMPONENT FILE NUMBER
DO SKEY^XPDANLYZ3(.XPDCARR,XPDNOM,XPDX1,"DESCRIPTION")
End DoDot:1
+45 QUIT
+46 ;
TROU(XPDTMPT,XPDCX,ZZ) ;TEMPLATE ARRAY OF NAMES
+1 ;W !,">>",XPDCX,! ZW XPDTMPT
if '$DATA(XPDTMPT)
QUIT
if 'ZZ
QUIT
+2 NEW JJ,XPDIENS
SET JJ=0
FOR
SET JJ=$ORDER(XPDTMPT(JJ))
if 'JJ
QUIT
Begin DoDot:1
+3 SET XPDARR(XPDCX,JJ,"NAME")=XPDTMPT(JJ)
+4 NEW TARR
SET XPDIENS=JJ_","
DO GETS^DIQ(ZZ,XPDIENS,"*","DESCRIPTION;ROUTINE INVOKED","TARR")
+5 IF '$DATA(TARR)
SET XPDARR(XPDCX,JJ,"DESCRIPT")="No"
SET XPDARR(ZZ,JJ,"WARNING","DESCRIPTION")="DESCRIPTION missing."
+6 IF $DATA(TARR)
Begin DoDot:2
+7 IF '$DATA(TARR(ZZ,XPDIENS,"DESCRIPTION"))
SET XPDARR(XPDCX,JJ,"DESCRIPT")="No"
SET XPDARR(XPDCX,JJ,"WARNING","DESCRIPTION")="DESCRIPTION missing."
+8 IF $DATA(TARR(ZZ,XPDIENS,"DESCRIPTION"))
SET XPDARR(XPDCX,JJ,"DESCRIPT")="Yes"
NEW LL
SET LL=0
FOR
SET LL=$ORDER(TARR(ZZ,XPDIENS,"DESCRIPTION",LL))
if 'LL
QUIT
SET XPDARR(XPDCX,JJ,"DESCRIPTION",LL)=TARR(ZZ,XPDIENS,"DESCRIPTION",LL)
+9 IF $DATA(TARR(ZZ,XPDIENS,"ROUTINE INVOKED"))
NEW RR
SET RR=$PIECE(TARR(ZZ,XPDIENS,"ROUTINE INVOKED"),"^",2)
SET XPDARR(XPDCX,JJ,"ROUTINE",RR)="ROUTINE INVOKED field (#1815): Calls "_RR
End DoDot:2
End DoDot:1
+10 QUIT
BULL(XPDBULL) ;Bulletin Description
+1 if '$DATA(XPDBULL)
QUIT
+2 NEW JJ,XPDIENS
SET JJ=0
FOR
SET JJ=$ORDER(XPDBULL(JJ))
if 'JJ
QUIT
Begin DoDot:1
+3 SET XPDARR("BULLETIN",JJ,"NAME")=XPDBULL(JJ)
+4 NEW TARR
SET XPDIENS=JJ_","
DO GETS^DIQ(3.6,XPDIENS,"DESCRIPTION","NR","TARR")
+5 IF '$DATA(TARR)
SET XPDARR("BULLETIN",JJ,"DESCRIPT")="No"
SET XPDARR("BULLETIN",JJ,"WARNING","DESCRIPTION")="DESCRIPTION field (#6) missing."
+6 IF $DATA(TARR)
Begin DoDot:2
+7 IF '$DATA(TARR(3.6,XPDIENS,"DESCRIPTION"))
SET XPDARR("BULLETIN",JJ,"DESCRIPT")="No"
SET XPDARR("BULLETIN",JJ,"WARNING","DESCRIPTION")="DESCRIPTION field (#6) missing."
+8 IF $DATA(TARR(3.6,XPDIENS,"DESCRIPTION"))
SET XPDARR("BULLETIN",JJ,"DESCRIPT")="Yes"
NEW LL
SET LL=0
FOR
SET LL=$ORDER(TARR(3.6,XPDIENS,"DESCRIPTION",LL))
if 'LL
QUIT
SET XPDARR("BULLETIN",JJ,"DESCRIPTION",LL)=TARR(3.6,XPDIENS,"DESCRIPTION",LL)
End DoDot:2
+9 ;MAIL GROUP
+10 NEW XPDMG
SET XPDMG=$$GET1^DIQ(3.62,"1,"_XPDIENS_",",.01)
+11 IF $GET(XPDMG)']""
SET XPDARR("BULLETIN",JJ,"WARNING","MAILGROUP")="MAIL GROUP field (#4) missing."
+12 IF '$TEST
SET XPDARR("BULLETIN",JJ,"MAILGROUP")=XPDBULL(JJ)_"("_JJ_") - MAIL GROUP: "_XPDMG
End DoDot:1
+13 QUIT
CEE(XPDOPTEE) ;CHECK OPTIONS ENTRY/EXIT FOR FILES AND ROUTINES
+1 if '$DATA(XPDOPTEE)
QUIT
+2 NEW XPDFILE,XPDTST,XPDON
DO FILES
+3 NEW JJJ
SET JJJ=0
FOR
SET JJJ=$ORDER(XPDOPTEE(JJJ))
if 'JJJ
QUIT
SET XPDON=$$GET1^DIQ(19,JJJ,.01)
Begin DoDot:1
+4 ;gets Entry and Exit text from option
NEW ENT,EXT,TRARR
SET ENT=$$GET1^DIQ(19,JJJ,20)
SET EXT=$$GET1^DIQ(19,JJJ,15)
+5 FOR XPDTST=ENT,EXT
Begin DoDot:2
+6 NEW XPLOC
SET XPLOC=$SELECT(XPDTST=ENT:"ENTRY ACTION field (#20):",XPDTST=EXT:"EXIT ACTION field (#15):",1:"Entry/Exit field:")
+7 NEW XPEE
SET XPEE=$SELECT(XPDTST=ENT:"ENT",XPDTST=EXT:"EXT",1:"EE")
+8 if XPDTST'["^"
QUIT
+9 IF XPDTST["$D(^"
Begin DoDot:3
+10 NEW XPD7,JK,TTT
SET XPD7=$LENGTH(XPDTST,"$D(")
FOR JK=2:1:XPD7
SET TTT=$PIECE($PIECE($PIECE(XPDTST,"$D(",JK),")"),",")
IF TTT]""
Begin DoDot:4
+11 IF $PIECE(TTT,"(",2)'?.NP
IF $LENGTH($PIECE(TTT,"("))>1
SET XPOPT(JJJ,XPEE,TTT)=XPLOC_" References the global "_TTT_"."
SET TRARR(TTT)=" "
QUIT
+12 if $LENGTH($PIECE(TTT,"(",2))>1
SET TTT=TTT_","
IF $DATA(XPDFILE(TTT))
SET XPOPT(JJJ,XPEE,$PIECE(@(TTT_"0)"),"^"))=XPLOC_" Calls file: "_$PIECE(@(TTT_"0)"),"^")_"."
SET TRARR(TTT)=" "
QUIT
End DoDot:4
End DoDot:3
+13 IF $DATA(TRARR)
SET XPDTST=$$REPLACE^XLFSTR(XPDTST,.TRARR)
+14 NEW XPD1,TMP1,TMP
SET XPD1=$LENGTH(XPDTST,"^")
FOR LL=2:1:XPD1
SET TMP1=$PIECE($PIECE(XPDTST,"^",LL)," ")
Begin DoDot:3
+15 if TMP1["TMP("
QUIT
+16 NEW XPDF
SET XPDF="^"_$PIECE(TMP1,",")_","
if $LENGTH($PIECE(XPDF,"(",2))<2
SET XPDF=$$TRIM^XLFSTR(XPDF,"R",",")
+17 ;CHECK FOR FILES
IF $DATA(XPDFILE(XPDF))
SET XPOPT(JJJ,XPEE,$PIECE(@(XPDF_"0)"),"^"))=XPLOC_" Calls file: "_$PIECE(@(XPDF_"0)"),"^")_"."
QUIT
+18 NEW XPDME
SET XPDME=0
IF TMP1["("
IF XPDTST'?.E1(1."D ",1."X ",1."K ",1."G ").E1."^".E
SET XPDME=1
+19 NEW JKL,JS
SET JS=1
SET TMP=""
IF $EXTRACT(TMP1,1)="%"
SET TMP="%"
SET JS=2
+20 ;W ">> ",TMP," "
FOR JKL=JS:1:$LENGTH(TMP1)
if '($EXTRACT(TMP1,JKL)?1(1A,1N).E)
QUIT
SET TMP=TMP_$EXTRACT(TMP1,JKL)
+21 IF TMP]""
IF $LENGTH(TMP)>1
Begin DoDot:4
+22 IF XPDME
SET XPOPT(JJJ,XPEE,TMP)=XPLOC_" Calls file: "_TMP_"."
QUIT
+23 SET XPOPT(JJJ,XPEE,TMP)=XPLOC
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT
FILES ;GET ALL FILE GLOBALS
+1 SET LL=0
FOR
SET LL=$ORDER(^DIC(LL))
if 'LL
QUIT
NEW XPD1
SET XPD1=$$GET1^DIQ(1,LL,1)
if XPD1]""
SET XPDFILE(XPD1)=""
+2 QUIT
+3 ;
MG1(XPDMARR) ;GET MAIL GROUP DESCRIPTION
+1 if '$DATA(XPDMARR)
QUIT
+2 NEW JJ,XPDIENS
SET JJ=0
FOR
SET JJ=$ORDER(XPDMARR(JJ))
if 'JJ
QUIT
Begin DoDot:1
+3 SET XPDARR("MAIL GROUP",JJ,"NAME")=XPDMARR(JJ)
+4 NEW TARR
SET XPDIENS=JJ_","
DO GETS^DIQ(3.8,XPDIENS,"DESCRIPTION","NR","TARR")
+5 IF '$DATA(TARR)
SET XPDARR("MAIL GROUP",JJ,"DESCRIPT")="No"
SET XPDARR("MAIL GROUP",JJ,"WARNING","DESCRIPTION")="MAIL GROUP "_XPDMARR(JJ)_"("_JJ_") - DESCRIPTION field (#3) missing."
+6 IF $DATA(TARR)
Begin DoDot:2
+7 IF '$DATA(TARR(3.8,XPDIENS,"DESCRIPTION"))
SET XPDARR("MAIL GROUP",JJ,"DESCRIPT")="No"
SET XPDARR("MAIL GROUP",JJ,"WARNING","DESCRIPTION")="MAIL GROUP "_XPDMARR(JJ)_"("_JJ_") - DESCRIPTION field (#3) missing."
+8 IF $DATA(TARR(3.8,XPDIENS,"DESCRIPTION"))
SET XPDARR("MAIL GROUP",JJ,"DESCRIPT")="Yes"
NEW LL
SET LL=0
FOR
SET LL=$ORDER(TARR(3.8,XPDIENS,"DESCRIPTION",LL))
if 'LL
QUIT
SET XPDARR("MAIL GROUP",JJ,"DESCRIPTION",LL)=TARR(3.8,XPDIENS,"DESCRIPTION",LL)
End DoDot:2
End DoDot:1
+9 QUIT
DIA(XPDIA) ;DIALOG CHECK
+1 if '$DATA(XPDIA)
QUIT
+2 NEW JJ,XPDIENS
SET JJ=0
FOR
SET JJ=$ORDER(XPDIA(JJ))
if 'JJ
QUIT
Begin DoDot:1
+3 SET XPDARR("DIALOG",JJ,"NAME")=XPDIA(JJ)
+4 NEW TARR
SET XPDIENS=JJ_","
DO GETS^DIQ(.84,XPDIENS,"**","NR","TARR")
+5 IF '$DATA(TARR)
SET XPDARR("DIALOG",JJ,"DESCRIPT")="No"
SET XPDARR("DIALOG",JJ,"WARNING","DESCRIPTION")="DIALOG "_XPDIA(JJ)_"("_JJ_") - TEXT field (#4) missing."
+6 IF $DATA(TARR)
Begin DoDot:2
+7 IF '$DATA(TARR(.84,XPDIENS,"TEXT"))
SET XPDARR("DIALOG",JJ,"DESCRIPT")="No"
SET XPDARR("DIALOG",JJ,"WARNING","DESCRIPTION")="DIALOG "_XPDIA(JJ)_"("_JJ_") - TEXT field (#4) missing."
+8 IF $DATA(TARR(.84,XPDIENS,"TEXT"))
SET XPDARR("DIALOG",JJ,"DESCRIPT")="Yes"
NEW LL
SET LL=0
FOR
SET LL=$ORDER(TARR(.84,XPDIENS,"TEXT",LL))
if 'LL
QUIT
SET XPDARR("DIALOG",JJ,"DESCRIPTION",LL)=TARR(.84,XPDIENS,"TEXT",LL)
+9 IF $DATA(TARR(.84,XPDIENS,"PACKAGE"))
IF $DATA(XPDN)
if TARR(.84,XPDIENS,"PACKAGE")'=XPDN
SET XPDARR("DIALOG",JJ,"WARNING","1NMSP")="PACKAGE field (#1.2) entry "_TARR(.84,XPDIENS,"PACKAGE")_" is not the build namespace."
+10 IF $DATA(TARR(.841))
NEW XIEN
SET XIEN=" "
FOR
SET XIEN=$ORDER(TARR(.841,XIEN))
if XIEN']""
QUIT
Begin DoDot:3
+11 NEW DRTN
SET DRTN=TARR(.841,XIEN,"ROUTINE NAME")
SET XPDARR("DIALOG",JJ,"ROUTINE",DRTN)="ROUTINE NAME (subfield #.01) within the CALLED FROM ENTRY POINTS sub-file (#8) calls "_DRTN_" not found in build."
+12 ;I $E(DRTN,1,$L(XPDSPC))'=XPDSPC S XPDARR("DIALOG",JJ,"WARNING",DRTN_"Z")="ROUTINE NAME (subfield #.01) within the CALLED FROM ENTRY POINTS sub-file (#8) calls "_DRTN_" not in the patch namespace."
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
SKEY(XPDGC,XPDCX,XPDXN,DES) ;GENERIC COMPONENT INFO RECEIVING: NAME ARRAY, COMPONENT NAME, COMPONENT FILE NUMBER, DES=DESCRIPTION OR TEXT
+1 if '$DATA(XPDGC)
QUIT
if XPDCX']""
QUIT
+2 NEW JJ,XPDIENS
SET JJ=0
FOR
SET JJ=$ORDER(XPDGC(JJ))
if 'JJ
QUIT
Begin DoDot:1
+3 SET XPDARR(XPDCX,JJ,"NAME")=XPDGC(JJ)
+4 NEW TARR
SET XPDIENS=JJ_","
DO GETS^DIQ(XPDXN,XPDIENS,DES,"NR","TARR")
+5 IF '$DATA(TARR)
SET XPDARR(XPDCX,JJ,"DESCRIPT")="No"
SET XPDARR(XPDCX,JJ,"WARNING","DESCRIPTION")=DES_" missing."
+6 IF $DATA(TARR)
Begin DoDot:2
+7 IF '$DATA(TARR(XPDXN,XPDIENS,DES))
SET XPDARR(XPDCX,JJ,"DESCRIPT")="No"
SET XPDARR(XPDCX,JJ,"WARNING","DESCRIPTION")=DES_" missing."
+8 IF $DATA(TARR(XPDXN,XPDIENS,DES))
SET XPDARR(XPDCX,JJ,"DESCRIPT")="Yes"
NEW LL
SET LL=0
FOR
SET LL=$ORDER(TARR(XPDXN,XPDIENS,DES,LL))
if 'LL
QUIT
SET XPDARR(XPDCX,JJ,"DESCRIPTION",LL)=TARR(XPDXN,XPDIENS,DES,LL)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
PDESC ;
+1 WRITE !!,$TRANSLATE($JUSTIFY("-",79)," ","-"),!!
+2 NEW DIRUT
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="YES"
+3 SET DIR("A",2)="them into a spell check program, would you like to print them"
SET DIR("A",1)="To review component descriptions and make it easier to copy/paste"
SET DIR("?")="Print descriptions in one place?"
+4 SET DIR("A")="at the end of the analysis"
+5 DO ^DIR
if $DATA(DTOUT)
GOTO X1^XPDANLYZ1
if $DATA(DIRUT)
GOTO X1^XPDANLYZ1
+6 IF Y
DO PRNTME("DESCRIPTION")
+7 QUIT
PRNTME(PTRM) ;
+1 if '$DATA(PTRM)
QUIT
+2 WRITE @IOF
+3 NEW XPDTYP
+4 IF XPDRC=1
SET XPDTYP="FILE"
WRITE "File Descriptions:"
+5 IF XPDRC=2
SET XPDTYP="OPTION"
WRITE "Option Descriptions:"
+6 IF XPDRC=3
SET XPDTYP="REMOTE PROCEDURE"
WRITE "Remote Procedure Call Descriptions:"
+7 ;I XPDRC=4 W "Descriptions associated with this build:" N II F II=1:1:CLEN S XPDTYP=$P(XPDCHK,",",II) D PM1
PM1 NEW TT
SET TT=0
FOR
SET TT=$ORDER(XPDARR(XPDTYP,TT))
if 'TT
QUIT
Begin DoDot:1
+1 ;I XPDTYP="BUILD" D FMSG^XPDANLYZ2(XPDARR(XPDTYP,TT,"NAME")) ;this looks for Forum msg and prints description for spell checking
+2 ;," (#",TT,")"
WRITE !!,XPDTYP_": ",XPDARR(XPDTYP,TT,"NAME")
+3 IF PTRM="DESCRIPTION"
IF XPDARR(XPDTYP,TT,"DESCRIPT")="No"
WRITE !,XPDTYP_" missing."
QUIT
+4 NEW QQ
SET QQ=0
FOR
SET QQ=$ORDER(XPDARR(XPDTYP,TT,PTRM,QQ))
if 'QQ
QUIT
WRITE !,XPDARR(XPDTYP,TT,PTRM,QQ)
+5 IF $DATA(XPDARR("FILE",TT,"FIELD DESCRIPTIONS"))
Begin DoDot:2
+6 NEW UU,PP
SET (PP,UU)=0
FOR
SET UU=$ORDER(XPDARR(XPDTYP,TT,UU))
if 'UU
QUIT
FOR
SET PP=$ORDER(XPDARR(XPDTYP,TT,UU,"DESCRIPTION",PP))
if 'PP
QUIT
WRITE !,XPDARR(XPDTYP,TT,UU,"DESCRIPTION",PP)
End DoDot:2
End DoDot:1
+7 ;I XPDRC=4 D PR1 Q
+8 QUIT
MMT ;SET SPELL CHECK ARRAY
+1 NEW XCNT
SET XCNT=0
SET XCNT=XCNT+1
SET XPDMM(XCNT)="Descriptions and other text associated with this build (for review and"
+2 SET XCNT=XCNT+1
SET XPDMM(XCNT)="spell check):"
NEW II
FOR II=1:1:CLEN
SET XPDTYP=$PIECE(XPDCHK,",",II)
Begin DoDot:1
+3 NEW TT
SET TT=0
FOR
SET TT=$ORDER(XPDARR(XPDTYP,TT))
if 'TT
QUIT
Begin DoDot:2
+4 ;I XPDTYP="BUILD" D FMSG^XPDANLYZ2(XPDARR(XPDTYP,TT,"NAME")) ;this looks for Forum msg and prints description for spell checking
+5 ;," (#",TT,")"
SET XCNT=XCNT+1
SET XPDMM(XCNT)=""
SET XCNT=XCNT+1
SET XPDMM(XCNT)=""
SET XCNT=XCNT+1
SET XPDMM(XCNT)=XPDTYP_": "_XPDARR(XPDTYP,TT,"NAME")
+6 IF XPDARR(XPDTYP,TT,"DESCRIPT")="No"
SET XCNT=XCNT+1
SET XPDMM(XCNT)=$JUSTIFY(" ",5)_"* Description missing."
QUIT
+7 NEW QQ
SET QQ=0
FOR
SET QQ=$ORDER(XPDARR(XPDTYP,TT,"DESCRIPTION",QQ))
if 'QQ
QUIT
SET XCNT=XCNT+1
SET XPDMM(XCNT)=XPDARR(XPDTYP,TT,"DESCRIPTION",QQ)
+8 IF $DATA(XPDARR("FILE",TT,"FIELD"))
SET XCNT=XCNT+1
SET XPDMM(XCNT)=""
Begin DoDot:3
+9 NEW UU,PP,YY
SET (UU,PP)=" "
SET YY=-1
FOR
SET UU=$ORDER(XPDARR("FILE",TT,"FIELD",UU))
if UU']""
QUIT
SET XCNT=XCNT+1
SET XPDMM(XCNT)=""
Begin DoDot:4
+10 FOR
SET PP=$ORDER(XPDARR("FILE",TT,"FIELD",UU,PP))
if PP']""
QUIT
SET XCNT=XCNT+1
FOR
SET YY=$ORDER(XPDARR("FILE",TT,"FIELD",UU,PP,YY))
if YY']""
QUIT
SET XCNT=XCNT+1
SET XPDMM(XCNT)=XPDARR("FILE",TT,"FIELD",UU,PP,YY)
End DoDot:4
End DoDot:3
+11 IF $DATA(XPDARR("FILE",TT,"FIELD DESCRIPTIONS"))
Begin DoDot:3
+12 NEW UU,PP
SET (PP,UU)=0
FOR
SET UU=$ORDER(XPDARR(XPDTYP,TT,UU))
if 'UU
QUIT
FOR
SET PP=$ORDER(XPDARR(XPDTYP,TT,UU,"DESCRIPTION",PP))
if 'PP
QUIT
SET XCNT=XCNT+1
SET XPDMM(XCNT)=XPDARR(XPDTYP,TT,UU,"DESCRIPTION",PP)
End DoDot:3
End DoDot:2
End DoDot:1
+13 IF '$DATA(XPRSPL)
SET XCNT=XCNT+1
SET XPDMM(XCNT)=""
SET XCNT=XCNT+1
SET XPDMM(XCNT)="*** No routine issues noted. ***"
QUIT
+14 SET XCNT=XCNT+1
SET XPDMM(XCNT)=""
SET XCNT=XCNT+1
SET XPDMM(XCNT)=$TRANSLATE($JUSTIFY("=",79)," ","=")
+15 SET XCNT=XCNT+1
SET XPDMM(XCNT)=""
SET XCNT=XCNT+1
SET XPDMM(XCNT)="Text in ROUTINES between quotes and/or after ;;, by line number:"
+16 NEW RNME,ONME,CNT
SET (RNME,ONME)=" "
SET CNT=0
FOR
SET RNME=$ORDER(XPRSPL(RNME))
if RNME']""
QUIT
FOR
SET CNT=$ORDER(XPRSPL(RNME,CNT))
if 'CNT
QUIT
Begin DoDot:1
+17 IF RNME'=ONME
SET ONME=RNME
SET XCNT=XCNT+1
SET XPDMM(XCNT)=""
SET XCNT=XCNT+1
SET XPDMM(XCNT)=""
SET XCNT=XCNT+1
SET XPDMM(XCNT)=RNME
+18 SET XCNT=XCNT+1
SET XPDMM(XCNT)=XPRSPL(RNME,CNT)
End DoDot:1
+19 QUIT
+20 ;
+21 ;BCHK(XPDR) ;CALLED FROM RLINES^XPDANLYZ2 <-- removed as resource intensive and probably not needed. It checked if routine was in patches not listed on line 2
+22 ;N QWE S QWE=0 F S QWE=$O(^XPD(9.6,QWE)) Q:'QWE N XPD1 S XPD1="" F S XPD1=$O(^XPD(9.6,QWE,"KRN",9.8,"NM","B",XPD1)) Q:$G(XPD1)']"" D
+23 ;. I XPD1=XPDR,$$GET1^DIQ(9.6,QWE_",",.02)]"" D
+24 ;.. N PNUM S PNUM=$$GET1^DIQ(9.6,QWE_",",.01) I X2'[(","_$P(PNUM,"*",3)_",") S:$D(BROU(XPDR)) BROU(XPDR)=BROU(XPDR)_", "_PNUM S:'$D(BROU(XPDR)) BROU(XPDR)=" "_PNUM
+25 ;Q
CUT ;CALLED FROM RLINES^XPDANLYZ2
+1 NEW WMSG,ZZ,CC,ET
SET ET=0
SET WMSG=XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)
C1 NEW I
FOR I=71,72,73,74
SET CC=$EXTRACT(WMSG,I)
IF ", "[CC
Begin DoDot:1
+1 SET XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)=$EXTRACT(WMSG,1,I)
SET WMSG=$JUSTIFY(" ",20)_$$TRIM^XLFSTR($EXTRACT(WMSG,(I+1),9999),"L"," ")
+2 SET XPCNT=XPCNT+1
+3 IF $LENGTH(WMSG)<74
SET XPDARR("BUILD",XPDBIEN,"ROUTINE",JJ,XPCNT)=WMSG
SET ET=1
QUIT
+4 IF '$TEST
SET ET=0
QUIT
End DoDot:1
if ET=1
QUIT
+5 IF $LENGTH(WMSG)>73
DO C1
+6 QUIT
FADJ(SME,FTXT) ;CALLED FROM PME^XPDANLYZ1
+1 IF +$GET(SME)
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=" "
+2 IF FTXT]""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=$JUSTIFY(" ",5)_FTXT
+3 QUIT
