XTVSCP ;Albany FO/GTS - VistA Package Sizing Manager; 12-JUL-2016
;;7.3;TOOLKIT;**143**;Apr 25, 1995;Build 116
;
EN(XPID) ; -- main entry point for XTVS PKG EXT CRT PARAM
;INPUT: XPID - $JOB value of ^XTMP("XTSIZE") array
;
D EN^VALM("XTVS PKG EXT CRT PARAM")
Q
;
HDR ; -- header code
NEW XSYSTEM,XDATE,DIRHEAD,SPCPAD
;
SET XDATE=$P($P(^XTMP("XTSIZE",XPID,0),"^",3),"-")
SET XSYSTEM=$P(^XTMP("XTSIZE",XPID,0),"^",4)
SET XDATE=$$FMTE^XLFDT(XDATE,"1P")
SET:XDATE']"" XDATE="undefined"
SET:XSYSTEM']"" XSYSTEM="undefined"
;
SET VALMHDR(1)=" VistA Package Size Analysis Manager - Package Parameters"
SET VALMHDR(2)=" Version: "_$$VERNUM^XTVSLM()_" Build: "_$$BLDNUM^XTVSLM()
SET DIRHEAD="System: "_XSYSTEM_" Extract PID:"_XPID_" Date: "_XDATE
SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
SET VALMHDR(3)=SPCPAD_DIRHEAD
Q
;
INIT ; -- init variables and list array
NEW PARMROOT
SET VALMCNT=0
SET PARMROOT="^TMP(""XTSIZE"","_$J_")" ;Result Param File array
FOR SET PARMROOT=$QUERY(@PARMROOT) QUIT:PARMROOT="" Q:$QSUBSCRIPT(PARMROOT,2)="IDX" Q:$QSUBSCRIPT(PARMROOT,1)'="XTSIZE" DO
. DO SPLITADD^XTVSLAPI(.VALMCNT,@PARMROOT,1)
DO MSG
Q
;
HELP ; -- help code
IF $D(X),X'["??" DO
. SET X="?"
. DO DISP^XQORM1 W !
IF $D(X),X["??",X'["???" DO
. DO CLEAR^VALM1
. DO FULL^VALM1
. WRITE !,"Package Parameters & Parameter Corrections 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(CPTXT2+TXTCT^XTVSHELP),";",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 !
IF $D(X),X["???" DO
. DO CLEAR^VALM1
. DO FULL^VALM1
. WRITE !,"Details about displayed data...",!
. SET XTQVAR=Y
. IF XTQVAR DO
.. SET XTQVAR=0
.. FOR TXTCT=1:1 SET XTX=$P($T(CPTXT3+TXTCT^XTVSHELP),";",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 !
D MSG
S VALMBCK="R"
K XTX,Y,TXTCT,XTQVAR
QUIT
;
EXIT ; -- exit code
Q
;
MSG(TEXT) ; -- set default message
IF $G(TEXT)]"" SET VALMSG=TEXT
IF $G(TEXT)']"" SET VALMSG="Enter ?? : more actions & Help, ??? : Process Help"
QUIT
;
KILL ; -- Cleanup local and global arrays
DO CLEAN^VALM10 ;Kill data and video control arrays
DO KILL^VALM10() ;Kill Video attributes
KILL ^TMP("XTVS PKG MAN NEW PARAM",$JOB)
KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
QUIT
;
;Action PROTOCOL entry points
REDISPRM ; -- Redisplay Paramters file
; -- Protocol: XTVS PKG EXT REDISP PARAM ACTION
;
SET VALMHDR(1)=" VistA Package Size Analysis Manager - Package Parameters"
SET VALMBG=1
DO KILL
DO INIT
SET VALMBCK="R"
QUIT
;
REDISCRT ; -- Redisplay Parameter file corrections list
; -- Protocol: XTVS PKG EXT DISP CORRECTIONS ACTION
;
SET VALMHDR(1)=" VistA Package Size Analysis Manager - Package Parameter Corrections"
SET VALMBG=1
DO KILL
SET VALMCNT=0
SET PARMROOT="^TMP(""XTVS-FILERPT"","_$J_")"
FOR SET PARMROOT=$QUERY(@PARMROOT) QUIT:PARMROOT="" Q:$QSUBSCRIPT(PARMROOT,1)'="XTVS-FILERPT" DO
. IF @PARMROOT["file number notes" DO ADD^XTVSLAPI(.VALMCNT," ")
. DO ADD^XTVSLAPI(.VALMCNT,@PARMROOT)
DO MSG
SET VALMBCK="R"
QUIT
;
WRPARMFL ; Write Parameter File to VistA Package Size Default Directory
; -- Protocol: XTVS PKG EXT PARAM WRT ACTION
;
NEW POPERR,PKGROOT,SUB3,SUB4,EXTDIR,FILENME,NOWDT,INITIAL
SET POPERR=0
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>"
;
D FULL^VALM1
;
SET EXTDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
SET FILENME="XTMPSIZE"_"_"_INITIAL_NOWDT_".DAT"
DO JUSTPAWS^XTVSLAPI("Parameter file: "_FILENME_", will be created.")
DO OPEN^%ZISH("XTMP",EXTDIR,FILENME,"A")
SET:POP POPERR=POP
QUIT:POPERR
U IO
SET PKGROOT="^TMP(""XTSIZE"","_$J_")"
SET INSCTRT="^TMP(""XTSIZE"","_$J_")"
FOR SET PKGROOT=$QUERY(@PKGROOT) QUIT:PKGROOT']"" Q:$QSUBSCRIPT(PKGROOT,1)'="XTSIZE" Q:$QSUBSCRIPT(PKGROOT,2)'=$J DO
. SET SUB3=$QSUBSCRIPT(PKGROOT,3)
. SET SUB4=$QSUBSCRIPT(PKGROOT,4)
. IF $G(SUB4)'="",$G(SUB3)'="",$G(@INSCTRT@(SUB4,SUB3))'="" W !,@INSCTRT@(SUB4,SUB3)_"^*"
. WRITE !,@PKGROOT
D CLOSE^%ZISH("XTMP")
DO MSG
SET VALMBCK="R"
QUIT
;
SNDNPFLE ;Send New Paramater file & report
; -- Protocol: XTVS PKG MGR NEW PARAM MAIL ACTION
;
NEW XTINSTMM,XTINSTVA,XTTASKMM,XTTASKVA,XTTOMM,XTTOVA,XMERR,XMZ,XTLPCNT,XTTYPE,XTSVSUBJ,XQSND
;
;XTSVSUBJ - Subject of message generated
;XQSND - User's DUZ, Group Name, or S.server name
SET XQSND=DUZ
SET XTSVSUBJ="VistA Package Parameter File"
;
DO FULL^VALM1
WRITE !!," The message can take some time to be sent.",!
;
S XTINSTMM("ADDR FLAGS")="R" ;Do not Restrict addressing
S XTTYPE="S"
K XMERR
D TOWHOM^XMXAPIU(DUZ,,XTTYPE,.XTINSTMM)
;
;Check Network addresses and mail attachmt
S XTINSTVA("ADDR FLAGS")="R" ;Do not Restrict addressing
S XTINSTVA("FROM")="VISTA_PACKAGE_MANAGER_RPT"
S XTSVSUBJ=$E(XTSVSUBJ,1,65)
S XTLPCNT=""
F S XTLPCNT=$O(^TMP("XMY",$J,XTLPCNT)) Q:XTLPCNT="" S XTTOVA(XTLPCNT)=""
;
I +$G(XMERR)'>0 DO
.WRITE !!,"NOTE: Attachments sent to VA MailMan addresses will be unreadable."
.WRITE !," Send the parameters in the message if sending to a VA Mailman address.",!
.N XTFORMAT
.SET XTFORMAT=$$MSGORATC^XTVSLAPI("the VistA Pkg Parameter File")
.; Report in message
.IF XTFORMAT="M" DO
.. S XTSVSUBJ=XTSVSUBJ_" & Error Rpt"
.. D ALLMSG("^TMP(""XTSIZE"","_$J_")","^TMP(""XTVS-FILERPT"","_$J_")","^TMP($J,""XTNETMSG"")")
.. D SENDMSG^XMXAPI(XQSND,XTSVSUBJ,"^TMP($J,""XTNETMSG"")",.XTTOVA,.XTINSTVA,.XTTASKVA)
.. D JUSTPAWS^XTVSLAPI("MSG#: "_XTTASKVA_" created!")
.; Report in attachment
.IF XTFORMAT="A" DO
..W !," [Creating attachments..."
..D OUTLKARY("^TMP(""XTSIZE"","_$J_")","^TMP($J,""XTNETMSG"")",XTSVSUBJ,1)
..D SENDMSG^XMXAPI(XQSND,XTSVSUBJ,"^TMP($J,""XTNETMSG"")",.XTTOVA,.XTINSTVA,.XTTASKVA)
..D JUSTPAWS^XTVSLAPI("MSG#: "_XTTASKVA_" created!")
;
K ^TMP("XMY",$J),^TMP("XMY0",$J),^TMP($J,"XTNETMSG")
;
DO MSG
SET VALMBCK="R"
QUIT
;
ALLMSG(XTPMARY,ERROOT,XTOTMSG) ;Create msg array with no attachment
;INPUT:
; XTPMARY - Array containing Package Parameter File text
; ERROOT - Array containing Error Report
; XTOTMSG - Array to use for E-mail Text
;
;OUTPUT:
; XTOTMSG - Array of message text to send via E-Mail
;
NEW XTERRND,XTCHAR,OTLKNDE
SET:+$G(XTRT)=0 XTRT=0
SET:+$G(XTRT) XTCHAR=0
SET XTSTR=""
KILL @XTOTMSG
SET @XTOTMSG@(1)=" "
SET OTLKNDE=1
;
IF ($O(@ERROOT@(0))'="") DO
. SET @XTOTMSG@(2)="Report of Package File Number Corrections made when creating parameter file."
. SET @XTOTMSG@(3)=" "
. SET @XTOTMSG@(4)="NOTE: Undefined File Number Ranges and *High/*Low File Numbers are reported."
. SET @XTOTMSG@(5)="File Number multiple entries not included in File Number Ranges multiple are"
. SET @XTOTMSG@(6)="added to the Package file parameter ranges and indicated in this report."
. SET @XTOTMSG@(7)="*High/*Low File Numbers are NOT added to File Number Parameter range. If only"
. SET @XTOTMSG@(8)="*High/*Low numbers are defined for a Package's files then that is reported."
. SET @XTOTMSG@(9)=" "
. SET OTLKNDE=9
. SET XTERRND=ERROOT
. FOR SET XTERRND=$QUERY(@XTERRND) QUIT:XTERRND="" Q:$QSUBSCRIPT(XTERRND,1)'="XTVS-FILERPT" Q:$QSUBSCRIPT(XTERRND,2)'=$J DO
.. SET OTLKNDE=OTLKNDE+1
.. IF @XTERRND["file number notes" SET @XTOTMSG@(OTLKNDE)=" " SET OTLKNDE=OTLKNDE+1
.. SET @XTOTMSG@(OTLKNDE)=@XTERRND
;
IF ($O(@ERROOT@(0))="") SET @XTOTMSG@(2)="No File corrections made in the parameter file!"
SET OTLKNDE=OTLKNDE+1
;
SET @XTOTMSG@(OTLKNDE)=""
SET OTLKNDE=OTLKNDE+1
SET @XTOTMSG@(OTLKNDE)=""
SET OTLKNDE=OTLKNDE+1
SET @XTOTMSG@(OTLKNDE)="----------------------------------------------------------------------"
SET OTLKNDE=OTLKNDE+1
SET @XTOTMSG@(OTLKNDE)=""
SET OTLKNDE=OTLKNDE+1
SET @XTOTMSG@(OTLKNDE)="VistA Package Parameters:"
SET OTLKNDE=OTLKNDE+1
SET @XTOTMSG@(OTLKNDE)="-------------------------"
SET OTLKNDE=OTLKNDE+1
SET @XTOTMSG@(OTLKNDE)=""
SET OTLKNDE=OTLKNDE+1
;
; No parameter file
IF ($O(@XTPMARY@(0))="") DO
. SET @XTOTMSG@(OTLKNDE)=""
. SET OTLKNDE=OTLKNDE+1
. SET @XTOTMSG@(OTLKNDE)="No Parameter List to report!"
. SET OTLKNDE=OTLKNDE+1
;
; Parameter file exists - write parameter file to message
IF ($O(@XTPMARY@(0))'="") DO
.FOR SET XTPMARY=$QUERY(@XTPMARY) QUIT:(XTPMARY="") Q:($QSUBSCRIPT(XTPMARY,1)'="XTSIZE") Q:($QSUBSCRIPT(XTPMARY,2)'=$J) DO
.. DO:XTPMARY#100=0 HANGCHAR^XTVSLAPI(.XTCHAR) ; Display progress character
.. SET @XTOTMSG@(OTLKNDE)=@XTPMARY SET OTLKNDE=OTLKNDE+1
;
QUIT
;
OUTLKARY(XTPMARY,XTOTLK,XTSVSUBJ,XTRT) ;Create attachmts array
;INPUT:
; XTPMARY - Array containing Package Parameter File text
; XTOTLK - Array containing message text for network addresses
; XTSVSUBJ - Message subject
; XTRT - Real Time processing from UI
;
N XTFILNAM,XTDTTM,XTCRLF,XTSTR,XTNODE,XTOUTNOD,XTNODATA,XTCHAR,NOWDT,INITIAL,OTLKNDE,ERROOT
S:+$G(XTRT)=0 XTRT=0
S:+$G(XTRT) XTCHAR=0
S XTSTR=""
S XTNODATA=0
S XTCRLF=$C(13,10)
S XTDTTM=$$NOW^XLFDT
K @XTOTLK
S @XTOTLK@(1)="Attachment Generated......: "_$$FMTE^XLFDT(XTDTTM)_XTCRLF
S @XTOTLK@(2)=" "
S @XTOTLK@(3)="Extract Requested......: "_XTSVSUBJ_XTCRLF
S @XTOTLK@(4)=" "
;
SET NOWDT=$$FMTE^XLFDT(XTDTTM,"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 XTFILNAM="XTMPSIZE"_"_"_INITIAL_NOWDT_".DAT"
;
S @XTOTLK@(5)="Attached Package Parameter file.....: "_XTFILNAM_XTCRLF
S:($O(@XTPMARY@(0))="") XTNODATA=1
S @XTOTLK@(6)=" "
S:(XTNODATA=0) @XTOTLK@(7)=" "
S:(XTNODATA=1) @XTOTLK@(7)="No Parameter List to file and attach!"
SET OTLKNDE=7
;
SET ERROOT="^TMP(""XTVS-FILERPT"","_$J_")"
IF ($O(@ERROOT@(0))'="") DO
. SET @XTOTLK@(9)="Report of Package File Number Corrections made when creating "_XTFILNAM_"."
. SET @XTOTLK@(10)=" "
. SET @XTOTLK@(11)="NOTE: Undefined File Number Ranges and *High/*Low File Numbers are reported."
. SET @XTOTLK@(12)="File Number multiple entries not included in File Number Ranges multiple are"
. SET @XTOTLK@(13)="added to the Package file parameter ranges and indicated in this report."
. SET @XTOTLK@(14)="*High/*Low File Numbers are NOT added to File Number Parameter range. If only"
. SET @XTOTLK@(15)="*High/*Low numbers are defined for a Package's files then that is reported."
. SET @XTOTLK@(16)=" "
. SET OTLKNDE=16
SET:($O(@ERROOT@(0))="") @XTOTLK@(8)="No File corrections made in "_XTFILNAM_"!"
FOR SET ERROOT=$QUERY(@ERROOT) QUIT:ERROOT="" Q:$QSUBSCRIPT(ERROOT,1)'="XTVS-FILERPT" Q:$QSUBSCRIPT(ERROOT,2)'=$J DO
. SET OTLKNDE=OTLKNDE+1
. IF @ERROOT["file number notes" SET @XTOTLK@(OTLKNDE)=" " SET OTLKNDE=OTLKNDE+1
. SET @XTOTLK@(OTLKNDE)=@ERROOT
;
;Begin file output
SET OTLKNDE=OTLKNDE+1
S @XTOTLK@(OTLKNDE)=$$UUBEGFN^XTVSLAPI(XTFILNAM)
S XTNODE=XTPMARY
S XTOUTNOD=OTLKNDE
;;
FOR SET XTNODE=$QUERY(@XTNODE) QUIT:(XTNODE="") Q:($QSUBSCRIPT(XTNODE,1)'="XTSIZE") Q:($QSUBSCRIPT(XTNODE,2)'=$J) DO
. I +$G(XTRT) D:XTNODE#100=0 HANGCHAR^XTVSLAPI(.XTCHAR) ; Display progress character
. S XTSTR=XTSTR_@XTNODE_XTCRLF
. D ENCODE^XTVSLAPI(.XTSTR,.XTOUTNOD,XTOTLK)
;
F Q:$L(XTSTR<45) D ENCODE^XTVSLAPI(.XTSTR,.XTOUTNOD,XTOTLK)
S:(XTSTR'="") @XTOTLK@(XTOUTNOD+1)=$$UUEN^XTVSLAPI(XTSTR)
S @XTOTLK@(XTOUTNOD+2)=" "
S @XTOTLK@(XTOUTNOD+3)="end"
;
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTVSCP 12088 printed Oct 16, 2024@18:42:40 Page 2
XTVSCP ;Albany FO/GTS - VistA Package Sizing Manager; 12-JUL-2016
+1 ;;7.3;TOOLKIT;**143**;Apr 25, 1995;Build 116
+2 ;
EN(XPID) ; -- main entry point for XTVS PKG EXT CRT PARAM
+1 ;INPUT: XPID - $JOB value of ^XTMP("XTSIZE") array
+2 ;
+3 DO EN^VALM("XTVS PKG EXT CRT PARAM")
+4 QUIT
+5 ;
HDR ; -- header code
+1 NEW XSYSTEM,XDATE,DIRHEAD,SPCPAD
+2 ;
+3 SET XDATE=$PIECE($PIECE(^XTMP("XTSIZE",XPID,0),"^",3),"-")
+4 SET XSYSTEM=$PIECE(^XTMP("XTSIZE",XPID,0),"^",4)
+5 SET XDATE=$$FMTE^XLFDT(XDATE,"1P")
+6 if XDATE']""
SET XDATE="undefined"
+7 if XSYSTEM']""
SET XSYSTEM="undefined"
+8 ;
+9 SET VALMHDR(1)=" VistA Package Size Analysis Manager - Package Parameters"
+10 SET VALMHDR(2)=" Version: "_$$VERNUM^XTVSLM()_" Build: "_$$BLDNUM^XTVSLM()
+11 SET DIRHEAD="System: "_XSYSTEM_" Extract PID:"_XPID_" Date: "_XDATE
+12 SET $PIECE(SPCPAD," ",(80-$LENGTH(DIRHEAD))/2)=""
+13 SET VALMHDR(3)=SPCPAD_DIRHEAD
+14 QUIT
+15 ;
INIT ; -- init variables and list array
+1 NEW PARMROOT
+2 SET VALMCNT=0
+3 ;Result Param File array
SET PARMROOT="^TMP(""XTSIZE"","_$JOB_")"
+4 FOR
SET PARMROOT=$QUERY(@PARMROOT)
if PARMROOT=""
QUIT
if $QSUBSCRIPT(PARMROOT,2)="IDX"
QUIT
if $QSUBSCRIPT(PARMROOT,1)'="XTSIZE"
QUIT
Begin DoDot:1
+5 DO SPLITADD^XTVSLAPI(.VALMCNT,@PARMROOT,1)
End DoDot:1
+6 DO MSG
+7 QUIT
+8 ;
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["??"
IF X'["???"
Begin DoDot:1
+5 DO CLEAR^VALM1
+6 DO FULL^VALM1
+7 WRITE !,"Package Parameters & Parameter Corrections 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(CPTXT2+TXTCT^XTVSHELP),";",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 IF $DATA(X)
IF X["???"
Begin DoDot:1
+18 DO CLEAR^VALM1
+19 DO FULL^VALM1
+20 WRITE !,"Details about displayed data...",!
+21 SET XTQVAR=Y
+22 IF XTQVAR
Begin DoDot:2
+23 SET XTQVAR=0
+24 FOR TXTCT=1:1
SET XTX=$PIECE($TEXT(CPTXT3+TXTCT^XTVSHELP),";",3,99)
if XTX="$END"
QUIT
if XTQVAR
QUIT
Begin DoDot:3
+25 IF XTX="$PAUSE"
DO PAUSE^VALM1
if Y
DO CLEAR^VALM1
IF 'Y
SET XTQVAR=1
QUIT
+26 WRITE !,$SELECT(XTX["$PAUSE":"",1:XTX)
End DoDot:3
End DoDot:2
+27 WRITE !
End DoDot:1
+28 DO MSG
+29 SET VALMBCK="R"
+30 KILL XTX,Y,TXTCT,XTQVAR
+31 QUIT
+32 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
MSG(TEXT) ; -- set default message
+1 IF $GET(TEXT)]""
SET VALMSG=TEXT
+2 IF $GET(TEXT)']""
SET VALMSG="Enter ?? : more actions & Help, ??? : Process Help"
+3 QUIT
+4 ;
KILL ; -- Cleanup local and global arrays
+1 ;Kill data and video control arrays
DO CLEAN^VALM10
+2 ;Kill Video attributes
DO KILL^VALM10()
+3 KILL ^TMP("XTVS PKG MAN NEW PARAM",$JOB)
+4 KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
+5 QUIT
+6 ;
+7 ;Action PROTOCOL entry points
REDISPRM ; -- Redisplay Paramters file
+1 ; -- Protocol: XTVS PKG EXT REDISP PARAM ACTION
+2 ;
+3 SET VALMHDR(1)=" VistA Package Size Analysis Manager - Package Parameters"
+4 SET VALMBG=1
+5 DO KILL
+6 DO INIT
+7 SET VALMBCK="R"
+8 QUIT
+9 ;
REDISCRT ; -- Redisplay Parameter file corrections list
+1 ; -- Protocol: XTVS PKG EXT DISP CORRECTIONS ACTION
+2 ;
+3 SET VALMHDR(1)=" VistA Package Size Analysis Manager - Package Parameter Corrections"
+4 SET VALMBG=1
+5 DO KILL
+6 SET VALMCNT=0
+7 SET PARMROOT="^TMP(""XTVS-FILERPT"","_$JOB_")"
+8 FOR
SET PARMROOT=$QUERY(@PARMROOT)
if PARMROOT=""
QUIT
if $QSUBSCRIPT(PARMROOT,1)'="XTVS-FILERPT"
QUIT
Begin DoDot:1
+9 IF @PARMROOT["file number notes"
DO ADD^XTVSLAPI(.VALMCNT," ")
+10 DO ADD^XTVSLAPI(.VALMCNT,@PARMROOT)
End DoDot:1
+11 DO MSG
+12 SET VALMBCK="R"
+13 QUIT
+14 ;
WRPARMFL ; Write Parameter File to VistA Package Size Default Directory
+1 ; -- Protocol: XTVS PKG EXT PARAM WRT ACTION
+2 ;
+3 NEW POPERR,PKGROOT,SUB3,SUB4,EXTDIR,FILENME,NOWDT,INITIAL
+4 SET POPERR=0
+5 SET NOWDT=$$FMTE^XLFDT($$NOW^XLFDT,"2M")
+6 SET NOWDT=$TRANSLATE(NOWDT,"/","-")
+7 SET NOWDT=$TRANSLATE(NOWDT,"@","_")
+8 SET NOWDT=$TRANSLATE(NOWDT,":","")
+9 SET INITIAL=$PIECE($GET(^VA(200,DUZ,0)),"^",2)
+10 IF INITIAL']""
SET INITIAL="<unk>"
+11 ;
+12 DO FULL^VALM1
+13 ;
+14 SET EXTDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+15 SET FILENME="XTMPSIZE"_"_"_INITIAL_NOWDT_".DAT"
+16 DO JUSTPAWS^XTVSLAPI("Parameter file: "_FILENME_", will be created.")
+17 DO OPEN^%ZISH("XTMP",EXTDIR,FILENME,"A")
+18 if POP
SET POPERR=POP
+19 if POPERR
QUIT
+20 USE IO
+21 SET PKGROOT="^TMP(""XTSIZE"","_$JOB_")"
+22 SET INSCTRT="^TMP(""XTSIZE"","_$JOB_")"
+23 FOR
SET PKGROOT=$QUERY(@PKGROOT)
if PKGROOT']""
QUIT
if $QSUBSCRIPT(PKGROOT,1)'="XTSIZE"
QUIT
if $QSUBSCRIPT(PKGROOT,2)'=$JOB
QUIT
Begin DoDot:1
+24 SET SUB3=$QSUBSCRIPT(PKGROOT,3)
+25 SET SUB4=$QSUBSCRIPT(PKGROOT,4)
+26 IF $GET(SUB4)'=""
IF $GET(SUB3)'=""
IF $GET(@INSCTRT@(SUB4,SUB3))'=""
WRITE !,@INSCTRT@(SUB4,SUB3)_"^*"
+27 WRITE !,@PKGROOT
End DoDot:1
+28 DO CLOSE^%ZISH("XTMP")
+29 DO MSG
+30 SET VALMBCK="R"
+31 QUIT
+32 ;
SNDNPFLE ;Send New Paramater file & report
+1 ; -- Protocol: XTVS PKG MGR NEW PARAM MAIL ACTION
+2 ;
+3 NEW XTINSTMM,XTINSTVA,XTTASKMM,XTTASKVA,XTTOMM,XTTOVA,XMERR,XMZ,XTLPCNT,XTTYPE,XTSVSUBJ,XQSND
+4 ;
+5 ;XTSVSUBJ - Subject of message generated
+6 ;XQSND - User's DUZ, Group Name, or S.server name
+7 SET XQSND=DUZ
+8 SET XTSVSUBJ="VistA Package Parameter File"
+9 ;
+10 DO FULL^VALM1
+11 WRITE !!," The message can take some time to be sent.",!
+12 ;
+13 ;Do not Restrict addressing
SET XTINSTMM("ADDR FLAGS")="R"
+14 SET XTTYPE="S"
+15 KILL XMERR
+16 DO TOWHOM^XMXAPIU(DUZ,,XTTYPE,.XTINSTMM)
+17 ;
+18 ;Check Network addresses and mail attachmt
+19 ;Do not Restrict addressing
SET XTINSTVA("ADDR FLAGS")="R"
+20 SET XTINSTVA("FROM")="VISTA_PACKAGE_MANAGER_RPT"
+21 SET XTSVSUBJ=$EXTRACT(XTSVSUBJ,1,65)
+22 SET XTLPCNT=""
+23 FOR
SET XTLPCNT=$ORDER(^TMP("XMY",$JOB,XTLPCNT))
if XTLPCNT=""
QUIT
SET XTTOVA(XTLPCNT)=""
+24 ;
+25 IF +$GET(XMERR)'>0
Begin DoDot:1
+26 WRITE !!,"NOTE: Attachments sent to VA MailMan addresses will be unreadable."
+27 WRITE !," Send the parameters in the message if sending to a VA Mailman address.",!
+28 NEW XTFORMAT
+29 SET XTFORMAT=$$MSGORATC^XTVSLAPI("the VistA Pkg Parameter File")
+30 ; Report in message
+31 IF XTFORMAT="M"
Begin DoDot:2
+32 SET XTSVSUBJ=XTSVSUBJ_" & Error Rpt"
+33 DO ALLMSG("^TMP(""XTSIZE"","_$JOB_")","^TMP(""XTVS-FILERPT"","_$JOB_")","^TMP($J,""XTNETMSG"")")
+34 DO SENDMSG^XMXAPI(XQSND,XTSVSUBJ,"^TMP($J,""XTNETMSG"")",.XTTOVA,.XTINSTVA,.XTTASKVA)
+35 DO JUSTPAWS^XTVSLAPI("MSG#: "_XTTASKVA_" created!")
End DoDot:2
+36 ; Report in attachment
+37 IF XTFORMAT="A"
Begin DoDot:2
+38 WRITE !," [Creating attachments..."
+39 DO OUTLKARY("^TMP(""XTSIZE"","_$JOB_")","^TMP($J,""XTNETMSG"")",XTSVSUBJ,1)
+40 DO SENDMSG^XMXAPI(XQSND,XTSVSUBJ,"^TMP($J,""XTNETMSG"")",.XTTOVA,.XTINSTVA,.XTTASKVA)
+41 DO JUSTPAWS^XTVSLAPI("MSG#: "_XTTASKVA_" created!")
End DoDot:2
End DoDot:1
+42 ;
+43 KILL ^TMP("XMY",$JOB),^TMP("XMY0",$JOB),^TMP($JOB,"XTNETMSG")
+44 ;
+45 DO MSG
+46 SET VALMBCK="R"
+47 QUIT
+48 ;
ALLMSG(XTPMARY,ERROOT,XTOTMSG) ;Create msg array with no attachment
+1 ;INPUT:
+2 ; XTPMARY - Array containing Package Parameter File text
+3 ; ERROOT - Array containing Error Report
+4 ; XTOTMSG - Array to use for E-mail Text
+5 ;
+6 ;OUTPUT:
+7 ; XTOTMSG - Array of message text to send via E-Mail
+8 ;
+9 NEW XTERRND,XTCHAR,OTLKNDE
+10 if +$GET(XTRT)=0
SET XTRT=0
+11 if +$GET(XTRT)
SET XTCHAR=0
+12 SET XTSTR=""
+13 KILL @XTOTMSG
+14 SET @XTOTMSG@(1)=" "
+15 SET OTLKNDE=1
+16 ;
+17 IF ($ORDER(@ERROOT@(0))'="")
Begin DoDot:1
+18 SET @XTOTMSG@(2)="Report of Package File Number Corrections made when creating parameter file."
+19 SET @XTOTMSG@(3)=" "
+20 SET @XTOTMSG@(4)="NOTE: Undefined File Number Ranges and *High/*Low File Numbers are reported."
+21 SET @XTOTMSG@(5)="File Number multiple entries not included in File Number Ranges multiple are"
+22 SET @XTOTMSG@(6)="added to the Package file parameter ranges and indicated in this report."
+23 SET @XTOTMSG@(7)="*High/*Low File Numbers are NOT added to File Number Parameter range. If only"
+24 SET @XTOTMSG@(8)="*High/*Low numbers are defined for a Package's files then that is reported."
+25 SET @XTOTMSG@(9)=" "
+26 SET OTLKNDE=9
+27 SET XTERRND=ERROOT
+28 FOR
SET XTERRND=$QUERY(@XTERRND)
if XTERRND=""
QUIT
if $QSUBSCRIPT(XTERRND,1)'="XTVS-FILERPT"
QUIT
if $QSUBSCRIPT(XTERRND,2)'=$JOB
QUIT
Begin DoDot:2
+29 SET OTLKNDE=OTLKNDE+1
+30 IF @XTERRND["file number notes"
SET @XTOTMSG@(OTLKNDE)=" "
SET OTLKNDE=OTLKNDE+1
+31 SET @XTOTMSG@(OTLKNDE)=@XTERRND
End DoDot:2
End DoDot:1
+32 ;
+33 IF ($ORDER(@ERROOT@(0))="")
SET @XTOTMSG@(2)="No File corrections made in the parameter file!"
+34 SET OTLKNDE=OTLKNDE+1
+35 ;
+36 SET @XTOTMSG@(OTLKNDE)=""
+37 SET OTLKNDE=OTLKNDE+1
+38 SET @XTOTMSG@(OTLKNDE)=""
+39 SET OTLKNDE=OTLKNDE+1
+40 SET @XTOTMSG@(OTLKNDE)="----------------------------------------------------------------------"
+41 SET OTLKNDE=OTLKNDE+1
+42 SET @XTOTMSG@(OTLKNDE)=""
+43 SET OTLKNDE=OTLKNDE+1
+44 SET @XTOTMSG@(OTLKNDE)="VistA Package Parameters:"
+45 SET OTLKNDE=OTLKNDE+1
+46 SET @XTOTMSG@(OTLKNDE)="-------------------------"
+47 SET OTLKNDE=OTLKNDE+1
+48 SET @XTOTMSG@(OTLKNDE)=""
+49 SET OTLKNDE=OTLKNDE+1
+50 ;
+51 ; No parameter file
+52 IF ($ORDER(@XTPMARY@(0))="")
Begin DoDot:1
+53 SET @XTOTMSG@(OTLKNDE)=""
+54 SET OTLKNDE=OTLKNDE+1
+55 SET @XTOTMSG@(OTLKNDE)="No Parameter List to report!"
+56 SET OTLKNDE=OTLKNDE+1
End DoDot:1
+57 ;
+58 ; Parameter file exists - write parameter file to message
+59 IF ($ORDER(@XTPMARY@(0))'="")
Begin DoDot:1
+60 FOR
SET XTPMARY=$QUERY(@XTPMARY)
if (XTPMARY="")
QUIT
if ($QSUBSCRIPT(XTPMARY,1)'="XTSIZE")
QUIT
if ($QSUBSCRIPT(XTPMARY,2)'=$JOB)
QUIT
Begin DoDot:2
+61 ; Display progress character
if XTPMARY#100=0
DO HANGCHAR^XTVSLAPI(.XTCHAR)
+62 SET @XTOTMSG@(OTLKNDE)=@XTPMARY
SET OTLKNDE=OTLKNDE+1
End DoDot:2
End DoDot:1
+63 ;
+64 QUIT
+65 ;
OUTLKARY(XTPMARY,XTOTLK,XTSVSUBJ,XTRT) ;Create attachmts array
+1 ;INPUT:
+2 ; XTPMARY - Array containing Package Parameter File text
+3 ; XTOTLK - Array containing message text for network addresses
+4 ; XTSVSUBJ - Message subject
+5 ; XTRT - Real Time processing from UI
+6 ;
+7 NEW XTFILNAM,XTDTTM,XTCRLF,XTSTR,XTNODE,XTOUTNOD,XTNODATA,XTCHAR,NOWDT,INITIAL,OTLKNDE,ERROOT
+8 if +$GET(XTRT)=0
SET XTRT=0
+9 if +$GET(XTRT)
SET XTCHAR=0
+10 SET XTSTR=""
+11 SET XTNODATA=0
+12 SET XTCRLF=$CHAR(13,10)
+13 SET XTDTTM=$$NOW^XLFDT
+14 KILL @XTOTLK
+15 SET @XTOTLK@(1)="Attachment Generated......: "_$$FMTE^XLFDT(XTDTTM)_XTCRLF
+16 SET @XTOTLK@(2)=" "
+17 SET @XTOTLK@(3)="Extract Requested......: "_XTSVSUBJ_XTCRLF
+18 SET @XTOTLK@(4)=" "
+19 ;
+20 SET NOWDT=$$FMTE^XLFDT(XTDTTM,"2M")
+21 SET NOWDT=$TRANSLATE(NOWDT,"/","-")
+22 SET NOWDT=$TRANSLATE(NOWDT,"@","_")
+23 SET NOWDT=$TRANSLATE(NOWDT,":","")
+24 SET INITIAL=$PIECE($GET(^VA(200,DUZ,0)),"^",2)
+25 IF INITIAL']""
SET INITIAL="<unk>"
+26 SET XTFILNAM="XTMPSIZE"_"_"_INITIAL_NOWDT_".DAT"
+27 ;
+28 SET @XTOTLK@(5)="Attached Package Parameter file.....: "_XTFILNAM_XTCRLF
+29 if ($ORDER(@XTPMARY@(0))="")
SET XTNODATA=1
+30 SET @XTOTLK@(6)=" "
+31 if (XTNODATA=0)
SET @XTOTLK@(7)=" "
+32 if (XTNODATA=1)
SET @XTOTLK@(7)="No Parameter List to file and attach!"
+33 SET OTLKNDE=7
+34 ;
+35 SET ERROOT="^TMP(""XTVS-FILERPT"","_$JOB_")"
+36 IF ($ORDER(@ERROOT@(0))'="")
Begin DoDot:1
+37 SET @XTOTLK@(9)="Report of Package File Number Corrections made when creating "_XTFILNAM_"."
+38 SET @XTOTLK@(10)=" "
+39 SET @XTOTLK@(11)="NOTE: Undefined File Number Ranges and *High/*Low File Numbers are reported."
+40 SET @XTOTLK@(12)="File Number multiple entries not included in File Number Ranges multiple are"
+41 SET @XTOTLK@(13)="added to the Package file parameter ranges and indicated in this report."
+42 SET @XTOTLK@(14)="*High/*Low File Numbers are NOT added to File Number Parameter range. If only"
+43 SET @XTOTLK@(15)="*High/*Low numbers are defined for a Package's files then that is reported."
+44 SET @XTOTLK@(16)=" "
+45 SET OTLKNDE=16
End DoDot:1
+46 if ($ORDER(@ERROOT@(0))="")
SET @XTOTLK@(8)="No File corrections made in "_XTFILNAM_"!"
+47 FOR
SET ERROOT=$QUERY(@ERROOT)
if ERROOT=""
QUIT
if $QSUBSCRIPT(ERROOT,1)'="XTVS-FILERPT"
QUIT
if $QSUBSCRIPT(ERROOT,2)'=$JOB
QUIT
Begin DoDot:1
+48 SET OTLKNDE=OTLKNDE+1
+49 IF @ERROOT["file number notes"
SET @XTOTLK@(OTLKNDE)=" "
SET OTLKNDE=OTLKNDE+1
+50 SET @XTOTLK@(OTLKNDE)=@ERROOT
End DoDot:1
+51 ;
+52 ;Begin file output
+53 SET OTLKNDE=OTLKNDE+1
+54 SET @XTOTLK@(OTLKNDE)=$$UUBEGFN^XTVSLAPI(XTFILNAM)
+55 SET XTNODE=XTPMARY
+56 SET XTOUTNOD=OTLKNDE
+57 ;;
+58 FOR
SET XTNODE=$QUERY(@XTNODE)
if (XTNODE="")
QUIT
if ($QSUBSCRIPT(XTNODE,1)'="XTSIZE")
QUIT
if ($QSUBSCRIPT(XTNODE,2)'=$JOB)
QUIT
Begin DoDot:1
+59 ; Display progress character
IF +$GET(XTRT)
if XTNODE#100=0
DO HANGCHAR^XTVSLAPI(.XTCHAR)
+60 SET XTSTR=XTSTR_@XTNODE_XTCRLF
+61 DO ENCODE^XTVSLAPI(.XTSTR,.XTOUTNOD,XTOTLK)
End DoDot:1
+62 ;
+63 FOR
if $LENGTH(XTSTR<45)
QUIT
DO ENCODE^XTVSLAPI(.XTSTR,.XTOUTNOD,XTOTLK)
+64 if (XTSTR'="")
SET @XTOTLK@(XTOUTNOD+1)=$$UUEN^XTVSLAPI(XTSTR)
+65 SET @XTOTLK@(XTOUTNOD+2)=" "
+66 SET @XTOTLK@(XTOUTNOD+3)="end"
+67 ;
+68 QUIT
