XTVSRFL1 ;ALBANY FO/GTS - VistA Package Sizing Manager; 21-OCT-2016
;;7.3;TOOLKIT;**143,152**;Apr 25, 1995;Build 3
;Per VA Directive 6402, this routine should not be modified.
;
;;Variable glosary (local, for each package)
;; PKGIEN = Package IEN
;; PKGNAME = Package NAME (.01 - $P(^(0),"^",1))
;; PKGPFX = Package PREFIX / NAMESPACE (1 - $P(^(0),"^",2))
;;
;; RTOT = total ROUTINEs
;; TLCNT = total SIZE of all ROUTINES
;; FTOT = total FILEs
;; FLDTOT = total FIELDs of all FILES (Future: TBD)
;; OTOT = total OPTIONs (^DIC(19,)
;; PRCTOT = total PROTOCOLs (^ORD(101,)
;; RPTOT = total REMOTE PROCEDUREs (^XWB(8994,)
;; TPLTTOT = total Fileman Templates
;
ONERPT(PKGNAME,VALMCNT) ; Report a single package
;;INPUT:
; PKGNAME - Package name to report
; VALMCNT - Current Node # on ListMan ^TMP("XTVS PKG MGR RPT",$JOB) global
;
N Q,PCENUM,ADP,RDP,FTOT,FLDTOT,FFCTRSLT,RTOT,OTOT,PRCTOT,RPTOT,TPLTTOT,PKGIEN,PKGPFX,RNDT,TLCNT
N PARMDAT,PARMDAT3,PARMDAT4,PARMDAT7,PARMDAT8
D FULL^VALM1
;
SET PKGIEN=0
IF PKGNAME["''" DO
. IF $D(^DIC(9.4,"B",$REPLACE(PKGNAME,"''",""""))) SET PKGIEN=$O(^DIC(9.4,"B",$REPLACE(PKGNAME,"''",""""),""))
. IF '$D(^DIC(9.4,"B",$REPLACE(PKGNAME,"''",""""))),$D(^DIC(9.4,"B",PKGNAME)) SET PKGIEN=$O(^DIC(9.4,"B",PKGNAME,""))
IF PKGNAME'["''" SET PKGIEN=+$O(^DIC(9.4,"B",PKGNAME,""))
;
IF PKGIEN=0 W !!,"Selected package is not defined in the Package file (#9.4) on this VistA.",!,"Protocol count may be incorrect.",!!
;
S PKGPFX=$G(^TMP("XTVS-PARAM-CAP",$J,PKGNAME,2,"Primary Prefix"))
I PKGPFX="" W !!,"PREFIX not found for package selected. Unable to continue." Q
;
SET PARMDAT=^TMP("XTVS-PARAM-CAP",$J,PKGNAME,5,"Additional Prefixes")
S (ADP,Q,PCENUM)=0
FOR SET PCENUM=PCENUM+1 SET Q=$P(PARMDAT,"|",PCENUM) Q:Q="" IF $$MULTX(Q,PKGNAME) SET ADP=ADP+1 SET ADP(ADP)=Q
;
SET PARMDAT=^TMP("XTVS-PARAM-CAP",$J,PKGNAME,6,"Excepted Prefixes")
S (RDP,Q,PCENUM)=0
FOR SET PCENUM=PCENUM+1 SET Q=$P(PARMDAT,"|",PCENUM) Q:Q="" SET RDP=RDP+1 SET RDP(RDP)=Q
;
W !,"...counting...",!," ...files and fields..."
SET PARMDAT3=^TMP("XTVS-PARAM-CAP",$J,PKGNAME,3,"*Lowest File#")
SET PARMDAT4=^TMP("XTVS-PARAM-CAP",$J,PKGNAME,4,"*Highest File#")
SET PARMDAT7=^TMP("XTVS-PARAM-CAP",$J,PKGNAME,7,"File Numbers")
SET PARMDAT8=^TMP("XTVS-PARAM-CAP",$J,PKGNAME,8,"File Ranges")
SET FFCTRSLT=$$COUNTFLS(PKGPFX,PARMDAT3,PARMDAT4,PARMDAT7,PARMDAT8) ; Count Files^Fields
SET FTOT=$P(FFCTRSLT,"^") ;Extract File ctr
SET FLDTOT=$P(FFCTRSLT,"^",2) ;Extract Field ctr
;
W !," ...routines..."
S TLCNT=0
S RTOT=$$ROUTINE(PKGPFX,.TLCNT,.RDP,.ADP)
I ADP F Q=1:1:ADP I ADP(Q)'="" S RTOT=RTOT+$$ROUTINE(ADP(Q),.TLCNT,.RDP,.ADP) ;ADP(Q) added prefixes called individually
;
W !," ...options..."
S OTOT=0
D CNTR("^DIC(19,",.OTOT,PKGPFX,.RDP,.ADP)
I ADP F Q=1:1:ADP I ADP(Q)'="" D CNTR("^DIC(19,",.OTOT,ADP(Q),.RDP,.ADP)
;
W !," ...protocols..."
S PRCTOT=$$PROTOCOL(PKGPFX,PKGIEN,.RDP)
I ADP F Q=1:1:ADP I ADP(Q)'="" S PRCTOT=PRCTOT+$$PROTOCOL(ADP(Q),PKGIEN,.RDP)
;
W !," ...remote procedures..."
S RPTOT=0
D CNTR("^XWB(8994,",.RPTOT,PKGPFX,.RDP,.ADP)
I ADP F Q=1:1:ADP I ADP(Q)'="" D CNTR("^XWB(8994,",.RPTOT,ADP(Q),.RDP,.ADP)
;
W !," ...edit, print, & sort templates..."
S TPLTTOT=0
D CNTR("^DIPT(",.TPLTTOT,PKGPFX,.RDP,.ADP) ;Print Templates
I ADP F Q=1:1:ADP I ADP(Q)'="" D CNTR("^DIPT(",.TPLTTOT,ADP(Q),.RDP,.ADP)
;
D CNTR("^DIBT(",.TPLTTOT,PKGPFX,.RDP) ;Sort Templates
I ADP F Q=1:1:ADP I ADP(Q)'="" D CNTR("^DIBT(",.TPLTTOT,ADP(Q),.RDP,.ADP)
;
D CNTR("^DIE(",.TPLTTOT,PKGPFX,.RDP) ;Input Templates
I ADP F Q=1:1:ADP I ADP(Q)'="" D CNTR("^DIE(",.TPLTTOT,ADP(Q),.RDP,.ADP)
;
DO ADD^XTVSLAPI(.VALMCNT," ")
DO ADD^XTVSLAPI(.VALMCNT," VistA Application Sizing Information",1,3,36)
DO NOW^%DTC S Y=X D DD^%DT
SET RNDT=Y
DO ADD^XTVSLAPI(.VALMCNT,"Run Date: "_RNDT)
DO ADD^XTVSLAPI(.VALMCNT,"VistA Application: "_PKGNAME)
DO ADD^XTVSLAPI(.VALMCNT,"==================")
DO ADD^XTVSLAPI(.VALMCNT,"Number of Routines: "_RTOT)
DO ADD^XTVSLAPI(.VALMCNT,"Size of Routines: "_TLCNT)
DO ADD^XTVSLAPI(.VALMCNT,"Number of Files: "_FTOT)
DO ADD^XTVSLAPI(.VALMCNT,"Number of Fields: "_FLDTOT)
DO ADD^XTVSLAPI(.VALMCNT,"Number of Options: "_OTOT)
DO ADD^XTVSLAPI(.VALMCNT,"Number of Protocols: "_PRCTOT)
DO ADD^XTVSLAPI(.VALMCNT,"Number of RPCs: "_RPTOT)
DO ADD^XTVSLAPI(.VALMCNT,"Number of Templates: "_TPLTTOT)
QUIT
;
COUNTFLS(PKGPFX,LINE3,LINE4,LINE7,LINE8) ;Count total # of files for a package
; LINE3=*Lowest File # from ^TMP("XTVS-PARAM-CAP",$J,PKGNAME,3,"*Lowest File#") or SELPKGPM
; LINE4=*Highest File # from ^TMP("XTVS-PARAM-CAP",$J,PKGNAME,4,"*Highest File#") or SELPKGPM
; LINE7=File Numbers from ^TMP("XTVS-PARAM-CAP",$J,PKGNAME,7,"File Numbers") or SELPKGPM
; LINE8=File Ranges from ^TMP("XTVS-PARAM-CAP",$J,PKGNAME,8,"File Ranges") or SELPKGPM
;
NEW FNDFLDAT,FILELIST,PCENUM,FLERNG,STRTFNUM,ENDFNUM,FTOT,FNUM,FLDCNT
SET (FTOT,FNDFLDAT,FLDCNT)=0
;
; 1st look for delimited list of file ranges, if exists count it only
SET FILELIST=LINE8
IF FILELIST'="" DO
. SET FNDFLDAT=1
. SET PCENUM=0
. FOR SET PCENUM=PCENUM+1 SET FLERNG=$P(FILELIST,"|",PCENUM) QUIT:FLERNG']"" DO
.. SET STRTFNUM=+$P(FLERNG,"-")
.. SET ENDFNUM=+$P(FLERNG,"-",2)
.. IF +STRTFNUM>0,+ENDFNUM>0 SET FTOT=FTOT+$$FLECNT(STRTFNUM,ENDFNUM,.FLDCNT)
;
; 2nd if no list of file ranges, look files between Lowest and Highest file number range
IF 'FNDFLDAT,PKGPFX'="XU" DO
. NEW STRTFNUM,ENDFNUM,FNUM,FILENAME
. SET STRTFNUM=LINE3
. SET ENDFNUM=LINE4
. IF +STRTFNUM>0,+ENDFNUM>0 SET FNDFLDAT=1 SET FTOT=FTOT+$$FLECNT(STRTFNUM,ENDFNUM,.FLDCNT)
;
; 3rd if no list of file ranges & no High/Low file range, count files in File list data element
SET FILELIST=LINE7
IF 'FNDFLDAT,FILELIST'="" DO
. SET FNDFLDAT=1
. SET PCENUM=0
. FOR SET PCENUM=PCENUM+1 SET FNUM=$P(FILELIST,"|",PCENUM) QUIT:FNUM']"" SET FTOT=FTOT+1 SET FLDCNT=FLDCNT+$$FLDCNTR(FNUM)
SET FTOT=FTOT_"^"_FLDCNT
KILL ^TMP("XTVS-FILE-CNTD",$J,PKGPFX)
QUIT FTOT
;
ROUTINE(PKGPFX,TLCNT,RDP,ADP) ; Returns # of routines & total characters in all routines
; CNT - # characters in each routine including line feeds on each line of each routine
NEW CNT,LPPFX,PFXLN,X,ADPFXLN,ADPFX,ADPNDE,LPCT,ADPRSET
SET PFXLN=$L(PKGPFX)
SET (ADPRSET,CNT)=0
FOR LPCT=1:1 Q:$G(ADP(LPCT))="" IF ADP(LPCT)=PKGPFX SET ADPRSET=LPCT KILL ADP(LPCT)
SET LPPFX=""
DO RTNLST(PKGPFX,"^TMP(""XTVS"",""RTNLST"""_","_$J_")") ;Create global of Routines with Primary Prefix
FOR SET LPPFX=$ORDER(^TMP("XTVS","RTNLST",$J,LPPFX)) QUIT:LPPFX="" DO
.IF $$ADPRDPCK(LPPFX,.RDP),$$ADPRDPCK(LPPFX,.ADP) DO
.. SET X=LPPFX
.. X ^%ZOSF("TEST") IF $T SET TLCNT=TLCNT+$$RSIZE(LPPFX) SET CNT=CNT+1
KILL ^TMP("XTVS","RTNLST",$J)
IF ADPRSET SET ADP(ADPRSET)=PKGPFX
QUIT CNT
;
RTNLST(PREFIX,RTNLIST) ; Create RTNLIST of routines in PREFIX namespace
; NOTE: NEW RTNS will destroy the ResultSet Query object when QUIT takes RTNS out of scope
NEW RTNS,RTNNAME
SET RTNS=##class(%ResultSet).%New("%Routine:RoutineList") ;Create Routine Query Class instance
DO RTNS.Execute(PREFIX_"*.INT") ;Query Routines
FOR Q:'RTNS.Next() SET RTNNAME=$P(RTNS.GetData(1),".") SET @RTNLIST@(RTNNAME)=""
QUIT
;
ADPRDPCK(LPPFX,CKDP) ;Check for Excepted PREFIX [Result=0 when excepted] ; Additional PREFIX [Result=0 when included in Additional]
N RESULT,CKFX,CKFXLN,CKPNDE
S RESULT=1
FOR CKPNDE=1:1:CKDP SET CKFX=$G(CKDP(CKPNDE)) Q:CKFX="" Q:'RESULT DO
. SET CKFXLN=$L(CKFX)
. IF $E(LPPFX,1,CKFXLN)=CKFX SET RESULT=0 ;Do not count OR will be/already counted
Q RESULT
;
FLECNT(STRTFNUM,ENDFNUM,FLDCNT) ; Count Files & Fields
NEW FCNT,FNUM
SET FCNT=0
SET FNUM=$O(^DIC(STRTFNUM),-1)
FOR SET FNUM=$O(^DIC(FNUM)) Q:'FNUM Q:FNUM>ENDFNUM DO
. IF '$D(^TMP("XTVS-FILE-CNTD",$J,PKGPFX,FNUM)) DO
.. SET FILENAME=$P($G(^DIC(FNUM,0)),"^")
.. IF FILENAME]"" S FCNT=FCNT+1 SET FLDCNT=FLDCNT+$$FLDCNTR(FNUM)
.. SET ^TMP("XTVS-FILE-CNTD",$J,PKGPFX,FNUM)=""
Q FCNT
;
FLDCNTR(FILENUM) ; Return # of fields
NEW FLDCT,FIELDNUM
SET (FLDCT,FIELDNUM)=0
IF $D(^DD(FILENUM)) DO
.FOR QUIT:FIELDNUM="" QUIT:'$D(^DD(+FILENUM,+FIELDNUM)) DO
..SET FIELDNUM=$O(^DD(FILENUM,FIELDNUM))
..IF +FIELDNUM>0 DO
...SET FLDCT=FLDCT+1
...; Check for Multiples and recursively call FLDCNTR
...IF +$E($P($G(^DD(FILENUM,FIELDNUM,0)),"^",2),1,1)>0 SET FLDCT=FLDCT+$$FLDCNTR(+$P($G(^DD(FILENUM,FIELDNUM,0)),"^",2))
QUIT FLDCT
;
PROTOCOL(PKGPFX,PKGIEN,RDP,ADP) ; Count Protocols
NEW LPPFX,PFXLN,CNT,ORDIEN,SPCPOS,DASHPOS,UNDRSPOS,PRTPFX,LPCT,ADPRSET,PFXANLYS,PFXEXT
SET PFXLN=$L(PKGPFX)
SET (ADPRSET,CNT)=0
IF '$D(PKGIEN) SET PKGIEN=0
IF $D(PKGIEN),(PKGIEN="") SET PKGIEN=0
FOR LPCT=1:1 SET LPPFX=$O(ADP(LPCT)) Q:$G(ADP(LPCT))="" IF ADP(LPCT)=PKGPFX SET ADPRSET=LPCT KILL ADP(LPCT)
SET LPPFX=$O(^ORD(101,"B",PKGPFX),-1)
FOR SET LPPFX=$O(^ORD(101,"B",LPPFX)) QUIT:LPPFX="" Q:$E(LPPFX,1,$L(PKGPFX))'=PKGPFX SET ORDIEN=$O(^ORD(101,"B",LPPFX,"")) QUIT:ORDIEN="" DO
. IF $P($G(^ORD(101,ORDIEN,0)),"^",12)=PKGIEN SET CNT=CNT+1 ;In Package; count it
. IF ($P($G(^ORD(101,ORDIEN,0)),"^",12)="") DO
.. SET PRTPFX=LPPFX
.. SET SPCPOS=$FIND(PRTPFX," ")
.. SET DASHPOS=$FIND(PRTPFX,"-")
.. SET UNDRSPOS=$FIND(PRTPFX,"_")
.. SET:PRTPFX[$$PFXDLIM(SPCPOS,DASHPOS,UNDRSPOS) PRTPFX=$P(PRTPFX,$$PFXDLIM(SPCPOS,DASHPOS,UNDRSPOS))
.. IF (PRTPFX=PKGPFX),($D(RDP)),($$ADPRDPCK(PRTPFX,.RDP)) SET CNT=CNT+1 ;Do NOT count if Prefix is in Excepted list
.. IF PRTPFX'=PKGPFX DO
... SET PFXAVAIL=1
... SET PFXANLYS=PKGPFX
... FOR PFXEXT=PFXLN+1:1 Q:($E(PRTPFX,PFXEXT)'?1AN) Q:'PFXAVAIL SET PFXANLYS=PFXANLYS_$E(PRTPFX,PFXEXT) DO
.... IF $D(^TMP("XTVS-FORUM-PFXS",$J,PFXANLYS)) SET PFXAVAIL=0 ;Do NOT count if extended Prefix is a Package Prefix
.... IF $D(ADP),('$$ADPRDPCK(PFXANLYS,.ADP)) SET PFXAVAIL=0 ;Do NOT count if extended Prefix is an additional Prefix
.... IF $D(RDP),('$$ADPRDPCK(PFXANLYS,.RDP)) SET PFXAVAIL=0 ;Do NOT count if extended Prefix is excluded from Package
... IF PFXAVAIL SET CNT=CNT+1
. SET LPPFX=$$QUOTEFX(LPPFX) ;So LPPFX with quote will work with FOR loop
IF ADPRSET SET ADP(ADPRSET)=PKGPFX
Q CNT
;
CNTR(TMPGLB,CNT,PKGPFX,RDP,ADP) ; Count Templates & RPCs
NEW LPPFX,PFXLN,TMPLTPFX,PFXEXT,PFXANLYS,PFXAVAIL,SPCPOS,DASHPOS,UNDRSPOS,LPCT,ADPRSET
SET PFXLN=$L(PKGPFX)
SET ADPRSET=0
FOR LPCT=1:1 SET LPPFX=$O(ADP(LPCT)) Q:$G(ADP(LPCT))="" IF ADP(LPCT)=PKGPFX SET ADPRSET=LPCT KILL ADP(LPCT)
SET LPPFX=$O(@(TMPGLB_"""B"","""_PKGPFX_""")"),-1)
IF LPPFX["""" SET LPPFX=QUOTEFX(LPPFX)
FOR SET LPPFX=$O(@(TMPGLB_"""B"","""_LPPFX_""")")) Q:LPPFX="" Q:$E(LPPFX,1,PFXLN)'=PKGPFX DO
.SET TMPLTPFX=LPPFX
.SET SPCPOS=$FIND(TMPLTPFX," ")
.SET DASHPOS=$FIND(TMPLTPFX,"-")
.SET UNDRSPOS=$FIND(TMPLTPFX,"_")
.SET:TMPLTPFX[$$PFXDLIM(SPCPOS,DASHPOS,UNDRSPOS) TMPLTPFX=$P(TMPLTPFX,$$PFXDLIM(SPCPOS,DASHPOS,UNDRSPOS))
.IF $L(TMPLTPFX)=PFXLN,($D(RDP)),($$ADPRDPCK(TMPLTPFX,.RDP)) SET CNT=CNT+1 ;Do NOT count if Prefix is in Excepted list
.IF $L(TMPLTPFX)>PFXLN,('$D(^TMP("XTVS-FORUM-PFXS",$J,TMPLTPFX))) DO
..; Above IF: Prefix starts with PKGPFX and not a specified prefix for any package
.. SET PFXAVAIL=1
.. SET PFXANLYS=PKGPFX
.. FOR PFXEXT=PFXLN+1:1 Q:($E(TMPLTPFX,PFXEXT)'?1AN) Q:'PFXAVAIL SET PFXANLYS=PFXANLYS_$E(TMPLTPFX,PFXEXT) DO
... IF $D(^TMP("XTVS-FORUM-PFXS",$J,PFXANLYS)) SET PFXAVAIL=0 ;Do NOT count if extended Prefix is a Package Prefix
... IF $D(ADP),('$$ADPRDPCK(PFXANLYS,.ADP)) SET PFXAVAIL=0 ;Do NOT count if extended Prefix is an additional Prefix
... IF $D(RDP),('$$ADPRDPCK(PFXANLYS,.RDP)) SET PFXAVAIL=0 ;Do NOT count if extended Prefix is excluded from Package
.. IF PFXAVAIL SET CNT=CNT+1
.SET LPPFX=$$QUOTEFX(LPPFX) ;So LPPFX with quote will work with FOR loop
IF ADPRSET SET ADP(ADPRSET)=PKGPFX
Q
;
QUOTEFX(ITEMNAME) ; Return ITEMNAME with single quotes changed to double
NEW QUPDT,LPCNT,XTVSBPC
SET QUPDT=""
FOR LPCNT=1:1 SET XTVSBPC=$E(ITEMNAME,LPCNT) Q:XTVSBPC="" S QUPDT=QUPDT_XTVSBPC IF XTVSBPC="""" S QUPDT=QUPDT_""""
SET ITEMNAME=QUPDT
Q ITEMNAME
;
;
MULTX(APFX,PKGNAME) ; Return indication of Multiple packages using same prefix
;MULTX can prevent Primary prefix from double counting when added prefix on another package
; NOTE: This creates an error in AMIE because (Retired) COMP & PEN Primary = DVBC when DVBC is a legitimate added prefix for AMIE
; COMP & PEN should be deleted from the Package Parameter file
;
; ^TMP("XTVS-PREFIX-IDX",$J,PKGPFX,PKGNAME)="" ;Primary Prefix,Pkg-Name for packages in Forum Param file
; ^TMP("XTVS-FORUM-PFXS",$J,PREFIX)="" ;All Prefixes in package file
; Following ^TMP for PACKAGES in Param file : Prefix,Pkg-Name = 1 when KIDS Prefix, Null when not KIDS Prefix
; ^TMP("XTVS-IDX-PKG",$J,PREFIX,PKGNAME)=$S($D(^TMP("XTVS-KIDSPFX-IDX",$J,PREFIX)):1,1:"")
; Output: Result - 1 count prefix ; 0 don't count prefix
NEW RESULT,LPPKG
SET RESULT=1
SET LPPKG=""
;
; If not the KIDS Prefix or Primary prefix, check for duplication in other packages
IF ($G(^TMP("XTVS-KIDSPFX-IDX",$J,APFX))'=PKGNAME),('$D(^TMP("XTVS-PREFIX-IDX",$J,APFX,PKGNAME))) SET RESULT=$$CHKOTHPK(APFX,PKGNAME)
;
QUIT RESULT
;
CHKOTHPK(APFX,PKGNAME) ; Check other packages using the same prefix
NEW LPPKG,RESULT
SET LPPKG=""
SET RESULT=1
;
FOR SET LPPKG=$O(^TMP("XTVS-IDX-PKG",$J,APFX,LPPKG)) Q:LPPKG="" Q:'RESULT IF (LPPKG'=PKGNAME) DO
. IF $G(^TMP("XTVS-IDX-PKG",$J,APFX,LPPKG))=1 SET RESULT=0 ;APFX: KIDS prefix for another package in Param file
. IF $D(^TMP("XTVS-PREFIX-IDX",$J,APFX,LPPKG)) SET RESULT=0 ;APFX: Primay prefix for other package in Param file
;
QUIT RESULT
;
KIDSIDX ;Create Prefix-Package Indexes from KIDS patches for builds linked to Package file
NEW KIDSIEN,KIDSPKG,KIDSPRFX,KIDSZERO,PKGIEN,PATCHNME
SET KIDSIEN=0
FOR SET KIDSIEN=$O(^XPD(9.6,KIDSIEN)) Q:+KIDSIEN=0 DO
. SET KIDSZERO=$G(^XPD(9.6,KIDSIEN,0))
. IF KIDSZERO]"" DO
.. SET PKGIEN=$P(KIDSZERO,"^",2)
.. IF +PKGIEN>0 DO
... SET KIDSPKG=$P($G(^DIC(9.4,PKGIEN,0)),"^",1)
... SET PATCHNME=$P(KIDSZERO,"^",1)
... SET KIDSPRFX=$P(PATCHNME,"*",1)
... IF KIDSPRFX]"" SET ^TMP("XTVS-KIDSPFX-IDX",$J,KIDSPRFX)=KIDSPKG
QUIT
;
PARAMIDX ;Create Prefix Indicies
NEW PKGNAME,LINEITEM,TMPSUB,PKGPFX,ADDPRFX,PREFIX
;
SET TMPSUB=0
FOR SET TMPSUB=$O(^TMP("XTVS-PARAM-CAP",$J,TMPSUB)) QUIT:TMPSUB="" DO
.SET LINEITEM=^TMP("XTVS-PARAM-CAP",$J,TMPSUB)
.SET PKGNAME=$P(LINEITEM,"^")
.SET PKGPFX=$P(LINEITEM,"^",2)
.SET ^TMP("XTVS-PREFIX-IDX",$J,PKGPFX,PKGNAME)="" ;Primary Prefix,Pkg-Name for packages in remote (E.G. Forum) Param file
.SET ^TMP("XTVS-FORUM-PFXS",$J,PKGPFX)="" ;Prefix
.; Following ^TMP for PACKAGES in Param file: Prefix,Pkg-Name = 1 when KIDS Prefix, Null when not KIDS Prefix
.;SET ^TMP("XTVS-IDX-PKG",$J,PKGPFX,PKGNAME)=$S($D(^TMP("XTVS-KIDSPFX-IDX",$J,PKGPFX)):1,1:"")
. IF '$D(^TMP("XTVS-KIDSPFX-IDX",$J,PKGPFX)) SET ^TMP("XTVS-IDX-PKG",$J,PKGPFX,PKGNAME)=""
. IF $D(^TMP("XTVS-KIDSPFX-IDX",$J,PKGPFX)) SET ^TMP("XTVS-IDX-PKG",$J,PKGPFX,PKGNAME)=$S(^TMP("XTVS-KIDSPFX-IDX",$J,PKGPFX)=PKGNAME:1,1:"")
.;
.SET ADDPRFX=$P(LINEITEM,"^",5)
.SET LPCNT=0
.FOR PCENUM=1:1 SET PREFIX=$P(ADDPRFX,"|",PCENUM) Q:PREFIX="" DO
.. SET ^TMP("XTVS-FORUM-PFXS",$J,PREFIX)="" ;Prefix
.. ; Following ^TMP for PACKAGES in Param file : Prefix,Pkg-Name = 1 when KIDS Prefix, Null when not KIDS Prefix
.. SET ^TMP("XTVS-IDX-PKG",$J,PREFIX,PKGNAME)=$S($D(^TMP("XTVS-KIDSPFX-IDX",$J,PREFIX)):1,1:"")
;
QUIT
;
RSIZE(RTN) ; Compute routine size (# characters plus line feeds) [^%ZOSF("SIZE") algorithm]
NEW LINE,CT,RSIZEVAL
SET (CT,RSIZEVAL)=0
SET LINE=""
X "ZL @RTN F S CT=CT+1,LINE=$T(+CT) Q:$L(LINE)=0 SET RSIZEVAL=RSIZEVAL+$L(LINE)+2"
QUIT RSIZEVAL
;
PFXDLIM(SPCPOS,DASHPOS,UNDRSPOS) ; Return the delimter for lowest pos #
NEW DELIM
SET:SPCPOS=0 SPCPOS=9999
SET:DASHPOS=0 DASHPOS=9999
SET:UNDRSPOS=0 UNDRSPOS=9999
SET DELIM=" "
SET:((SPCPOS<DASHPOS)&(SPCPOS<UNDRSPOS)) DELIM=" "
SET:((DASHPOS<SPCPOS)&(DASHPOS<UNDRSPOS)) DELIM="-"
SET:((UNDRSPOS<DASHPOS)&(UNDRSPOS<SPCPOS)) DELIM="_"
QUIT DELIM
