XPDANLYZ6 ;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.
;
BUILDME ;Ask for build and build user choices on the type of report when running the option
; Called from line START^XPDANLYZ1
N X,Y D COMP1^XPDANLYZ2 ;SETS COMPONENT ARRAY XPDCS
S XPPATH=$$PWD^%ZISH()
W @IOF,!,"This tool is used to analyze and list the components of a build to identify",!,"adherence to standards and best practices.",!! ;p732
S XPDLINE="Analysis of a KIDS BUILD" ;XPDBN is the build patch name and XPDCS is a set of all components
N DIRUT,DIC S DIC=9.6,DIC(0)="QEAM",DIC("A")="Select Build Name: "
D ^DIC I Y=-1 K DIC S END=1 Q
I $D(DIRUT) K DIC S END=1 Q
I $G(Y)]"" S XPDTOP=Y ;BUILD ien ^ NAME, 11045^SRA*3.0*1
S XPDBIEN=$P(XPDTOP,"^")
Q:'+XPDBIEN
S XPDARR("BUILD",XPDBIEN,"NAME")=$P(XPDTOP,"^",2)
S:$P(XPDTOP,"^",2)["*" XPDSPC=$P($P(XPDTOP,"^",2),"*"),XPNS(XPDSPC)=""
S:$P(XPDTOP,"^",2)'["*" XPDSPC=$P($P(XPDTOP,"^",2)," "),XPDSPC=$$TRIM^XLFSTR(XPDSPC),XPNS(XPDSPC)="" ;p792
S PFL=$$GET1^DIQ(9.6,XPDBIEN_",",1,"I") I PFL?.N S PFL=$$GET1^DIQ(9.6,XPDBIEN_",",1,"E")
I $G(PFL)]"",$G(XPDSPC)']"" S XPDSPC=PFL,XPNS(XPDSPC)=""
;I $G(PFL)="",$G(XPDSPC)="" S:$P(XPDTOP,"^",2)[" " XPDSPC=$P($P(XPDTOP,"^",2)," "),XPNS(XPDSPC)="" ;p792
N XPNSM,J S J=" " F S J=$O(^XPD(9.6,XPDBIEN,"ABNS","B",J)) Q:J']"" S XPNSM(J)="",XPNS(J)="" ;BUILD CROSS REF
N XPDLL S XPDLL=$O(^DIC(9.4,"C",XPDSPC,9999),-1) S:'$G(XPDLL) XPDLL=$O(^DIC(9.4,"C2",XPDSPC,0))
I XPDLL D ;D GETS^DIQ(9.4,XPDLL_",","14*","I","XPNS") ;DIC(9.4 - package file
. N J S J=" " F S J=$O(^DIC(9.4,XPDLL,14,"B",J)) Q:J']"" S XPNS(J)=""
. S J=0 F S J=$O(^DIC(9.4,XPDLL,"EX",J)) Q:'J S XPEX(^DIC(9.4,XPDLL,"EX",J,0))=""
S XPDN=PFL I $G(XPDN)']"" S XPDN=$$GET1^DIQ(9.4,XPDLL_",",.01)
I $D(XPNSM),'$D(XPNSM(XPDSPC)) W !!,"*** Warning: BUILD namespace not consistent with PACKAGE NAMESPACE OR",!,"PREFIX (#23) field of BUILD file."
I '$G(XPDSPC),'$D(XPNS) W !!,"*** Warning: No namespace found for this build. ****"
I $G(XPDSPC)]"" W !!,"Namespace: ",XPDSPC,!,"Package: ",$G(XPDN)
I XPDIS2 S XPQR=1 G TX1
N Y W !! N DIRUT K DIR S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="specific code references reviewed on the SQA checklist",DIR("A",1)="Do you want to include a section that displays the routine lines containing"
S DIR("?",1)="The analysis report always displays the routine and line numbers that",DIR("?",2)="include specific code references that are checked as part of the SQA"
S DIR("?",3)="Checklist.",DIR("?",4)=""
S DIR("?",5)="Enter YES if you want the analysis report to include a detailed",DIR("?")="display of the code contained on those lines."
D ^DIR S:$D(DTOUT) END=1 S:$D(DIRUT) END=1 Q:END
S XPQR=Y
TX1 W !! N DIRUT K DIR,Y S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="and text found in routines",DIR("A",1)="Do you want to include a section that displays the component descriptions"
S DIR("?",1)="Enter YES if you want the analysis report to include a display of the"
S DIR("?",2)="descriptions for each component included in the build and text within"
S DIR("?",3)="the routines included. This additional display can be copied into another"
S DIR("?")="product (like MS WORD) to do a spell check."
D ^DIR S:$D(DTOUT) END=1 S:$D(DIRUT) END=1 Q:END
S XPDR=Y
W !!,"Analysis Results Display Choices:"
W !!,"1. Print the Report"
W !,"2. Create the Report in .TXT Files"
W !,"3. Send the Report in MailMan Messages"
W ! K DIR,Y S DIR(0)="N^1:3"
S DIR("?")="captured into text files, or compiled into MailMan messages.",DIR("?",1)="Enter your preference for displaying the findings. Reports can be printed,"
S DIR("A")="Select number"
D ^DIR S:$D(DTOUT) END=1 S:$D(DIRUT) END=1 Q:END
S XPDIS=Y I XPDIS=1 H .5 W " . " H .5 W ". " H .5 W "." W !
N XPDIENS S XPDIENS=XPDBIEN_","
N TARR D GINFO("9.6",XPDIENS,"3","TARR") ;GET DESCRIPTION ARRAY
I '$D(TARR(9.6,XPDIENS,3)) S XPDARR("BUILD",XPDBIEN,"DESCRIPT")="No",XPDARR("BUILD",XPDBIEN,"WARNING","DESCRIPTION")="BUILD "_$P(XPDTOP,"^",2)_"("_XPDBIEN_") - DESCRIPTION field (#3) missing."
I $D(TARR(9.6,XPDIENS,3)) D
. S XPDARR("BUILD",XPDBIEN,"DESCRIPT")="Yes" N LL S LL=0 F S LL=$O(TARR(9.6,XPDIENS,3,LL)) Q:'LL S XPDARR("BUILD",XPDBIEN,"DESCRIPTION",LL)=TARR(9.6,XPDIENS,3,LL)
; FILES
N LL
I $D(^XPD(9.6,XPDBIEN,4,"B")) S LL=0 F S LL=$O(^XPD(9.6,XPDBIEN,4,"B",LL)) Q:'LL!($P(^XPD(9.6,XPDBIEN,4,0),"^",4)<1) S XPDARR("BUILD",XPDBIEN,"FILES",LL)="" D FCHK^XPDANLYZ4(XPDBIEN,LL)
S LL=0 F S LL=$O(^XPD(9.6,XPDBIEN,"KRN","B",LL)) Q:'LL I $D(^XPD(9.6,XPDBIEN,"KRN",LL,"NM")) D
. Q:$P(^XPD(9.6,XPDBIEN,"KRN",LL,"NM",0),"^",4)<1 S XPDCAR(LL,0)=$$GET1^DIQ(1,LL,.01)
. N KK S KK=0 F S KK=$O(^XPD(9.6,XPDBIEN,"KRN",LL,"NM",KK)) Q:'KK D
.. I $$GET1^DIQ(9.68,KK_","_LL_","_XPDBIEN,.03)'["DELETE AT SITE" S XPDCAR(LL,KK)=$$GET1^DIQ(9.68,KK_","_LL_","_XPDBIEN,.01)
.. I $$GET1^DIQ(9.68,KK_","_LL_","_XPDBIEN,.03)["DELETE AT SITE" S XPDARR("DELETE",XPDBIEN,XPDCAR(LL,0),$$GET1^DIQ(9.68,KK_","_LL_","_XPDBIEN,.01))=""
N XPDL S XPDL=0 F S XPDL=$O(XPDCAR(XPDL)) Q:'XPDL D
. D NSST^XPDANLYZ3(XPDL) ;SET COMPONENTS
I $D(XPDARR("BUILD",XPDBIEN,"ROUTINE"))>0 D RLINES^XPDANLYZ2 ;CAPTURES ROUTINE INFO; XPDSQA ARRAY OF SQA ROUTINE LINES
S XPDBN=XPDARR("BUILD",XPDBIEN,"NAME")
Q
;
BTXT ; build routine, XPDARR ARRAY check settings
I $D(XPDARR("BUILD",XPDNUM,"ROUTINE")) D
. N XPDL1 S XPDL1=0 F S XPDL1=$O(XPDARR("BUILD",XPDNUM,"ROUTINE",XPDL1)) Q:'XPDL1 S XPDRTN(XPDARR("BUILD",XPDNUM,"ROUTINE",XPDL1))=""
;RPC routine calls
N LKJ,HHH S LKJ=0,HHH=" " F S LKJ=$O(XPDARR("REMOTE PROCEDURE",LKJ)) Q:'LKJ F S HHH=$O(XPDARR("REMOTE PROCEDURE",LKJ,"ROUTINE",HHH)) Q:HHH']"" D
. N INCL S INCL=1 I $D(XPDRTN(HHH)) S INCL=0 ;IF INCL=1 ROUTINE IS NOT INCLUDED IN THE BUILD
. N NSP S NSP=0 I '$$NSPACE^XPDANLYZ6(HHH) S NSP=1 ;IF NSP=1 ROUTINE IS NOT IS PATCH NAMESPACE
. ;N NSP S NSP=0 I $E(HHH,1,$L(XPDSPC))'=XPDSPC S NSP=1 ;IF NSP=1 ROUTINE IS NOT IS PATCH NAMESPACE
. I '(NSP),'(INCL) Q
. I INCL,NSP S XPDARR("REMOTE PROCEDURE",LKJ,"WARNING",HHH)="Routine field (#.03): Calls "_HHH_" not found in build or patch namespace." Q
. I 'INCL,NSP S XPDARR("REMOTE PROCEDURE",LKJ,"WARNING",HHH)="Routine field (#.03): Calls "_HHH_" not found in patch namespace." Q
. I INCL,'NSP S XPDARR("REMOTE PROCEDURE",LKJ,"WARNING",HHH)="Routine field (#.03): Calls "_HHH_" not found in build." Q
;DIALOG routine calls
N LKJ,HHH S LKJ=0,HHH=" " F S LKJ=$O(XPDARR("DIALOG",LKJ)) Q:'LKJ F S HHH=$O(XPDARR("DIALOG",LKJ,"ROUTINE",HHH)) Q:HHH']"" D
. N INCL S INCL=1 I $D(XPDRTN(HHH)) S INCL=0 ;IF INCL=1 ROUTINE IS NOT INCLUDED IN THE BUILD
. N NSP S NSP=0 I '$$NSPACE^XPDANLYZ6(HHH) S NSP=1 ;IF NSP=1 ROUTINE IS NOT IS PATCH NAMESPACE
. ;N NSP S NSP=0 I $E(HHH,1,$L(XPDSPC))'=XPDSPC S NSP=1 ;IF NSP=1 ROUTINE IS NOT IS PATCH NAMESPACE
. I '(NSP),'(INCL) Q
. N TXT1 S TXT1="ROUTINE NAME (subfield #.01) within the CALLED FROM ENTRY POINTS sub-file (#8) calls "
. I INCL,NSP S XPDARR("DIALOG",LKJ,"WARNING",HHH)=TXT1_HHH_" not found in build or patch namespace." Q
. I 'INCL,NSP S XPDARR("DIALOG",LKJ,"WARNING",HHH)=TXT1_HHH_" not found in patch namespace." Q
. I INCL,'NSP S XPDARR("DIALOG",LKJ,"WARNING",HHH)=TXT1_HHH_" not found in build." Q
;TEMPLATE (INPUT,PRINT,SORT) ROUTINE CALLS
N TY1,LKJ,HHH F TY1="INPUT TEMPLATE","PRINT TEMPLATE","SORT TEMPLATE" D
. S LKJ=0,HHH=" " F S LKJ=$O(XPDARR(TY1,LKJ)) Q:'LKJ F S HHH=$O(XPDARR(TY1,LKJ,"ROUTINE",HHH)) Q:HHH']"" D
.. N INCL S INCL=1 I $D(XPDRTN(HHH)) S INCL=0 ;IF INCL=1 ROUTINE IS NOT INCLUDED IN THE BUILD
.. N NSP S NSP=0 I '$$NSPACE^XPDANLYZ6(HHH) S NSP=1 ;IF NSP=1 ROUTINE IS NOT IS PATCH NAMESPACE
.. ;N NSP S NSP=0 I $E(HHH,1,$L(XPDSPC))'=XPDSPC S NSP=1 ;IF NSP=1 ROUTINE IS NOT IS PATCH NAMESPACE
.. I '(NSP),'(INCL) Q
.. N TXT1 S TXT1=XPDARR(TY1,LKJ,"ROUTINE",HHH)
.. I INCL,NSP S XPDARR(TY1,LKJ,"WARNING",HHH)=TXT1_" not found in build or patch namespace." Q
.. I 'INCL,NSP S XPDARR(TY1,LKJ,"WARNING",HHH)=TXT1_" not found in patch namespace." Q
.. I INCL,'NSP S XPDARR(TY1,LKJ,"WARNING",HHH)=TXT1_" not found in build." Q
;CONSOLODATE OPTIONS ENTRY/EXIT INFO, SEE CEE^XPDANLYZ3
N LKJ,EE1,ROU6,T1,LJJ,LEE S LEE="",LJJ=0,LKJ=0,EE1=" ",ROU6=" " F S LKJ=$O(XPOPT(LKJ)) Q:'LKJ F S EE1=$O(XPOPT(LKJ,EE1)) Q:EE1']"" F S ROU6=$O(XPOPT(LKJ,EE1,ROU6)) Q:ROU6']"" D
. N TMK S TMK=$S(EE1="ENT":"b",EE1="EXT":"c",EE1="ROU":"a",1:"") S T1=XPOPT(LKJ,EE1,ROU6)
. I XPOPT(LKJ,EE1,ROU6)["file:" S XPDARR("OPTION",LKJ,"WARNING",TMK_ROU6)=XPOPT(LKJ,EE1,ROU6) Q
. I XPOPT(LKJ,EE1,ROU6)["global" S XPDARR("OPTION",LKJ,"WARNING",TMK_ROU6)=XPOPT(LKJ,EE1,ROU6) Q
. N INCL S INCL=1 I $D(XPDRTN(ROU6)) S INCL=0 ;IF INCL=1 ROUTINE IS NOT INCLUDED IN THE BUILD
. N NSP S NSP=0 I '$$NSPACE^XPDANLYZ6(ROU6) S NSP=1 ;IF NSP=1 ROUTINE IS NOT IS PATCH NAMESPACE
. ;N NSP S NSP=0 I $E(ROU6,1,$L(XPDSPC))'=XPDSPC S NSP=1 ;IF NSP=1 ROUTINE IS NOT IS PATCH NAMESPACE
. I '(NSP),'(INCL) Q
. I LJJ=LKJ,LEE=EE1 S T1=$J(" ",$L(XPOPT(LKJ,EE1,ROU6)))
. S:LJJ'=LKJ LJJ=LKJ S:LEE'=EE1 LEE=EE1
. I INCL,NSP S XPDARR("OPTION",LKJ,"WARNING",TMK_ROU6)=T1_" Calls routine "_ROU6_" not in build or namespace." Q
. I 'INCL,NSP S XPDARR("OPTION",LKJ,"WARNING",TMK_ROU6)=T1_" Calls routine "_ROU6_" not in patch namespace." Q
. I INCL,'NSP S XPDARR("OPTION",LKJ,"WARNING",TMK_ROU6)=T1_" Calls routine "_ROU6_" not in build." Q
;FILES TO CHECK AGAINST OPTION ENTRY/EXIT
N XPDC2,FN1 S XPDC2=0 F S XPDC2=$O(XPDARR("FILE",XPDC2)) Q:'XPDC2 S FN1=XPDARR("FILE",XPDC2,"NAME") D
. N LKJ S LKJ=0 F S LKJ=$O(XPDARR("OPTION",LKJ)) Q:'LKJ I $D(XPDARR("OPTION",LKJ,"WARNING",FN1)) K XPDARR("OPTION",LKJ,"WARNING",FN1)
I $D(XPDARR("DELETE",XPDNUM)) D
. S XPDCNT=XPDCNT+1,XPDW(XPDCNT)="",XPDCNT=XPDCNT+1,XPDW(XPDCNT)="",XPDCNT=XPDCNT+1,XPDW(XPDCNT)=$J(" ",5)_"The following components are listed as ""DELETE AT SITE""."
. S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=$J(" ",5)_"Review to validate these are accurately identified."
. S XPDCNT=XPDCNT+1,XPDW(XPDCNT)="",XPDCNT=XPDCNT+1,XPDW(XPDCNT)=$J(" ",10)_"Component"_$J(" ",20)_"Name"
. S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=$J(" ",10)_$TR($J("=",40)," ","=")
. N XPDME S XPDME=" " F S XPDME=$O(XPDARR("DELETE",XPDNUM,XPDME)) Q:XPDME']"" D
.. N XPDIT S XPDIT=" " F S XPDIT=$O(XPDARR("DELETE",XPDNUM,XPDME,XPDIT)) Q:XPDIT']"" S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=$J(" ",10)_XPDME_$J(" ",(40-(10+$L(XPDME))))_XPDIT
;if TRACK PACKAGE NATIONALLY not set to YES
S TRKN=$$GET1^DIQ(9.6,XPDNUM_",",5)
I TRKN'["Y" D
. S XPDCNT=XPDCNT+1,XPDW(XPDCNT)="",XPDCNT=XPDCNT+1,XPDW(XPDCNT)="",XPDCNT=XPDCNT+1,XPDW(XPDCNT)="Warning: Build not set to track package nationally"
. S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=$J(" ",10)_"Please validate that is correct.",XPDCNT=XPDCNT+1,XPDW(XPDCNT)=""
;PACKAGE FILE LINK PFL set in BUILDME
I PFL]"" S XPDCNT=XPDCNT+1,XPDW(XPDCNT)="",XPDCNT=XPDCNT+1,XPDW(XPDCNT)="Package File link: "_PFL
I PFL']"" D
. S XPDCNT=XPDCNT+1,XPDW(XPDCNT)="",XPDCNT=XPDCNT+1,XPDW(XPDCNT)="Warning: The PACKAGE FILE LINK is missing."
. S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=$J(" ",10)_"This should be defined for a national VISTA product build."
;ENVIRONMENT CHECK ROUTINE CHECK
N ENV1,ENVD S ENV1=$$GET1^DIQ(9.6,XPDNUM_",",913)
I $G(ENV1)]"" S ENVD=$$GET1^DIQ(9.6,XPDNUM_",",913.1) S:ENVD["N" XPDCNT=XPDCNT+1,XPDW(XPDCNT)="",XPDCNT=XPDCNT+1,XPDW(XPDCNT)="Warning: ENVIRONMENT CHECK routine is NOT set to DELETE AT SITE."
;Post-Install check
N ENV1,ENVD S ENV1=$$GET1^DIQ(9.6,XPDNUM_",",914)
I $G(ENV1)]"" S ENVD=$$GET1^DIQ(9.6,XPDNUM_",",914.1) S:ENVD["N" XPDCNT=XPDCNT+1,XPDW(XPDCNT)="",XPDCNT=XPDCNT+1,XPDW(XPDCNT)="Warning: POST-INSTALL routine is NOT set to DELETE AT SITE."
;Pre-Install check
N ENV1,ENVD S ENV1=$$GET1^DIQ(9.6,XPDNUM_",",916)
I $G(ENV1)]"" S ENVD=$$GET1^DIQ(9.6,XPDNUM_",",916.1) S:ENVD["N" XPDCNT=XPDCNT+1,XPDW(XPDCNT)="",XPDCNT=XPDCNT+1,XPDW(XPDCNT)="Warning: PRE-INSTALL routine is NOT set to DELETE AT SITE."
S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=$TR($J("-",79)," ","-")
S XPDCNT=XPDCNT+1,XPDW(XPDCNT)="",XPDCNT=XPDCNT+1,XPDW(XPDCNT)="",XPDCNT=XPDCNT+1,XPDW(XPDCNT)="*** Detailed results for components included in build "_XPDARR("BUILD",XPDBB,"NAME")_" ***",XPDHR(XPDCNT)="Component Analysis"
Q
;
GINFO(XPDF,XPDI,XPDFLDS,QRR) ;XPDF IS FILE NUMBER, XPDI IS IENS, XPDFLDS CAN BE ONE FIELD, OR SEPARATED BY COMMAS
D GETS^DIQ(XPDF,XPDI,XPDFLDS,"N",QRR)
Q
;
ADIC(GLB) ;DIC COMMENTS
S XPDW(XPDCNT)=" Data for this file is stored in "_GLB
S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=" The global ^DIC should no longer be used for data storage. Data should be"
S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=" stored in a namespaced global or in ^DIZ followed by the file number."
;S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=""
Q
;
ADIZ(ZLB) ;DIZ COMMENTS
Q:TRKN'["Y"
S XPDW(XPDCNT)=" Data for this file is stored in "_ZLB
S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=" National packages should use a global storage location in a"
S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=" namespaced global."
;S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=""
Q
;
PWARN(COMP2) ;
S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=""
N JKL S JKL=0 F S JKL=$O(XPDARR(COMP2,"WARNING",JKL)) Q:'JKL S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=XPDARR(COMP2,"WARNING",JKL)
Q
NSPACE(TNAME) ;returns 1 if in namespace, 0 if not
Q:'$D(XPNS) 0
N CHK S CHK=0
N J S J=" " F S J=$O(XPNS(J)) Q:J']"" I $E(TNAME,1,$L(J))=J S CHK=1
I CHK,$D(XPEX) D ;CHECK IF EXCLUDED NAMESPACE
. S J=" " F S J=$O(XPEX(J)) Q:J']"" I $E(TNAME,1,$L(J))=J S CHK=0 ;EXCLUDED
Q CHK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDANLYZ6 13694 printed Dec 13, 2024@02:03:12 Page 2
XPDANLYZ6 ;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 ;
BUILDME ;Ask for build and build user choices on the type of report when running the option
+1 ; Called from line START^XPDANLYZ1
+2 ;SETS COMPONENT ARRAY XPDCS
NEW X,Y
DO COMP1^XPDANLYZ2
+3 SET XPPATH=$$PWD^%ZISH()
+4 ;p732
WRITE @IOF,!,"This tool is used to analyze and list the components of a build to identify",!,"adherence to standards and best practices.",!!
+5 ;XPDBN is the build patch name and XPDCS is a set of all components
SET XPDLINE="Analysis of a KIDS BUILD"
+6 NEW DIRUT,DIC
SET DIC=9.6
SET DIC(0)="QEAM"
SET DIC("A")="Select Build Name: "
+7 DO ^DIC
IF Y=-1
KILL DIC
SET END=1
QUIT
+8 IF $DATA(DIRUT)
KILL DIC
SET END=1
QUIT
+9 ;BUILD ien ^ NAME, 11045^SRA*3.0*1
IF $GET(Y)]""
SET XPDTOP=Y
+10 SET XPDBIEN=$PIECE(XPDTOP,"^")
+11 if '+XPDBIEN
QUIT
+12 SET XPDARR("BUILD",XPDBIEN,"NAME")=$PIECE(XPDTOP,"^",2)
+13 if $PIECE(XPDTOP,"^",2)["*"
SET XPDSPC=$PIECE($PIECE(XPDTOP,"^",2),"*")
SET XPNS(XPDSPC)=""
+14 ;p792
if $PIECE(XPDTOP,"^",2)'["*"
SET XPDSPC=$PIECE($PIECE(XPDTOP,"^",2)," ")
SET XPDSPC=$$TRIM^XLFSTR(XPDSPC)
SET XPNS(XPDSPC)=""
+15 SET PFL=$$GET1^DIQ(9.6,XPDBIEN_",",1,"I")
IF PFL?.N
SET PFL=$$GET1^DIQ(9.6,XPDBIEN_",",1,"E")
+16 IF $GET(PFL)]""
IF $GET(XPDSPC)']""
SET XPDSPC=PFL
SET XPNS(XPDSPC)=""
+17 ;I $G(PFL)="",$G(XPDSPC)="" S:$P(XPDTOP,"^",2)[" " XPDSPC=$P($P(XPDTOP,"^",2)," "),XPNS(XPDSPC)="" ;p792
+18 ;BUILD CROSS REF
NEW XPNSM,J
SET J=" "
FOR
SET J=$ORDER(^XPD(9.6,XPDBIEN,"ABNS","B",J))
if J']""
QUIT
SET XPNSM(J)=""
SET XPNS(J)=""
+19 NEW XPDLL
SET XPDLL=$ORDER(^DIC(9.4,"C",XPDSPC,9999),-1)
if '$GET(XPDLL)
SET XPDLL=$ORDER(^DIC(9.4,"C2",XPDSPC,0))
+20 ;D GETS^DIQ(9.4,XPDLL_",","14*","I","XPNS") ;DIC(9.4 - package file
IF XPDLL
Begin DoDot:1
+21 NEW J
SET J=" "
FOR
SET J=$ORDER(^DIC(9.4,XPDLL,14,"B",J))
if J']""
QUIT
SET XPNS(J)=""
+22 SET J=0
FOR
SET J=$ORDER(^DIC(9.4,XPDLL,"EX",J))
if 'J
QUIT
SET XPEX(^DIC(9.4,XPDLL,"EX",J,0))=""
End DoDot:1
+23 SET XPDN=PFL
IF $GET(XPDN)']""
SET XPDN=$$GET1^DIQ(9.4,XPDLL_",",.01)
+24 IF $DATA(XPNSM)
IF '$DATA(XPNSM(XPDSPC))
WRITE !!,"*** Warning: BUILD namespace not consistent with PACKAGE NAMESPACE OR",!,"PREFIX (#23) field of BUILD file."
+25 IF '$GET(XPDSPC)
IF '$DATA(XPNS)
WRITE !!,"*** Warning: No namespace found for this build. ****"
+26 IF $GET(XPDSPC)]""
WRITE !!,"Namespace: ",XPDSPC,!,"Package: ",$GET(XPDN)
+27 IF XPDIS2
SET XPQR=1
GOTO TX1
+28 NEW Y
WRITE !!
NEW DIRUT
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
+29 SET DIR("A")="specific code references reviewed on the SQA checklist"
SET DIR("A",1)="Do you want to include a section that displays the routine lines containing"
+30 SET DIR("?",1)="The analysis report always displays the routine and line numbers that"
SET DIR("?",2)="include specific code references that are checked as part of the SQA"
+31 SET DIR("?",3)="Checklist."
SET DIR("?",4)=""
+32 SET DIR("?",5)="Enter YES if you want the analysis report to include a detailed"
SET DIR("?")="display of the code contained on those lines."
+33 DO ^DIR
if $DATA(DTOUT)
SET END=1
if $DATA(DIRUT)
SET END=1
if END
QUIT
+34 SET XPQR=Y
TX1 WRITE !!
NEW DIRUT
KILL DIR,Y
SET DIR(0)="Y"
SET DIR("B")="NO"
+1 SET DIR("A")="and text found in routines"
SET DIR("A",1)="Do you want to include a section that displays the component descriptions"
+2 SET DIR("?",1)="Enter YES if you want the analysis report to include a display of the"
+3 SET DIR("?",2)="descriptions for each component included in the build and text within"
+4 SET DIR("?",3)="the routines included. This additional display can be copied into another"
+5 SET DIR("?")="product (like MS WORD) to do a spell check."
+6 DO ^DIR
if $DATA(DTOUT)
SET END=1
if $DATA(DIRUT)
SET END=1
if END
QUIT
+7 SET XPDR=Y
+8 WRITE !!,"Analysis Results Display Choices:"
+9 WRITE !!,"1. Print the Report"
+10 WRITE !,"2. Create the Report in .TXT Files"
+11 WRITE !,"3. Send the Report in MailMan Messages"
+12 WRITE !
KILL DIR,Y
SET DIR(0)="N^1:3"
+13 SET DIR("?")="captured into text files, or compiled into MailMan messages."
SET DIR("?",1)="Enter your preference for displaying the findings. Reports can be printed,"
+14 SET DIR("A")="Select number"
+15 DO ^DIR
if $DATA(DTOUT)
SET END=1
if $DATA(DIRUT)
SET END=1
if END
QUIT
+16 SET XPDIS=Y
IF XPDIS=1
HANG .5
WRITE " . "
HANG .5
WRITE ". "
HANG .5
WRITE "."
WRITE !
+17 NEW XPDIENS
SET XPDIENS=XPDBIEN_","
+18 ;GET DESCRIPTION ARRAY
NEW TARR
DO GINFO("9.6",XPDIENS,"3","TARR")
+19 IF '$DATA(TARR(9.6,XPDIENS,3))
SET XPDARR("BUILD",XPDBIEN,"DESCRIPT")="No"
SET XPDARR("BUILD",XPDBIEN,"WARNING","DESCRIPTION")="BUILD "_$PIECE(XPDTOP,"^",2)_"("_XPDBIEN_") - DESCRIPTION field (#3) missing."
+20 IF $DATA(TARR(9.6,XPDIENS,3))
Begin DoDot:1
+21 SET XPDARR("BUILD",XPDBIEN,"DESCRIPT")="Yes"
NEW LL
SET LL=0
FOR
SET LL=$ORDER(TARR(9.6,XPDIENS,3,LL))
if 'LL
QUIT
SET XPDARR("BUILD",XPDBIEN,"DESCRIPTION",LL)=TARR(9.6,XPDIENS,3,LL)
End DoDot:1
+22 ; FILES
+23 NEW LL
+24 IF $DATA(^XPD(9.6,XPDBIEN,4,"B"))
SET LL=0
FOR
SET LL=$ORDER(^XPD(9.6,XPDBIEN,4,"B",LL))
if 'LL!($PIECE(^XPD(9.6,XPDBIEN,4,0),"^",4)<1)
QUIT
SET XPDARR("BUILD",XPDBIEN,"FILES",LL)=""
DO FCHK^XPDANLYZ4(XPDBIEN,LL)
+25 SET LL=0
FOR
SET LL=$ORDER(^XPD(9.6,XPDBIEN,"KRN","B",LL))
if 'LL
QUIT
IF $DATA(^XPD(9.6,XPDBIEN,"KRN",LL,"NM"))
Begin DoDot:1
+26 if $PIECE(^XPD(9.6,XPDBIEN,"KRN",LL,"NM",0),"^",4)<1
QUIT
SET XPDCAR(LL,0)=$$GET1^DIQ(1,LL,.01)
+27 NEW KK
SET KK=0
FOR
SET KK=$ORDER(^XPD(9.6,XPDBIEN,"KRN",LL,"NM",KK))
if 'KK
QUIT
Begin DoDot:2
+28 IF $$GET1^DIQ(9.68,KK_","_LL_","_XPDBIEN,.03)'["DELETE AT SITE"
SET XPDCAR(LL,KK)=$$GET1^DIQ(9.68,KK_","_LL_","_XPDBIEN,.01)
+29 IF $$GET1^DIQ(9.68,KK_","_LL_","_XPDBIEN,.03)["DELETE AT SITE"
SET XPDARR("DELETE",XPDBIEN,XPDCAR(LL,0),$$GET1^DIQ(9.68,KK_","_LL_","_XPDBIEN,.01))=""
End DoDot:2
End DoDot:1
+30 NEW XPDL
SET XPDL=0
FOR
SET XPDL=$ORDER(XPDCAR(XPDL))
if 'XPDL
QUIT
Begin DoDot:1
+31 ;SET COMPONENTS
DO NSST^XPDANLYZ3(XPDL)
End DoDot:1
+32 ;CAPTURES ROUTINE INFO; XPDSQA ARRAY OF SQA ROUTINE LINES
IF $DATA(XPDARR("BUILD",XPDBIEN,"ROUTINE"))>0
DO RLINES^XPDANLYZ2
+33 SET XPDBN=XPDARR("BUILD",XPDBIEN,"NAME")
+34 QUIT
+35 ;
BTXT ; build routine, XPDARR ARRAY check settings
+1 IF $DATA(XPDARR("BUILD",XPDNUM,"ROUTINE"))
Begin DoDot:1
+2 NEW XPDL1
SET XPDL1=0
FOR
SET XPDL1=$ORDER(XPDARR("BUILD",XPDNUM,"ROUTINE",XPDL1))
if 'XPDL1
QUIT
SET XPDRTN(XPDARR("BUILD",XPDNUM,"ROUTINE",XPDL1))=""
End DoDot:1
+3 ;RPC routine calls
+4 NEW LKJ,HHH
SET LKJ=0
SET HHH=" "
FOR
SET LKJ=$ORDER(XPDARR("REMOTE PROCEDURE",LKJ))
if 'LKJ
QUIT
FOR
SET HHH=$ORDER(XPDARR("REMOTE PROCEDURE",LKJ,"ROUTINE",HHH))
if HHH']""
QUIT
Begin DoDot:1
+5 ;IF INCL=1 ROUTINE IS NOT INCLUDED IN THE BUILD
NEW INCL
SET INCL=1
IF $DATA(XPDRTN(HHH))
SET INCL=0
+6 ;IF NSP=1 ROUTINE IS NOT IS PATCH NAMESPACE
NEW NSP
SET NSP=0
IF '$$NSPACE^XPDANLYZ6(HHH)
SET NSP=1
+7 ;N NSP S NSP=0 I $E(HHH,1,$L(XPDSPC))'=XPDSPC S NSP=1 ;IF NSP=1 ROUTINE IS NOT IS PATCH NAMESPACE
+8 IF '(NSP)
IF '(INCL)
QUIT
+9 IF INCL
IF NSP
SET XPDARR("REMOTE PROCEDURE",LKJ,"WARNING",HHH)="Routine field (#.03): Calls "_HHH_" not found in build or patch namespace."
QUIT
+10 IF 'INCL
IF NSP
SET XPDARR("REMOTE PROCEDURE",LKJ,"WARNING",HHH)="Routine field (#.03): Calls "_HHH_" not found in patch namespace."
QUIT
+11 IF INCL
IF 'NSP
SET XPDARR("REMOTE PROCEDURE",LKJ,"WARNING",HHH)="Routine field (#.03): Calls "_HHH_" not found in build."
QUIT
End DoDot:1
+12 ;DIALOG routine calls
+13 NEW LKJ,HHH
SET LKJ=0
SET HHH=" "
FOR
SET LKJ=$ORDER(XPDARR("DIALOG",LKJ))
if 'LKJ
QUIT
FOR
SET HHH=$ORDER(XPDARR("DIALOG",LKJ,"ROUTINE",HHH))
if HHH']""
QUIT
Begin DoDot:1
+14 ;IF INCL=1 ROUTINE IS NOT INCLUDED IN THE BUILD
NEW INCL
SET INCL=1
IF $DATA(XPDRTN(HHH))
SET INCL=0
+15 ;IF NSP=1 ROUTINE IS NOT IS PATCH NAMESPACE
NEW NSP
SET NSP=0
IF '$$NSPACE^XPDANLYZ6(HHH)
SET NSP=1
+16 ;N NSP S NSP=0 I $E(HHH,1,$L(XPDSPC))'=XPDSPC S NSP=1 ;IF NSP=1 ROUTINE IS NOT IS PATCH NAMESPACE
+17 IF '(NSP)
IF '(INCL)
QUIT
+18 NEW TXT1
SET TXT1="ROUTINE NAME (subfield #.01) within the CALLED FROM ENTRY POINTS sub-file (#8) calls "
+19 IF INCL
IF NSP
SET XPDARR("DIALOG",LKJ,"WARNING",HHH)=TXT1_HHH_" not found in build or patch namespace."
QUIT
+20 IF 'INCL
IF NSP
SET XPDARR("DIALOG",LKJ,"WARNING",HHH)=TXT1_HHH_" not found in patch namespace."
QUIT
+21 IF INCL
IF 'NSP
SET XPDARR("DIALOG",LKJ,"WARNING",HHH)=TXT1_HHH_" not found in build."
QUIT
End DoDot:1
+22 ;TEMPLATE (INPUT,PRINT,SORT) ROUTINE CALLS
+23 NEW TY1,LKJ,HHH
FOR TY1="INPUT TEMPLATE","PRINT TEMPLATE","SORT TEMPLATE"
Begin DoDot:1
+24 SET LKJ=0
SET HHH=" "
FOR
SET LKJ=$ORDER(XPDARR(TY1,LKJ))
if 'LKJ
QUIT
FOR
SET HHH=$ORDER(XPDARR(TY1,LKJ,"ROUTINE",HHH))
if HHH']""
QUIT
Begin DoDot:2
+25 ;IF INCL=1 ROUTINE IS NOT INCLUDED IN THE BUILD
NEW INCL
SET INCL=1
IF $DATA(XPDRTN(HHH))
SET INCL=0
+26 ;IF NSP=1 ROUTINE IS NOT IS PATCH NAMESPACE
NEW NSP
SET NSP=0
IF '$$NSPACE^XPDANLYZ6(HHH)
SET NSP=1
+27 ;N NSP S NSP=0 I $E(HHH,1,$L(XPDSPC))'=XPDSPC S NSP=1 ;IF NSP=1 ROUTINE IS NOT IS PATCH NAMESPACE
+28 IF '(NSP)
IF '(INCL)
QUIT
+29 NEW TXT1
SET TXT1=XPDARR(TY1,LKJ,"ROUTINE",HHH)
+30 IF INCL
IF NSP
SET XPDARR(TY1,LKJ,"WARNING",HHH)=TXT1_" not found in build or patch namespace."
QUIT
+31 IF 'INCL
IF NSP
SET XPDARR(TY1,LKJ,"WARNING",HHH)=TXT1_" not found in patch namespace."
QUIT
+32 IF INCL
IF 'NSP
SET XPDARR(TY1,LKJ,"WARNING",HHH)=TXT1_" not found in build."
QUIT
End DoDot:2
End DoDot:1
+33 ;CONSOLODATE OPTIONS ENTRY/EXIT INFO, SEE CEE^XPDANLYZ3
+34 NEW LKJ,EE1,ROU6,T1,LJJ,LEE
SET LEE=""
SET LJJ=0
SET LKJ=0
SET EE1=" "
SET ROU6=" "
FOR
SET LKJ=$ORDER(XPOPT(LKJ))
if 'LKJ
QUIT
FOR
SET EE1=$ORDER(XPOPT(LKJ,EE1))
if EE1']""
QUIT
FOR
SET ROU6=$ORDER(XPOPT(LKJ,EE1,ROU6))
if ROU6']""
QUIT
Begin DoDot:1
+35 NEW TMK
SET TMK=$SELECT(EE1="ENT":"b",EE1="EXT":"c",EE1="ROU":"a",1:"")
SET T1=XPOPT(LKJ,EE1,ROU6)
+36 IF XPOPT(LKJ,EE1,ROU6)["file:"
SET XPDARR("OPTION",LKJ,"WARNING",TMK_ROU6)=XPOPT(LKJ,EE1,ROU6)
QUIT
+37 IF XPOPT(LKJ,EE1,ROU6)["global"
SET XPDARR("OPTION",LKJ,"WARNING",TMK_ROU6)=XPOPT(LKJ,EE1,ROU6)
QUIT
+38 ;IF INCL=1 ROUTINE IS NOT INCLUDED IN THE BUILD
NEW INCL
SET INCL=1
IF $DATA(XPDRTN(ROU6))
SET INCL=0
+39 ;IF NSP=1 ROUTINE IS NOT IS PATCH NAMESPACE
NEW NSP
SET NSP=0
IF '$$NSPACE^XPDANLYZ6(ROU6)
SET NSP=1
+40 ;N NSP S NSP=0 I $E(ROU6,1,$L(XPDSPC))'=XPDSPC S NSP=1 ;IF NSP=1 ROUTINE IS NOT IS PATCH NAMESPACE
+41 IF '(NSP)
IF '(INCL)
QUIT
+42 IF LJJ=LKJ
IF LEE=EE1
SET T1=$JUSTIFY(" ",$LENGTH(XPOPT(LKJ,EE1,ROU6)))
+43 if LJJ'=LKJ
SET LJJ=LKJ
if LEE'=EE1
SET LEE=EE1
+44 IF INCL
IF NSP
SET XPDARR("OPTION",LKJ,"WARNING",TMK_ROU6)=T1_" Calls routine "_ROU6_" not in build or namespace."
QUIT
+45 IF 'INCL
IF NSP
SET XPDARR("OPTION",LKJ,"WARNING",TMK_ROU6)=T1_" Calls routine "_ROU6_" not in patch namespace."
QUIT
+46 IF INCL
IF 'NSP
SET XPDARR("OPTION",LKJ,"WARNING",TMK_ROU6)=T1_" Calls routine "_ROU6_" not in build."
QUIT
End DoDot:1
+47 ;FILES TO CHECK AGAINST OPTION ENTRY/EXIT
+48 NEW XPDC2,FN1
SET XPDC2=0
FOR
SET XPDC2=$ORDER(XPDARR("FILE",XPDC2))
if 'XPDC2
QUIT
SET FN1=XPDARR("FILE",XPDC2,"NAME")
Begin DoDot:1
+49 NEW LKJ
SET LKJ=0
FOR
SET LKJ=$ORDER(XPDARR("OPTION",LKJ))
if 'LKJ
QUIT
IF $DATA(XPDARR("OPTION",LKJ,"WARNING",FN1))
KILL XPDARR("OPTION",LKJ,"WARNING",FN1)
End DoDot:1
+50 IF $DATA(XPDARR("DELETE",XPDNUM))
Begin DoDot:1
+51 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=$JUSTIFY(" ",5)_"The following components are listed as ""DELETE AT SITE""."
+52 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=$JUSTIFY(" ",5)_"Review to validate these are accurately identified."
+53 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=$JUSTIFY(" ",10)_"Component"_$JUSTIFY(" ",20)_"Name"
+54 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=$JUSTIFY(" ",10)_$TRANSLATE($JUSTIFY("=",40)," ","=")
+55 NEW XPDME
SET XPDME=" "
FOR
SET XPDME=$ORDER(XPDARR("DELETE",XPDNUM,XPDME))
if XPDME']""
QUIT
Begin DoDot:2
+56 NEW XPDIT
SET XPDIT=" "
FOR
SET XPDIT=$ORDER(XPDARR("DELETE",XPDNUM,XPDME,XPDIT))
if XPDIT']""
QUIT
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=$JUSTIFY(" ",10)_XPDME_$JUSTIFY(" ",(40-(10+$LENGTH(XPDME))))_XPDIT
End DoDot:2
End DoDot:1
+57 ;if TRACK PACKAGE NATIONALLY not set to YES
+58 SET TRKN=$$GET1^DIQ(9.6,XPDNUM_",",5)
+59 IF TRKN'["Y"
Begin DoDot:1
+60 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)="Warning: Build not set to track package nationally"
+61 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=$JUSTIFY(" ",10)_"Please validate that is correct."
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
End DoDot:1
+62 ;PACKAGE FILE LINK PFL set in BUILDME
+63 IF PFL]""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)="Package File link: "_PFL
+64 IF PFL']""
Begin DoDot:1
+65 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)="Warning: The PACKAGE FILE LINK is missing."
+66 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=$JUSTIFY(" ",10)_"This should be defined for a national VISTA product build."
End DoDot:1
+67 ;ENVIRONMENT CHECK ROUTINE CHECK
+68 NEW ENV1,ENVD
SET ENV1=$$GET1^DIQ(9.6,XPDNUM_",",913)
+69 IF $GET(ENV1)]""
SET ENVD=$$GET1^DIQ(9.6,XPDNUM_",",913.1)
if ENVD["N"
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)="Warning: ENVIRONMENT CHECK routine is NOT set to DELETE AT SITE."
+70 ;Post-Install check
+71 NEW ENV1,ENVD
SET ENV1=$$GET1^DIQ(9.6,XPDNUM_",",914)
+72 IF $GET(ENV1)]""
SET ENVD=$$GET1^DIQ(9.6,XPDNUM_",",914.1)
if ENVD["N"
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)="Warning: POST-INSTALL routine is NOT set to DELETE AT SITE."
+73 ;Pre-Install check
+74 NEW ENV1,ENVD
SET ENV1=$$GET1^DIQ(9.6,XPDNUM_",",916)
+75 IF $GET(ENV1)]""
SET ENVD=$$GET1^DIQ(9.6,XPDNUM_",",916.1)
if ENVD["N"
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)="Warning: PRE-INSTALL routine is NOT set to DELETE AT SITE."
+76 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=$TRANSLATE($JUSTIFY("-",79)," ","-")
+77 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)="*** Detailed results for components included in build "_XPDARR("BUILD",XPDBB,"NAME")_" ***"
SET XPDHR(XPDCNT)="Component Analysis"
+78 QUIT
+79 ;
GINFO(XPDF,XPDI,XPDFLDS,QRR) ;XPDF IS FILE NUMBER, XPDI IS IENS, XPDFLDS CAN BE ONE FIELD, OR SEPARATED BY COMMAS
+1 DO GETS^DIQ(XPDF,XPDI,XPDFLDS,"N",QRR)
+2 QUIT
+3 ;
ADIC(GLB) ;DIC COMMENTS
+1 SET XPDW(XPDCNT)=" Data for this file is stored in "_GLB
+2 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=" The global ^DIC should no longer be used for data storage. Data should be"
+3 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=" stored in a namespaced global or in ^DIZ followed by the file number."
+4 ;S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=""
+5 QUIT
+6 ;
ADIZ(ZLB) ;DIZ COMMENTS
+1 if TRKN'["Y"
QUIT
+2 SET XPDW(XPDCNT)=" Data for this file is stored in "_ZLB
+3 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=" National packages should use a global storage location in a"
+4 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=" namespaced global."
+5 ;S XPDCNT=XPDCNT+1,XPDW(XPDCNT)=""
+6 QUIT
+7 ;
PWARN(COMP2) ;
+1 SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=""
+2 NEW JKL
SET JKL=0
FOR
SET JKL=$ORDER(XPDARR(COMP2,"WARNING",JKL))
if 'JKL
QUIT
SET XPDCNT=XPDCNT+1
SET XPDW(XPDCNT)=XPDARR(COMP2,"WARNING",JKL)
+3 QUIT
NSPACE(TNAME) ;returns 1 if in namespace, 0 if not
+1 if '$DATA(XPNS)
QUIT 0
+2 NEW CHK
SET CHK=0
+3 NEW J
SET J=" "
FOR
SET J=$ORDER(XPNS(J))
if J']""
QUIT
IF $EXTRACT(TNAME,1,$LENGTH(J))=J
SET CHK=1
+4 ;CHECK IF EXCLUDED NAMESPACE
IF CHK
IF $DATA(XPEX)
Begin DoDot:1
+5 ;EXCLUDED
SET J=" "
FOR
SET J=$ORDER(XPEX(J))
if J']""
QUIT
IF $EXTRACT(TNAME,1,$LENGTH(J))=J
SET CHK=0
End DoDot:1
+6 QUIT CHK
