- XTVSLPDC ;ALBANY FO/GTS - VistA Package Sizing Manager - Caption display; 12-JUL-2016
- ;;7.3;TOOLKIT;**143,152**;Apr 25, 1995;Build 3
- ;Per VA Directive 6402, this routine should not be modified.
- ;
- EN ; -- main entry point for XTVS PKG MGR PARAM CAPTN DISP
- NEW CHNGMADE
- SET CHNGMADE=0
- KILL ^TMP("XTVS-PARAM-BI",$J)
- DO EN^VALM("XTVS PKG MGR PARAM CAPTN DISP")
- QUIT
- ;
- HDR ; -- header code
- NEW DEFDIR,SPCPAD,DIRHEAD
- SET SPCPAD=""
- SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
- SET VALMHDR(1)=" VistA Package Size Analysis Manager - Captioned List"
- SET VALMHDR(2)=" Version: "_$$VERNUM^XTVSLM()_" Build: "_$$BLDNUM^XTVSLM()
- SET DIRHEAD="Default Directory: "_DEFDIR
- SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
- SET VALMHDR(3)=SPCPAD_DIRHEAD
- SET SPCPAD=""
- SET DIRHEAD="Parameter file: "_XTVPSPRM_$S(+$G(CHNGMADE)>0:" {EDITED}",1:"")
- SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
- SET VALMHDR(4)=SPCPAD_DIRHEAD
- DO MSG
- QUIT
- ;
- INIT ; -- init variables and list array
- NEW DATAITEM,PRMLNLP,PKG,CAPDAT,LPNM,LNENUM,DEFDIR,FILENAME,LCKCHK
- SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
- SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
- IF $P(LCKCHK,"^")=1 DO
- . DO KILL
- . SET PKG=""
- . SET VALMCNT=0
- . FOR SET PKG=$O(^TMP("XTVS-PARAM-CAP",$J,PKG)) Q:PKG="" DO
- .. SET LNENUM=0
- .. SET CAPDAT=""
- .. DO ADD^XTVSLAPI(.VALMCNT," ")
- .. DO ADD^XTVSLAPI(.VALMCNT," ")
- .. FOR SET LNENUM=$O(^TMP("XTVS-PARAM-CAP",$J,PKG,LNENUM)) Q:+LNENUM'>0 DO
- ... FOR SET CAPDAT=$O(^TMP("XTVS-PARAM-CAP",$J,PKG,LNENUM,CAPDAT)) Q:CAPDAT="" DO
- .... SET DATAITEM=^TMP("XTVS-PARAM-CAP",$J,PKG,LNENUM,CAPDAT)
- .... DO SPLITADD^XTVSLAPI(.VALMCNT,CAPDAT_": "_DATAITEM)
- ;
- IF ($P(LCKCHK,"^")'=1) SET VALMQUIT="" DO EXIT^XTVSLPDC
- QUIT
- ;
- HELP ; -- help code
- IF $D(X),X'["??" DO
- . SET X="?"
- . DO DISP^XQORM1 W !
- IF $D(X),X["??" DO
- . DO CLEAR^VALM1
- . DO FULL^VALM1
- . WRITE !,"Captioned List action help..."
- . WRITE !,"List specific actions:",!
- . DO DISP^XQORM1 W !!
- . SET XTQVAR=Y
- . IF XTQVAR DO
- .. SET XTQVAR=0
- .. FOR TXTCT=1:1 SET XTX=$P($T(LPDCTXT+TXTCT^XTVSHLP1),";",3,99) QUIT:XTX="$END" QUIT:XTQVAR DO
- ... IF XTX="$PAUSE" DO PAUSE^VALM1 D:Y CLEAR^VALM1 IF 'Y SET XTQVAR=1 QUIT
- ... W !,$S(XTX["$PAUSE":"",1:XTX)
- . W !
- DO HDR,INIT
- S VALMBCK="R"
- K XTX,Y,TXTCT,XTQVAR
- QUIT
- ;
- EXIT ; -- exit code
- NEW SVEDT
- SET LCKCHK=$$CHKPID^XTVSLAPI($$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I"),XTVPSPRM)
- IF $P(LCKCHK,"^")=1 DO
- . IF +$G(CHNGMADE)>0 DO
- .. DO FULL^VALM1
- .. WRITE !,"You have unsaved Package edits in this Parameter file!"
- .. SET SVEDT=+$$YNCHK^XTVSLAPI("Do you want to save the Parameter edits before exiting","YES")
- .. IF SVEDT DO PKGSAVE
- .. IF $G(CHNGMADE)>0 DO JUSTPAWS^XTVSLAPI(" Package edits NOT saved!")
- .. IF $G(CHNGMADE)'>0 DO JUSTPAWS^XTVSLAPI(" Package edits saved!")
- ;
- IF ($P(LCKCHK,"^")'=1) DO
- . DO FULL^VALM1
- . W !!," <* LOCK ERROR. LOCK required to proceed. Check LOCK file Integrity. *>"
- . DO JUSTPAWS^XTVSLAPI($P(LCKCHK,"^",2))
- ;
- KILL ^TMP("XTVS-PARAM-BI",$J),LASTSPKG
- DO KILL
- Q
- ;
- MSG(TEXT) ; -- set default message
- IF $G(TEXT)]"" SET VALMSG=TEXT
- IF $G(TEXT)']"" SET VALMSG="Enter ?? for more actions and Help"
- QUIT
- ;
- KILL ; - Cleanup local and global display arrays
- DO CLEAN^VALM10 ;Kill data and video control arrays
- DO KILL^VALM10() ;Kill Video attributes
- KILL ^TMP("XTVS PKG MGR PARAM CAP",$J)
- QUIT
- ;
- SELPKG(ADDITM,DELIND) ; Select Package to Edit/Delete from ^TMP("XTVS PKG MGR PARAM CAP",$J)
- ; INPUT:
- ; ADDITM : 0 - Do not allow add new package [Default]
- ; : 1 - Allow add new package
- ; DELIND : 0 - Called to select a package for add/edit [Default]
- ; 1 - Called to select a package to delete
- ;
- ; Set: ITEMNUM - Number of items in SELARY
- ; SELARY - Array of Package Parameter files
- ; PARAMSTR - Array of string parameters as follows:
- ; PARAMSTR("ADDITM") - 0: Adding item to SELARY NOT Allowed; 1: Adding unique item to SELARY Allowed 1^1: Add duplicates allowed
- ; PARAMSTR("MAXLNG") - Maximum length of entered string [default 30, or 10 more than MINLNG when MINLNG>MAXLNG]
- ; PARAMSTR("MINLNG") - Minumum length of entered string [default 10] - DEV NOTE: MINLNG must be > or = #Chars in PATRN begin & end strings
- ; PARAMSTR("PATRN") - Pattern match definition for text [default .ANP)
- ; PARAMSTR("XTUPCASE") - 0: case matters, 1: All item text translated to upper case [default]
- ;
- ;
- ; RETURN - Name of the selected Package
- ;
- NEW DIR,DIRUT,DTOUT,DUOUT,X,Y,MINLG,MAXLG,PARAMSTR,SELARY,ITEMNUM,PKGNME
- SET PARAMSTR("ADDITM")=+$G(ADDITM) ;Default - 0 No adding items
- SET PARAMSTR("XTUPCASE")=0 ; Case matters
- SET PARAMSTR("PATRN")=".ANP"
- SET PARAMSTR("MINLNG")=4
- SET PARAMSTR("MAXLNG")=50
- SET DELIND=+$G(DELIND) ; Default 0 (add/edit)
- SET PARAMSTR("DELIND")=DELIND
- SET SELARY=""
- ;
- SET ITEMNUM=$$SETSELAY(.SELARY)
- SET PARAMSTR("ITEMNUM")=ITEMNUM
- ;
- IF +ITEMNUM=0 DO JUSTPAWS^XTVSLAPI(" No packages to select. Corrupted Package parameter file!") QUIT ;Nothing to select
- ;
- SET DIR("A")="Select Package: "
- SET DIR(0)="NAO^1:"_(ITEMNUM+1)_"^K:(X'?.N) X I $D(X),(X>ITEMNUM) K X"
- SET DIR("PRE")="D PRECHK^XTVSLPDC(.X,.LASTSPKG,.SELARY,.ITEMNUM,.PARAMSTR)"
- IF 'ADDITM,('DELIND) SET DIR("?",2)=" New items cannot be added."
- IF ADDITM,('$P(ADDITM,"^",2)) SET DIR("?",2)=" New items can be added but duplicates are not allowed."
- SET DIR("?",1)=" Enter the name or number (1-"_ITEMNUM_") of the Package."
- SET DIR("?")=" [Enter '??' for a numbered list of items OR '^' to exit]"
- SET DIR("??")="^DO LISTOUT^XTVSLAPI(.SELARY)"
- DO ^DIR
- ;
- SET PKGNME=$S(+$G(X)>0:SELARY(X),1:0) ; Return 0 if package not selected
- IF PKGNME'=0 SET LASTSPKG=PKGNME W " ",PKGNME
- ;
- QUIT PKGNME
- ;
- PRECHK(X,LASTSPKG,SELARY,ITEMNUM,PARAMSTR) ; SELPKG X value DIR("PRE") pre-check
- NEW XTVSSAVX,DELIND
- SET DELIND=+$G(PARAMSTR("DELIND"))
- IF (X=" "),($G(LASTSPKG)]"") SET (XTVSSAVX,X)=LASTSPKG W " ",LASTSPKG
- IF (X]""),('$D(DTOUT)),($E(X,1)'="^") DO
- . IF (X'?.N),($E(X,1)'["?") DO SELLIST^XTVSLPR2(.SELARY,.ITEMNUM,.X,.PARAMSTR)
- IF DELIND,($G(XTVSSAVX)]""),('$D(X)!($D(X)&$G(X)']"")) D SPCPKGCK(XTVSSAVX,ITEMNUM,.SELARY)
- QUIT
- ;
- EDITPRM ; Edit parameters for a package
- ; -- Protocol: XTVS PKG MGR EDIT PACKAGE PARM ACTION
- ;
- ;Logic notes:
- ; Select package name
- ; Edit package data in ^TMP("XTVS-PARAM-CAP") array
- ; Redisplay all 'Edited' packages to screen, set "Edit" [CHNGMADE] param to allow Write Edited pkgs action
- ;
- NEW PKGNME,EDITARY,CAPARY,EDPKG,DEFDIR,LCKCHK
- SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
- SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
- IF $P(LCKCHK,"^")=1 DO
- . DO FULL^VALM1
- . SET PKGNME=$$SELPKG(1)
- . IF PKGNME'=0 DO
- ..;
- .. IF PKGNME["""" DO ;Assumes that " only in PKGNME via Add New Package (XT*7.3*152)
- ... SET PKGNME=$REPLACE(PKGNME,"""","''")
- ... SET LASTSPKG=PKGNME
- ... DO JUSTPAWS^XTVSLAPI("Quotation marks changed to apostrophes in "_PKGNME_" name.")
- ..;
- .. IF '$D(^TMP("XTVS-PARAM-CAP",$J,PKGNME)) DO SETADD(PKGNME)
- .. IF '$D(^TMP("XTVS-PARAM-BI",$J,PKGNME)) DO BEFORIMG^XTVSLPD1(PKGNME)
- .. SET CAPARY="^TMP(""XTVS-PARAM-CAP"","_$J_","""_PKGNME_""")"
- .. DO EDPKGPRM^XTVSLPD1(PKGNME)
- .. SET EDPKG=$$EDCHK^XTVSLPD1(PKGNME)
- .. IF EDPKG SET @CAPARY=$$SETSTR^XTVSLPD1(CAPARY) ;Update header
- .. IF 'EDPKG KILL ^TMP("XTVS-PARAM-BI",$J,PKGNME)
- .. SET CHNGMADE=$E($D(^TMP("XTVS-PARAM-BI",$J)),1,1)
- ..;
- .. SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
- .. SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
- .. IF $P(LCKCHK,"^")=1 DO HDR,INIT
- .;
- . IF PKGNME=0 DO JUSTPAWS^XTVSLAPI(" Package Not Selected.") DO MSG
- ;
- IF $P(LCKCHK,"^")=1 SET VALMBCK="R"
- IF $P(LCKCHK,"^")'=1 SET VALMQUIT=""
- QUIT
- ;
- DELPMPKG ; Delete parameters from a package
- ; -- Protocol: XTVS PKG MGR DEL PACKAGE PARM ACTION
- ;
- NEW PKGNME,CAPARY,DELPKG,LCKCHK,DEFDIR
- SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
- SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
- IF $P(LCKCHK,"^")=1 DO
- . DO FULL^VALM1
- . SET PKGNME=$$SELPKG(0,1)
- . IF PKGNME'=0 DO
- .. SET CAPARY="^TMP(""XTVS-PARAM-CAP"","_$J_","""_PKGNME_""")"
- .. WRITE !,"You have chosen to delete the "_PKGNME_" entry"
- .. WRITE !," from the "_XTVPSPRM_" Package Parameter file.",!
- .. WRITE !,"[If deleted, "_PKGNME_" will not be included"
- .. WRITE !," in any VistA Size Report derived from "_XTVPSPRM_"!]",!
- .. SET DELPKG=+$$YNCHK^XTVSLAPI("Are you SURE you want to delete the parameters for this package")
- .. IF 'DELPKG DO MSG
- .. IF DELPKG DO
- ... IF '$D(^TMP("XTVS-PARAM-BI",$J,PKGNME)) DO BEFORIMG^XTVSLPD1(PKGNME) ; Create BI when delete an existing, unedited package.
- ... KILL @CAPARY
- ... IF $D(^TMP("XTVS-PARAM-BI",$J,PKGNME,2,"Primary Prefix")),((^TMP("XTVS-PARAM-BI",$J,PKGNME,2,"Primary Prefix"))="") KILL ^TMP("XTVS-PARAM-BI",$J,PKGNME)
- ... SET CHNGMADE=$E($D(^TMP("XTVS-PARAM-BI",$J)),1,1)
- ... DO:$P($$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM),"^")=1 HDR,INIT
- .;
- . IF PKGNME=0 DO JUSTPAWS^XTVSLAPI(" Package Not Selected.") DO MSG
- .;
- . SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
- . SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
- ;
- IF $P(LCKCHK,"^")=1 SET VALMBCK="R"
- IF $P(LCKCHK,"^")'=1 SET VALMBCK="Q" SET VALMQUIT=""
- QUIT
- ;
- SAVPMPKG ; Save Package Parameters file
- ; -- Protocol: XTVS PKG MGR SAVE PACKAGE PARM ACTION
- ;
- NEW LCKCHK,DEFDIR
- SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
- SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
- IF $P(LCKCHK,"^")=1 DO
- . DO FULL^VALM1
- . IF +$G(CHNGMADE)'>0 DO JUSTPAWS^XTVSLAPI("File Content not edited. No modifications to save!") DO MSG
- . IF +$G(CHNGMADE)>0 DO
- .. DO PKGSAVE
- .. IF $G(CHNGMADE)'>0 DO HDR,INIT
- .. IF $G(CHNGMADE)>0 DO MSG
- . SET VALMBCK="R"
- ;
- IF $P(LCKCHK,"^")'=1 SET VALMQUIT=""
- QUIT
- ;
- PKGSAVE ;Save Package Changes
- NEW NOWDT,INITIAL,PKGNME,WNFILE,WOFILE,FILENME,DEFDIR
- SET NOWDT=$$FMTE^XLFDT($$NOW^XLFDT,"2M")
- SET NOWDT=$TR(NOWDT,"/","-")
- SET NOWDT=$TR(NOWDT,"@","_")
- SET NOWDT=$TR(NOWDT,":","")
- SET INITIAL=$P($G(^VA(200,DUZ,0)),"^",2)
- IF INITIAL']"" SET INITIAL="<unk>"
- SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
- ;
- SET (WNFILE,WOFILE)=0
- SET WNFILE=+$$YNCHK^XTVSLAPI("Do you want to create a new package parameters file")
- SET:'WNFILE WOFILE=+$$YNCHK^XTVSLAPI("Do you want to OVERWRITE the existing package parameters file")
- IF (WNFILE)!(WOFILE) DO
- . NEW DELRSLT
- . IF WNFILE SET FILENME="XTMPSIZE"_"_"_INITIAL_NOWDT_".DAT" ;Output a New Parameter file
- . ;
- . SET DELRSLT=1 ; Initialize DELRSLT (delete Result) variable
- . IF WOFILE DO ;Write Old File: FILENME remains the selected/displayed parameter file
- .. NEW DELFLE,OLDFNME,CHKLKER
- .. SET FILENME=XTVPSPRM
- .. IF FILENME[";" SET FILENME=$P(FILENME,";")
- .. SET OLDFNME=$P(FILENME,".")_".BAK"
- .. SET DELFLE(OLDFNME)="" SET DELRSLT=$$DEL^%ZISH(DEFDIR,$NA(DELFLE)) K DELFLE(OLDFNME) ;Delete current Parameter file
- .. SET DELRSLT=$$MV^%ZISH(DEFDIR,XTVPSPRM,DEFDIR,OLDFNME) ;Save current file to "BAK" before overwriting
- .. IF DELRSLT SET DELFLE(XTVPSPRM)="" SET DELRSLT=$$DEL^%ZISH(DEFDIR,$NA(DELFLE)) ;Delete current Parameter file
- .. SET FILENME=XTVPSPRM
- .. DO CRTFLE(DEFDIR,FILENME,WNFILE)
- . ;
- . ; If file name definitions and copies were completed successfully, create the Parameter file
- . IF DELRSLT DO
- .. IF WNFILE DO ;Write New File
- ... SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI(XTVPSPRM)
- ... IF ($P(UNLKRSLT,"^")'=1) W !!," <* UNLOCK ERROR. Check LOCK file Integrity. *>"
- ... DO JUSTPAWS^XTVSLAPI($P(UNLKRSLT,"^",2))
- ... IF ($P(UNLKRSLT,"^")=1) DO CRTFLE(DEFDIR,FILENME,WNFILE)
- ;
- QUIT
- ;
- CRTFLE(DEFDIR,FILENME,WNFILE) ; Update old file/Write New file
- NEW POPERR,CHKLKER
- SET POPERR=0
- DO OPEN^%ZISH("XTMP",DEFDIR,FILENME,"A")
- SET:POP POPERR=POP
- IF 'POPERR DO
- . U IO
- . SET PKGNME=""
- . FOR SET PKGNME=$O(^TMP("XTVS-PARAM-CAP",$J,PKGNME)) QUIT:PKGNME']"" WRITE !,^TMP("XTVS-PARAM-CAP",$J,PKGNME)
- . D CLOSE^%ZISH("XTMP")
- . SET XTVPSPRM=FILENME
- . SET CHNGMADE=0
- . KILL ^TMP("XTVS-PARAM-BI",$J)
- . IF WNFILE DO
- .. SET CHKLKER=$$REQLOCK^XTVSLAPI(XTVPSPRM)
- .. DO JUSTPAWS^XTVSLAPI($P(CHKLKER,"^",2))
- QUIT
- ;
- SETADD(X) ; Add a new package to ^TMP("XTVS-PARAM-CAP")
- SET ^TMP("XTVS-PARAM-CAP",$J,X)=X ;Create new entry in TMP global
- SET ^TMP("XTVS-PARAM-CAP",$J,X,1,"Package Name")=X
- SET ^TMP("XTVS-PARAM-CAP",$J,X,2,"Primary Prefix")=""
- SET ^TMP("XTVS-PARAM-CAP",$J,X,3,"*Lowest File#")=""
- SET ^TMP("XTVS-PARAM-CAP",$J,X,4,"*Highest File#")=""
- SET ^TMP("XTVS-PARAM-CAP",$J,X,5,"Additional Prefixes")=""
- SET ^TMP("XTVS-PARAM-CAP",$J,X,6,"Excepted Prefixes")=""
- SET ^TMP("XTVS-PARAM-CAP",$J,X,7,"File Numbers")=""
- SET ^TMP("XTVS-PARAM-CAP",$J,X,8,"File Ranges")=""
- SET ^TMP("XTVS-PARAM-CAP",$J,X,9,"Parent Package")=""
- QUIT
- ;
- SETSELAY(SELARY) ; Move Package names to SELARY from ^TMP("XTVS-PARAM-CAP") array
- NEW ITEMNUM,FILENME
- SET FILENME=""
- SET ITEMNUM=0
- FOR SET FILENME=$O(^TMP("XTVS-PARAM-CAP",$J,FILENME)) Q:FILENME="" DO
- . SET ITEMNUM=ITEMNUM+1 SET SELARY(ITEMNUM)=FILENME ;Parameter list
- QUIT ITEMNUM
- ;
- SPCPKGCK(XTVSSAVX,ITEMNUM,SELARY) ; Check for existence of the <SPACE> select package in SELARY
- NEW SELARYCT
- FOR SELARYCT=1:1:ITEMNUM QUIT:(SELARY(SELARYCT)=XTVSSAVX)
- IF (+SELARYCT+1)>(+ITEMNUM) W !!,"?? ",XTVSSAVX_" VistA package is undefined."
- QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTVSLPDC 13838 printed Feb 19, 2025@00:08:43 Page 2
- XTVSLPDC ;ALBANY FO/GTS - VistA Package Sizing Manager - Caption display; 12-JUL-2016
- +1 ;;7.3;TOOLKIT;**143,152**;Apr 25, 1995;Build 3
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- EN ; -- main entry point for XTVS PKG MGR PARAM CAPTN DISP
- +1 NEW CHNGMADE
- +2 SET CHNGMADE=0
- +3 KILL ^TMP("XTVS-PARAM-BI",$JOB)
- +4 DO EN^VALM("XTVS PKG MGR PARAM CAPTN DISP")
- +5 QUIT
- +6 ;
- HDR ; -- header code
- +1 NEW DEFDIR,SPCPAD,DIRHEAD
- +2 SET SPCPAD=""
- +3 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
- +4 SET VALMHDR(1)=" VistA Package Size Analysis Manager - Captioned List"
- +5 SET VALMHDR(2)=" Version: "_$$VERNUM^XTVSLM()_" Build: "_$$BLDNUM^XTVSLM()
- +6 SET DIRHEAD="Default Directory: "_DEFDIR
- +7 SET $PIECE(SPCPAD," ",(80-$LENGTH(DIRHEAD))/2)=""
- +8 SET VALMHDR(3)=SPCPAD_DIRHEAD
- +9 SET SPCPAD=""
- +10 SET DIRHEAD="Parameter file: "_XTVPSPRM_$SELECT(+$GET(CHNGMADE)>0:" {EDITED}",1:"")
- +11 SET $PIECE(SPCPAD," ",(80-$LENGTH(DIRHEAD))/2)=""
- +12 SET VALMHDR(4)=SPCPAD_DIRHEAD
- +13 DO MSG
- +14 QUIT
- +15 ;
- INIT ; -- init variables and list array
- +1 NEW DATAITEM,PRMLNLP,PKG,CAPDAT,LPNM,LNENUM,DEFDIR,FILENAME,LCKCHK
- +2 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
- +3 SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
- +4 IF $PIECE(LCKCHK,"^")=1
- Begin DoDot:1
- +5 DO KILL
- +6 SET PKG=""
- +7 SET VALMCNT=0
- +8 FOR
- SET PKG=$ORDER(^TMP("XTVS-PARAM-CAP",$JOB,PKG))
- if PKG=""
- QUIT
- Begin DoDot:2
- +9 SET LNENUM=0
- +10 SET CAPDAT=""
- +11 DO ADD^XTVSLAPI(.VALMCNT," ")
- +12 DO ADD^XTVSLAPI(.VALMCNT," ")
- +13 FOR
- SET LNENUM=$ORDER(^TMP("XTVS-PARAM-CAP",$JOB,PKG,LNENUM))
- if +LNENUM'>0
- QUIT
- Begin DoDot:3
- +14 FOR
- SET CAPDAT=$ORDER(^TMP("XTVS-PARAM-CAP",$JOB,PKG,LNENUM,CAPDAT))
- if CAPDAT=""
- QUIT
- Begin DoDot:4
- +15 SET DATAITEM=^TMP("XTVS-PARAM-CAP",$JOB,PKG,LNENUM,CAPDAT)
- +16 DO SPLITADD^XTVSLAPI(.VALMCNT,CAPDAT_": "_DATAITEM)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +17 ;
- +18 IF ($PIECE(LCKCHK,"^")'=1)
- SET VALMQUIT=""
- DO EXIT^XTVSLPDC
- +19 QUIT
- +20 ;
- HELP ; -- help code
- +1 IF $DATA(X)
- IF X'["??"
- Begin DoDot:1
- +2 SET X="?"
- +3 DO DISP^XQORM1
- WRITE !
- End DoDot:1
- +4 IF $DATA(X)
- IF X["??"
- Begin DoDot:1
- +5 DO CLEAR^VALM1
- +6 DO FULL^VALM1
- +7 WRITE !,"Captioned List action help..."
- +8 WRITE !,"List specific actions:",!
- +9 DO DISP^XQORM1
- WRITE !!
- +10 SET XTQVAR=Y
- +11 IF XTQVAR
- Begin DoDot:2
- +12 SET XTQVAR=0
- +13 FOR TXTCT=1:1
- SET XTX=$PIECE($TEXT(LPDCTXT+TXTCT^XTVSHLP1),";",3,99)
- if XTX="$END"
- QUIT
- if XTQVAR
- QUIT
- Begin DoDot:3
- +14 IF XTX="$PAUSE"
- DO PAUSE^VALM1
- if Y
- DO CLEAR^VALM1
- IF 'Y
- SET XTQVAR=1
- QUIT
- +15 WRITE !,$SELECT(XTX["$PAUSE":"",1:XTX)
- End DoDot:3
- End DoDot:2
- +16 WRITE !
- End DoDot:1
- +17 DO HDR
- DO INIT
- +18 SET VALMBCK="R"
- +19 KILL XTX,Y,TXTCT,XTQVAR
- +20 QUIT
- +21 ;
- EXIT ; -- exit code
- +1 NEW SVEDT
- +2 SET LCKCHK=$$CHKPID^XTVSLAPI($$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I"),XTVPSPRM)
- +3 IF $PIECE(LCKCHK,"^")=1
- Begin DoDot:1
- +4 IF +$GET(CHNGMADE)>0
- Begin DoDot:2
- +5 DO FULL^VALM1
- +6 WRITE !,"You have unsaved Package edits in this Parameter file!"
- +7 SET SVEDT=+$$YNCHK^XTVSLAPI("Do you want to save the Parameter edits before exiting","YES")
- +8 IF SVEDT
- DO PKGSAVE
- +9 IF $GET(CHNGMADE)>0
- DO JUSTPAWS^XTVSLAPI(" Package edits NOT saved!")
- +10 IF $GET(CHNGMADE)'>0
- DO JUSTPAWS^XTVSLAPI(" Package edits saved!")
- End DoDot:2
- End DoDot:1
- +11 ;
- +12 IF ($PIECE(LCKCHK,"^")'=1)
- Begin DoDot:1
- +13 DO FULL^VALM1
- +14 WRITE !!," <* LOCK ERROR. LOCK required to proceed. Check LOCK file Integrity. *>"
- +15 DO JUSTPAWS^XTVSLAPI($PIECE(LCKCHK,"^",2))
- End DoDot:1
- +16 ;
- +17 KILL ^TMP("XTVS-PARAM-BI",$JOB),LASTSPKG
- +18 DO KILL
- +19 QUIT
- +20 ;
- MSG(TEXT) ; -- set default message
- +1 IF $GET(TEXT)]""
- SET VALMSG=TEXT
- +2 IF $GET(TEXT)']""
- SET VALMSG="Enter ?? for more actions and Help"
- +3 QUIT
- +4 ;
- KILL ; - Cleanup local and global display arrays
- +1 ;Kill data and video control arrays
- DO CLEAN^VALM10
- +2 ;Kill Video attributes
- DO KILL^VALM10()
- +3 KILL ^TMP("XTVS PKG MGR PARAM CAP",$JOB)
- +4 QUIT
- +5 ;
- SELPKG(ADDITM,DELIND) ; Select Package to Edit/Delete from ^TMP("XTVS PKG MGR PARAM CAP",$J)
- +1 ; INPUT:
- +2 ; ADDITM : 0 - Do not allow add new package [Default]
- +3 ; : 1 - Allow add new package
- +4 ; DELIND : 0 - Called to select a package for add/edit [Default]
- +5 ; 1 - Called to select a package to delete
- +6 ;
- +7 ; Set: ITEMNUM - Number of items in SELARY
- +8 ; SELARY - Array of Package Parameter files
- +9 ; PARAMSTR - Array of string parameters as follows:
- +10 ; PARAMSTR("ADDITM") - 0: Adding item to SELARY NOT Allowed; 1: Adding unique item to SELARY Allowed 1^1: Add duplicates allowed
- +11 ; PARAMSTR("MAXLNG") - Maximum length of entered string [default 30, or 10 more than MINLNG when MINLNG>MAXLNG]
- +12 ; PARAMSTR("MINLNG") - Minumum length of entered string [default 10] - DEV NOTE: MINLNG must be > or = #Chars in PATRN begin & end strings
- +13 ; PARAMSTR("PATRN") - Pattern match definition for text [default .ANP)
- +14 ; PARAMSTR("XTUPCASE") - 0: case matters, 1: All item text translated to upper case [default]
- +15 ;
- +16 ;
- +17 ; RETURN - Name of the selected Package
- +18 ;
- +19 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y,MINLG,MAXLG,PARAMSTR,SELARY,ITEMNUM,PKGNME
- +20 ;Default - 0 No adding items
- SET PARAMSTR("ADDITM")=+$GET(ADDITM)
- +21 ; Case matters
- SET PARAMSTR("XTUPCASE")=0
- +22 SET PARAMSTR("PATRN")=".ANP"
- +23 SET PARAMSTR("MINLNG")=4
- +24 SET PARAMSTR("MAXLNG")=50
- +25 ; Default 0 (add/edit)
- SET DELIND=+$GET(DELIND)
- +26 SET PARAMSTR("DELIND")=DELIND
- +27 SET SELARY=""
- +28 ;
- +29 SET ITEMNUM=$$SETSELAY(.SELARY)
- +30 SET PARAMSTR("ITEMNUM")=ITEMNUM
- +31 ;
- +32 ;Nothing to select
- IF +ITEMNUM=0
- DO JUSTPAWS^XTVSLAPI(" No packages to select. Corrupted Package parameter file!")
- QUIT
- +33 ;
- +34 SET DIR("A")="Select Package: "
- +35 SET DIR(0)="NAO^1:"_(ITEMNUM+1)_"^K:(X'?.N) X I $D(X),(X>ITEMNUM) K X"
- +36 SET DIR("PRE")="D PRECHK^XTVSLPDC(.X,.LASTSPKG,.SELARY,.ITEMNUM,.PARAMSTR)"
- +37 IF 'ADDITM
- IF ('DELIND)
- SET DIR("?",2)=" New items cannot be added."
- +38 IF ADDITM
- IF ('$PIECE(ADDITM,"^",2))
- SET DIR("?",2)=" New items can be added but duplicates are not allowed."
- +39 SET DIR("?",1)=" Enter the name or number (1-"_ITEMNUM_") of the Package."
- +40 SET DIR("?")=" [Enter '??' for a numbered list of items OR '^' to exit]"
- +41 SET DIR("??")="^DO LISTOUT^XTVSLAPI(.SELARY)"
- +42 DO ^DIR
- +43 ;
- +44 ; Return 0 if package not selected
- SET PKGNME=$SELECT(+$GET(X)>0:SELARY(X),1:0)
- +45 IF PKGNME'=0
- SET LASTSPKG=PKGNME
- WRITE " ",PKGNME
- +46 ;
- +47 QUIT PKGNME
- +48 ;
- PRECHK(X,LASTSPKG,SELARY,ITEMNUM,PARAMSTR) ; SELPKG X value DIR("PRE") pre-check
- +1 NEW XTVSSAVX,DELIND
- +2 SET DELIND=+$GET(PARAMSTR("DELIND"))
- +3 IF (X=" ")
- IF ($GET(LASTSPKG)]"")
- SET (XTVSSAVX,X)=LASTSPKG
- WRITE " ",LASTSPKG
- +4 IF (X]"")
- IF ('$DATA(DTOUT))
- IF ($EXTRACT(X,1)'="^")
- Begin DoDot:1
- +5 IF (X'?.N)
- IF ($EXTRACT(X,1)'["?")
- DO SELLIST^XTVSLPR2(.SELARY,.ITEMNUM,.X,.PARAMSTR)
- End DoDot:1
- +6 IF DELIND
- IF ($GET(XTVSSAVX)]"")
- IF ('$DATA(X)!($DATA(X)&$GET(X)']""))
- DO SPCPKGCK(XTVSSAVX,ITEMNUM,.SELARY)
- +7 QUIT
- +8 ;
- EDITPRM ; Edit parameters for a package
- +1 ; -- Protocol: XTVS PKG MGR EDIT PACKAGE PARM ACTION
- +2 ;
- +3 ;Logic notes:
- +4 ; Select package name
- +5 ; Edit package data in ^TMP("XTVS-PARAM-CAP") array
- +6 ; Redisplay all 'Edited' packages to screen, set "Edit" [CHNGMADE] param to allow Write Edited pkgs action
- +7 ;
- +8 NEW PKGNME,EDITARY,CAPARY,EDPKG,DEFDIR,LCKCHK
- +9 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
- +10 SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
- +11 IF $PIECE(LCKCHK,"^")=1
- Begin DoDot:1
- +12 DO FULL^VALM1
- +13 SET PKGNME=$$SELPKG(1)
- +14 IF PKGNME'=0
- Begin DoDot:2
- +15 ;
- +16 ;Assumes that " only in PKGNME via Add New Package (XT*7.3*152)
- IF PKGNME[""""
- Begin DoDot:3
- +17
- *** ERROR ***
- SET PKGNME=$REPLACE(PKGNME,"""","''")
- +18 SET LASTSPKG=PKGNME
- +19 DO JUSTPAWS^XTVSLAPI("Quotation marks changed to apostrophes in "_PKGNME_" name.")
- End DoDot:3
- +20 ;
- +21 IF '$DATA(^TMP("XTVS-PARAM-CAP",$JOB,PKGNME))
- DO SETADD(PKGNME)
- +22 IF '$DATA(^TMP("XTVS-PARAM-BI",$JOB,PKGNME))
- DO BEFORIMG^XTVSLPD1(PKGNME)
- +23 SET CAPARY="^TMP(""XTVS-PARAM-CAP"","_$JOB_","""_PKGNME_""")"
- +24 DO EDPKGPRM^XTVSLPD1(PKGNME)
- +25 SET EDPKG=$$EDCHK^XTVSLPD1(PKGNME)
- +26 ;Update header
- IF EDPKG
- SET @CAPARY=$$SETSTR^XTVSLPD1(CAPARY)
- +27 IF 'EDPKG
- KILL ^TMP("XTVS-PARAM-BI",$JOB,PKGNME)
- +28 SET CHNGMADE=$EXTRACT($DATA(^TMP("XTVS-PARAM-BI",$JOB)),1,1)
- +29 ;
- +30 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
- +31 SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
- +32 IF $PIECE(LCKCHK,"^")=1
- DO HDR
- DO INIT
- End DoDot:2
- +33 ;
- +34 IF PKGNME=0
- DO JUSTPAWS^XTVSLAPI(" Package Not Selected.")
- DO MSG
- End DoDot:1
- +35 ;
- +36 IF $PIECE(LCKCHK,"^")=1
- SET VALMBCK="R"
- +37 IF $PIECE(LCKCHK,"^")'=1
- SET VALMQUIT=""
- +38 QUIT
- +39 ;
- DELPMPKG ; Delete parameters from a package
- +1 ; -- Protocol: XTVS PKG MGR DEL PACKAGE PARM ACTION
- +2 ;
- +3 NEW PKGNME,CAPARY,DELPKG,LCKCHK,DEFDIR
- +4 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
- +5 SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
- +6 IF $PIECE(LCKCHK,"^")=1
- Begin DoDot:1
- +7 DO FULL^VALM1
- +8 SET PKGNME=$$SELPKG(0,1)
- +9 IF PKGNME'=0
- Begin DoDot:2
- +10 SET CAPARY="^TMP(""XTVS-PARAM-CAP"","_$JOB_","""_PKGNME_""")"
- +11 WRITE !,"You have chosen to delete the "_PKGNME_" entry"
- +12 WRITE !," from the "_XTVPSPRM_" Package Parameter file.",!
- +13 WRITE !,"[If deleted, "_PKGNME_" will not be included"
- +14 WRITE !," in any VistA Size Report derived from "_XTVPSPRM_"!]",!
- +15 SET DELPKG=+$$YNCHK^XTVSLAPI("Are you SURE you want to delete the parameters for this package")
- +16 IF 'DELPKG
- DO MSG
- +17 IF DELPKG
- Begin DoDot:3
- +18 ; Create BI when delete an existing, unedited package.
- IF '$DATA(^TMP("XTVS-PARAM-BI",$JOB,PKGNME))
- DO BEFORIMG^XTVSLPD1(PKGNME)
- +19 KILL @CAPARY
- +20 IF $DATA(^TMP("XTVS-PARAM-BI",$JOB,PKGNME,2,"Primary Prefix"))
- IF ((^TMP("XTVS-PARAM-BI",$JOB,PKGNME,2,"Primary Prefix"))="")
- KILL ^TMP("XTVS-PARAM-BI",$JOB,PKGNME)
- +21 SET CHNGMADE=$EXTRACT($DATA(^TMP("XTVS-PARAM-BI",$JOB)),1,1)
- +22 if $PIECE($$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM),"^")=1
- DO HDR
- DO INIT
- End DoDot:3
- End DoDot:2
- +23 ;
- +24 IF PKGNME=0
- DO JUSTPAWS^XTVSLAPI(" Package Not Selected.")
- DO MSG
- +25 ;
- +26 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
- +27 SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
- End DoDot:1
- +28 ;
- +29 IF $PIECE(LCKCHK,"^")=1
- SET VALMBCK="R"
- +30 IF $PIECE(LCKCHK,"^")'=1
- SET VALMBCK="Q"
- SET VALMQUIT=""
- +31 QUIT
- +32 ;
- SAVPMPKG ; Save Package Parameters file
- +1 ; -- Protocol: XTVS PKG MGR SAVE PACKAGE PARM ACTION
- +2 ;
- +3 NEW LCKCHK,DEFDIR
- +4 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
- +5 SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
- +6 IF $PIECE(LCKCHK,"^")=1
- Begin DoDot:1
- +7 DO FULL^VALM1
- +8 IF +$GET(CHNGMADE)'>0
- DO JUSTPAWS^XTVSLAPI("File Content not edited. No modifications to save!")
- DO MSG
- +9 IF +$GET(CHNGMADE)>0
- Begin DoDot:2
- +10 DO PKGSAVE
- +11 IF $GET(CHNGMADE)'>0
- DO HDR
- DO INIT
- +12 IF $GET(CHNGMADE)>0
- DO MSG
- End DoDot:2
- +13 SET VALMBCK="R"
- End DoDot:1
- +14 ;
- +15 IF $PIECE(LCKCHK,"^")'=1
- SET VALMQUIT=""
- +16 QUIT
- +17 ;
- PKGSAVE ;Save Package Changes
- +1 NEW NOWDT,INITIAL,PKGNME,WNFILE,WOFILE,FILENME,DEFDIR
- +2 SET NOWDT=$$FMTE^XLFDT($$NOW^XLFDT,"2M")
- +3 SET NOWDT=$TRANSLATE(NOWDT,"/","-")
- +4 SET NOWDT=$TRANSLATE(NOWDT,"@","_")
- +5 SET NOWDT=$TRANSLATE(NOWDT,":","")
- +6 SET INITIAL=$PIECE($GET(^VA(200,DUZ,0)),"^",2)
- +7 IF INITIAL']""
- SET INITIAL="<unk>"
- +8 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
- +9 ;
- +10 SET (WNFILE,WOFILE)=0
- +11 SET WNFILE=+$$YNCHK^XTVSLAPI("Do you want to create a new package parameters file")
- +12 if 'WNFILE
- SET WOFILE=+$$YNCHK^XTVSLAPI("Do you want to OVERWRITE the existing package parameters file")
- +13 IF (WNFILE)!(WOFILE)
- Begin DoDot:1
- +14 NEW DELRSLT
- +15 ;Output a New Parameter file
- IF WNFILE
- SET FILENME="XTMPSIZE"_"_"_INITIAL_NOWDT_".DAT"
- +16 ;
- +17 ; Initialize DELRSLT (delete Result) variable
- SET DELRSLT=1
- +18 ;Write Old File: FILENME remains the selected/displayed parameter file
- IF WOFILE
- Begin DoDot:2
- +19 NEW DELFLE,OLDFNME,CHKLKER
- +20 SET FILENME=XTVPSPRM
- +21 IF FILENME[";"
- SET FILENME=$PIECE(FILENME,";")
- +22 SET OLDFNME=$PIECE(FILENME,".")_".BAK"
- +23 ;Delete current Parameter file
- SET DELFLE(OLDFNME)=""
- SET DELRSLT=$$DEL^%ZISH(DEFDIR,$NAME(DELFLE))
- KILL DELFLE(OLDFNME)
- +24 ;Save current file to "BAK" before overwriting
- SET DELRSLT=$$MV^%ZISH(DEFDIR,XTVPSPRM,DEFDIR,OLDFNME)
- +25 ;Delete current Parameter file
- IF DELRSLT
- SET DELFLE(XTVPSPRM)=""
- SET DELRSLT=$$DEL^%ZISH(DEFDIR,$NAME(DELFLE))
- +26 SET FILENME=XTVPSPRM
- +27 DO CRTFLE(DEFDIR,FILENME,WNFILE)
- End DoDot:2
- +28 ;
- +29 ; If file name definitions and copies were completed successfully, create the Parameter file
- +30 IF DELRSLT
- Begin DoDot:2
- +31 ;Write New File
- IF WNFILE
- Begin DoDot:3
- +32 SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI(XTVPSPRM)
- +33 IF ($PIECE(UNLKRSLT,"^")'=1)
- WRITE !!," <* UNLOCK ERROR. Check LOCK file Integrity. *>"
- +34 DO JUSTPAWS^XTVSLAPI($PIECE(UNLKRSLT,"^",2))
- +35 IF ($PIECE(UNLKRSLT,"^")=1)
- DO CRTFLE(DEFDIR,FILENME,WNFILE)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +36 ;
- +37 QUIT
- +38 ;
- CRTFLE(DEFDIR,FILENME,WNFILE) ; Update old file/Write New file
- +1 NEW POPERR,CHKLKER
- +2 SET POPERR=0
- +3 DO OPEN^%ZISH("XTMP",DEFDIR,FILENME,"A")
- +4 if POP
- SET POPERR=POP
- +5 IF 'POPERR
- Begin DoDot:1
- +6 USE IO
- +7 SET PKGNME=""
- +8 FOR
- SET PKGNME=$ORDER(^TMP("XTVS-PARAM-CAP",$JOB,PKGNME))
- if PKGNME']""
- QUIT
- WRITE !,^TMP("XTVS-PARAM-CAP",$JOB,PKGNME)
- +9 DO CLOSE^%ZISH("XTMP")
- +10 SET XTVPSPRM=FILENME
- +11 SET CHNGMADE=0
- +12 KILL ^TMP("XTVS-PARAM-BI",$JOB)
- +13 IF WNFILE
- Begin DoDot:2
- +14 SET CHKLKER=$$REQLOCK^XTVSLAPI(XTVPSPRM)
- +15 DO JUSTPAWS^XTVSLAPI($PIECE(CHKLKER,"^",2))
- End DoDot:2
- End DoDot:1
- +16 QUIT
- +17 ;
- SETADD(X) ; Add a new package to ^TMP("XTVS-PARAM-CAP")
- +1 ;Create new entry in TMP global
- SET ^TMP("XTVS-PARAM-CAP",$JOB,X)=X
- +2 SET ^TMP("XTVS-PARAM-CAP",$JOB,X,1,"Package Name")=X
- +3 SET ^TMP("XTVS-PARAM-CAP",$JOB,X,2,"Primary Prefix")=""
- +4 SET ^TMP("XTVS-PARAM-CAP",$JOB,X,3,"*Lowest File#")=""
- +5 SET ^TMP("XTVS-PARAM-CAP",$JOB,X,4,"*Highest File#")=""
- +6 SET ^TMP("XTVS-PARAM-CAP",$JOB,X,5,"Additional Prefixes")=""
- +7 SET ^TMP("XTVS-PARAM-CAP",$JOB,X,6,"Excepted Prefixes")=""
- +8 SET ^TMP("XTVS-PARAM-CAP",$JOB,X,7,"File Numbers")=""
- +9 SET ^TMP("XTVS-PARAM-CAP",$JOB,X,8,"File Ranges")=""
- +10 SET ^TMP("XTVS-PARAM-CAP",$JOB,X,9,"Parent Package")=""
- +11 QUIT
- +12 ;
- SETSELAY(SELARY) ; Move Package names to SELARY from ^TMP("XTVS-PARAM-CAP") array
- +1 NEW ITEMNUM,FILENME
- +2 SET FILENME=""
- +3 SET ITEMNUM=0
- +4 FOR
- SET FILENME=$ORDER(^TMP("XTVS-PARAM-CAP",$JOB,FILENME))
- if FILENME=""
- QUIT
- Begin DoDot:1
- +5 ;Parameter list
- SET ITEMNUM=ITEMNUM+1
- SET SELARY(ITEMNUM)=FILENME
- End DoDot:1
- +6 QUIT ITEMNUM
- +7 ;
- SPCPKGCK(XTVSSAVX,ITEMNUM,SELARY) ; Check for existence of the <SPACE> select package in SELARY
- +1 NEW SELARYCT
- +2 FOR SELARYCT=1:1:ITEMNUM
- if (SELARY(SELARYCT)=XTVSSAVX)
- QUIT
- +3 IF (+SELARYCT+1)>(+ITEMNUM)
- WRITE !!,"?? ",XTVSSAVX_" VistA package is undefined."
- +4 QUIT