XTVSLR ;ALBANY FO/GTS - VistA Package Sizing Manager; 27-JUN-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 VISTA SIZE RPT
DO EN^VALM("XTVS PKG MGR VISTA SIZE RPT")
QUIT
;
HDR ; -- Main 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 - Package Statistics"
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
SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
SET VALMHDR(4)=SPCPAD_DIRHEAD
QUIT
;
HDRA ; -- Alternate header code
SET VALMHDR(1)=""
SET VALMHDR(2)=" Total"
SET VALMHDR(3)="Application Rtn"
SET VALMHDR(4)="(Namespace) Routines Size Files Fields Options Protocols RPCs Templates"
QUIT
;
INIT ; -- init variables and list array
NEW XTVSXFNM
KILL ^TMP("XTVS PKG MGR RPT",$JOB)
DO FULL^VALM1
IF (+$G(FIRSTITM)>0),($G(LASTITM)>0) DO
. NEW CHKLKER,LCKCHK,DEFDIR
. SET XTVSXFNM=$$SELXTMP^XTVSLAPI(FIRSTITM,LASTITM)
. IF XTVSXFNM]"" DO
.. SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
.. SET XTVPSPRM=XTVSXFNM
.. SET LASTSPKG=""
.. SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM) ;Returns 1 when current process has lock
.. SET CHKLKER=$$REQLOCK^XTVSLAPI(XTVPSPRM) ;Returns 1 when any process has lock
.. IF (+CHKLKER=0)!(+LCKCHK=1) DO
... WRITE:(+CHKLKER=0) !!,$P(CHKLKER,"^",2)
... WRITE:(+LCKCHK=1) !!,XTVPSPRM_" LOCK already held."
... DO BUILD
.. IF (+CHKLKER=1),(+LCKCHK'=1) DO
... W !!," <* LOCK request denied! Try again later. *>"
... DO JUSTPAWS^XTVSLAPI($P(CHKLKER,"^",2))
... S VALMQUIT=""
. IF XTVSXFNM']"" SET VALMQUIT=""
IF ((+$G(FIRSTITM)'>0)&(+$G(LASTITM)'>0))!($G(XTVSXFNM)']"") SET VALMQUIT=""
DO MSG
QUIT
;
BUILD ; - Build local and global display arrays
NEW UNLKRSLT
SET VALMCNT=0
DO INIT^XTVSRFL(.VALMCNT,XTVPSPRM)
SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI(XTVPSPRM)
IF +UNLKRSLT DO JUSTPAWS^XTVSLAPI($P(UNLKRSLT,"^",2))
IF VALMCNT'>0 SET VALMQUIT=""
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 !,"Package Statistics 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(LRTXT+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 !
D MSG
S VALMBCK="R"
K XTX,Y,TXTCT,XTQVAR
QUIT
;
EXIT ; -- exit code
D KILL
Q
;
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 RPT",$JOB),LASTSPKG
KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
QUIT
;
MSG(TEXT) ; -- set default message
IF $G(TEXT)]"" SET VALMSG=TEXT
IF $G(TEXT)']"" SET VALMSG="Enter ?? for more actions and Help"
QUIT
;
; ListMan Report Action APIs
TEXTFILE ; Write report to text file
; -- Protocol: XTVS PKG MGR RPT WRT ACTION
;
DO FULL^VALM1
;
NEW DIR,Y,X,FILENME,STORPATH
SET (FILENME,STORPATH)=""
SET DIR(0)="FAOr^2:60^"
SET DIR("A")="Enter directory to write report file: "_$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
SET DIR("A",1)=" "
SET DIR("B")=""
SET DIR("?")="Enter '^' to abort Host File creation."
SET DIR("?",1)="Enter a host directory where you have write privileges"
SET DIR("?",2)=" and at least 10K of space."
SET DIR("?",3)=" "
DO ^DIR
;
IF '$D(DTOUT),'$D(DUOUT),'$D(DIROUT) DO
. SET:X]"" STORPATH=X
. SET:X']"" STORPATH=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
. NEW DIR,Y,X
. SET DIR(0)="FAOr^3:30^"
. SET DIR("A")="Enter the name of the Host File "
. SET DIR("A",1)=" "
. SET DIR("B")="VistAPkgSize_"_$P($$NOW^XLFDT,".",1)_$P($$NOW^XLFDT,".",2)_".txt"
. SET DIR("?")="Enter '^' to abort Host File creation."
. SET DIR("?",1)="The file will be written to "_STORPATH
. DO ^DIR
. IF '$D(DTOUT),'$D(DUOUT),'$D(DIROUT) DO
.. SET FILENME=Y
.. DO WRTTXTFL^XTVSLAPI(FILENME,STORPATH)
;
DO MSG
SET VALMBCK="R"
QUIT
;
REMREQ ; - Remote VistA Size Query
; -- Protocol: XTVS PKG MGR RPT QUERY REMOTE ACTION
;
NEW LCKCHK,CHKLKER
DO FULL^VALM1
SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM) ;Returns 1 when current process has lock
SET CHKLKER=$$REQLOCK^XTVSLAPI(XTVPSPRM) ;Returns 1 when any process has lock
IF (+CHKLKER=0)!(+LCKCHK=1) DO
. WRITE:(+CHKLKER=0) !!,$P(CHKLKER,"^",2)
. WRITE:(+LCKCHK=1) !!,XTVPSPRM_" LOCK already held."
. DO REMRPTRQ(XTVPSPRM)
IF (+CHKLKER=1),(+LCKCHK'=1) DO
. WRITE !!," <* LOCK request denied! Try again later. *>"
. DO JUSTPAWS^XTVSLAPI($P(CHKLKER,"^",2))
DO MSG
SET VALMBCK="R"
QUIT
;
; ListMan Report Action APIs
REMRPTRQ(XTVPSPRM) ; Request remote report file
; Called from APIs invoked by Protocols:
; XTVS PKG QUERY REMOTE VISTA SIZE ACTION [Remote VistA Size Query
; - from VistA Package Size Analysis Manager LM display]
; XTVS PKG MGR RPT QUERY REMOTE ACTION [Remote VistA Size Query - from Package Statistics LM display]
;
NEW LINEITEM,XTVSRQ,DIR,XMY,XTVSRPT,PRMDSPCT,XTVSPVAL,PKGNAME,XTVSRMCT,UNLKRSLT
;
SET LINEITEM=""
SET PKGNAME=0
KILL XMY
;
SET DIR("A",1)=""
SET DIR("A",2)=" The response from a remote VistA can take some time."
SET DIR("A",3)=""
SET DIR("A")="Do you want to request a report from a remote VistA? "
SET DIR("B")="YES"
SET DIR("?",1)="Yes to query remote system using the displayed parameters."
SET DIR("?",2)="No to abort request action."
SET DIR("?")="Enter '^' to exit."
SET DIR(0)="YA"
DO ^DIR
SET XTVSRQ=$GET(Y)
IF ($DATA(DUOUT))!($DATA(DTOUT))!($DATA(DIROUT))!(XTVSRQ=0) DO
. W !!,"Size Report prompt not answered!"
. SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI(XTVPSPRM)
. IF ($P(UNLKRSLT,"^")'=1) W !!," <* UNLOCK ERROR. Check LOCK file Integrity. *>"
. DO JUSTPAWS^XTVSLAPI($P(UNLKRSLT,"^",2))
;
KILL DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
;
; If query remote system, select package to report
IF XTVSRQ=1 DO
. WRITE !!," ...Loading Parameters...",!
. SET XTVSRMCT=4
. DO OPEN^%ZISH("XTMP",DEFDIR,XTVPSPRM,"R")
. U IO
. FOR S LINEITEM="" READ LINEITEM:5 Q:$$STATUS^%ZISH IF LINEITEM]"" DO
.. DO ADD2MSG(LINEITEM,"XTVS REQ MSG",.XTVSRMCT)
.. DO SCAPARY^XTVSLP(LINEITEM) ;^TMP("XTVS-PARAM-CAP",$J) needed for $$SELPKG^XTVSLPDC(0) (XT*7.3*152)
. DO CLOSE^%ZISH("XTMP")
. ;
. SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI(XTVPSPRM)
. IF ($P(UNLKRSLT,"^")'=1) W !!," <* UNLOCK ERROR. Check LOCK file Integrity. *>"
. W !,$P(UNLKRSLT,"^",2),!
. ;
. SET PKGNAME=$$SELPKG^XTVSLPDC(0)
. SET LINEITEM=""
;
IF PKGNAME=0,XTVSRQ=1 DO JUSTPAWS^XTVSLAPI("VistA Package not selected!")
; If package selected, select VistA site (Domain)
IF PKGNAME'=0 DO
. SET LASTSPKG=PKGNAME
. SET LINEITEM=^TMP("XTVS-PARAM-CAP",$J,PKGNAME)
. KILL DIC,X,Y,DTOUT,DUOUT
. SET DIC="^DIC(4.2,"
. SET DIC(0)="AEQ"
. SET DIC("A")="Domain server to query: "
. SET DIC("S")="I $P(^(0),U,2)'=""C""" ;Screen "CLOSED" domains
. DO ^DIC
. IF '$DATA(DUOUT),'$DATA(DTOUT),(+Y>-1) SET XMY("S.XTVS PKG EXTRACT SERVER@"_$PIECE(Y,"^",2))="" ;Query address for size rpt
. IF ($DATA(DUOUT))!($DATA(DTOUT))!(+Y=-1) DO JUSTPAWS^XTVSLAPI("VistA Domain not selected!")
. KILL DIC,X,Y,DTOUT,DUOUT
;
; If site selected, send query message
IF ($DATA(XMY)) DO
. NEW XMTEXT,XMDUZ,XMSUB,XDATE,XMMG,XMZ,TMP
. SET ^TMP("XTVS REQ MSG",$J,1)="REQUESTED BY: "_$$NETNAME^XMXUTIL(DUZ)
. SET ^TMP("XTVS REQ MSG",$J,2)="Extract Indicator: 0" ; No Extract requested
. SET ^TMP("XTVS REQ MSG",$J,3)="Report Indicator: 2" ; Request Single Package Size rpt
. SET ^TMP("XTVS REQ MSG",$J,4)="Package Parameters: "_LINEITEM ; Package to report at remote site
. SET XMDUZ=DUZ
. SET XMSUB="XTVS: PACKAGE FILE EXTRACT & REPORT REQUEST"
. SET XMTEXT="^TMP(""XTVS REQ MSG"","_$J_","
. DO ^XMD
. IF +$GET(XMZ)<1 DO
.. DO JUSTPAWS^XTVSLAPI("Error sending query message: "_XMMG_"!")
. IF +$GET(XMZ)>0 DO
.. DO JUSTPAWS^XTVSLAPI("Query message sent! Message # "_XMZ)
;
KILL ^TMP("XTVS REQ MSG",$J),^TMP("XTVS-PARAM-CAP",$J)
;
QUIT
;
ADD2MSG(LINEITEM,ARRYNAME,XTVSRMCT) ;Add a parameters to Request Message array (XT*7.3*152)
NEW EXTSTR
SET EXTSTR=$EXTRACT(LINEITEM,1,255)
SET XTVSRMCT=XTVSRMCT+1
IF $L(LINEITEM)'>255 SET ^TMP(ARRYNAME,$J,XTVSRMCT)=LINEITEM
IF $L(LINEITEM)>255 SET ^TMP(ARRYNAME,$J,XTVSRMCT)=EXTSTR DO
. DO ADD2MSG($E(LINEITEM,256,9999999),ARRYNAME,.XTVSRMCT) ; Recurse to process next 255 characters
QUIT
;
SWAPHEAD ;Report of all packages, toggle action header and report header
; -- Protocol: XTVS PKG RPT SWAP HEADER
NEW SWAPPD
SET SWAPPD=0
IF VALMHDR(1)="" KILL VALMHDR DO HDR SET SWAPPD=1
IF 'SWAPPD,VALMHDR(1)'="" KILL VALMHDR DO HDRA
SET VALMBCK="R"
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTVSLR 9415 printed Dec 13, 2024@02:42:19 Page 2
XTVSLR ;ALBANY FO/GTS - VistA Package Sizing Manager; 27-JUN-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 VISTA SIZE RPT
+1 DO EN^VALM("XTVS PKG MGR VISTA SIZE RPT")
+2 QUIT
+3 ;
HDR ; -- Main 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 - Package Statistics"
+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
+11 SET $PIECE(SPCPAD," ",(80-$LENGTH(DIRHEAD))/2)=""
+12 SET VALMHDR(4)=SPCPAD_DIRHEAD
+13 QUIT
+14 ;
HDRA ; -- Alternate header code
+1 SET VALMHDR(1)=""
+2 SET VALMHDR(2)=" Total"
+3 SET VALMHDR(3)="Application Rtn"
+4 SET VALMHDR(4)="(Namespace) Routines Size Files Fields Options Protocols RPCs Templates"
+5 QUIT
+6 ;
INIT ; -- init variables and list array
+1 NEW XTVSXFNM
+2 KILL ^TMP("XTVS PKG MGR RPT",$JOB)
+3 DO FULL^VALM1
+4 IF (+$GET(FIRSTITM)>0)
IF ($GET(LASTITM)>0)
Begin DoDot:1
+5 NEW CHKLKER,LCKCHK,DEFDIR
+6 SET XTVSXFNM=$$SELXTMP^XTVSLAPI(FIRSTITM,LASTITM)
+7 IF XTVSXFNM]""
Begin DoDot:2
+8 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+9 SET XTVPSPRM=XTVSXFNM
+10 SET LASTSPKG=""
+11 ;Returns 1 when current process has lock
SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
+12 ;Returns 1 when any process has lock
SET CHKLKER=$$REQLOCK^XTVSLAPI(XTVPSPRM)
+13 IF (+CHKLKER=0)!(+LCKCHK=1)
Begin DoDot:3
+14 if (+CHKLKER=0)
WRITE !!,$PIECE(CHKLKER,"^",2)
+15 if (+LCKCHK=1)
WRITE !!,XTVPSPRM_" LOCK already held."
+16 DO BUILD
End DoDot:3
+17 IF (+CHKLKER=1)
IF (+LCKCHK'=1)
Begin DoDot:3
+18 WRITE !!," <* LOCK request denied! Try again later. *>"
+19 DO JUSTPAWS^XTVSLAPI($PIECE(CHKLKER,"^",2))
+20 SET VALMQUIT=""
End DoDot:3
End DoDot:2
+21 IF XTVSXFNM']""
SET VALMQUIT=""
End DoDot:1
+22 IF ((+$GET(FIRSTITM)'>0)&(+$GET(LASTITM)'>0))!($GET(XTVSXFNM)']"")
SET VALMQUIT=""
+23 DO MSG
+24 QUIT
+25 ;
BUILD ; - Build local and global display arrays
+1 NEW UNLKRSLT
+2 SET VALMCNT=0
+3 DO INIT^XTVSRFL(.VALMCNT,XTVPSPRM)
+4 SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI(XTVPSPRM)
+5 IF +UNLKRSLT
DO JUSTPAWS^XTVSLAPI($PIECE(UNLKRSLT,"^",2))
+6 IF VALMCNT'>0
SET VALMQUIT=""
+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["??"
Begin DoDot:1
+5 DO CLEAR^VALM1
+6 DO FULL^VALM1
+7 WRITE !,"Package Statistics 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(LRTXT+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 MSG
+18 SET VALMBCK="R"
+19 KILL XTX,Y,TXTCT,XTQVAR
+20 QUIT
+21 ;
EXIT ; -- exit code
+1 DO KILL
+2 QUIT
+3 ;
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 RPT",$JOB),LASTSPKG
+4 KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
+5 QUIT
+6 ;
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 ;
+5 ; ListMan Report Action APIs
TEXTFILE ; Write report to text file
+1 ; -- Protocol: XTVS PKG MGR RPT WRT ACTION
+2 ;
+3 DO FULL^VALM1
+4 ;
+5 NEW DIR,Y,X,FILENME,STORPATH
+6 SET (FILENME,STORPATH)=""
+7 SET DIR(0)="FAOr^2:60^"
+8 SET DIR("A")="Enter directory to write report file: "_$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+9 SET DIR("A",1)=" "
+10 SET DIR("B")=""
+11 SET DIR("?")="Enter '^' to abort Host File creation."
+12 SET DIR("?",1)="Enter a host directory where you have write privileges"
+13 SET DIR("?",2)=" and at least 10K of space."
+14 SET DIR("?",3)=" "
+15 DO ^DIR
+16 ;
+17 IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
IF '$DATA(DIROUT)
Begin DoDot:1
+18 if X]""
SET STORPATH=X
+19 if X']""
SET STORPATH=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+20 NEW DIR,Y,X
+21 SET DIR(0)="FAOr^3:30^"
+22 SET DIR("A")="Enter the name of the Host File "
+23 SET DIR("A",1)=" "
+24 SET DIR("B")="VistAPkgSize_"_$PIECE($$NOW^XLFDT,".",1)_$PIECE($$NOW^XLFDT,".",2)_".txt"
+25 SET DIR("?")="Enter '^' to abort Host File creation."
+26 SET DIR("?",1)="The file will be written to "_STORPATH
+27 DO ^DIR
+28 IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
IF '$DATA(DIROUT)
Begin DoDot:2
+29 SET FILENME=Y
+30 DO WRTTXTFL^XTVSLAPI(FILENME,STORPATH)
End DoDot:2
End DoDot:1
+31 ;
+32 DO MSG
+33 SET VALMBCK="R"
+34 QUIT
+35 ;
REMREQ ; - Remote VistA Size Query
+1 ; -- Protocol: XTVS PKG MGR RPT QUERY REMOTE ACTION
+2 ;
+3 NEW LCKCHK,CHKLKER
+4 DO FULL^VALM1
+5 ;Returns 1 when current process has lock
SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
+6 ;Returns 1 when any process has lock
SET CHKLKER=$$REQLOCK^XTVSLAPI(XTVPSPRM)
+7 IF (+CHKLKER=0)!(+LCKCHK=1)
Begin DoDot:1
+8 if (+CHKLKER=0)
WRITE !!,$PIECE(CHKLKER,"^",2)
+9 if (+LCKCHK=1)
WRITE !!,XTVPSPRM_" LOCK already held."
+10 DO REMRPTRQ(XTVPSPRM)
End DoDot:1
+11 IF (+CHKLKER=1)
IF (+LCKCHK'=1)
Begin DoDot:1
+12 WRITE !!," <* LOCK request denied! Try again later. *>"
+13 DO JUSTPAWS^XTVSLAPI($PIECE(CHKLKER,"^",2))
End DoDot:1
+14 DO MSG
+15 SET VALMBCK="R"
+16 QUIT
+17 ;
+18 ; ListMan Report Action APIs
REMRPTRQ(XTVPSPRM) ; Request remote report file
+1 ; Called from APIs invoked by Protocols:
+2 ; XTVS PKG QUERY REMOTE VISTA SIZE ACTION [Remote VistA Size Query
+3 ; - from VistA Package Size Analysis Manager LM display]
+4 ; XTVS PKG MGR RPT QUERY REMOTE ACTION [Remote VistA Size Query - from Package Statistics LM display]
+5 ;
+6 NEW LINEITEM,XTVSRQ,DIR,XMY,XTVSRPT,PRMDSPCT,XTVSPVAL,PKGNAME,XTVSRMCT,UNLKRSLT
+7 ;
+8 SET LINEITEM=""
+9 SET PKGNAME=0
+10 KILL XMY
+11 ;
+12 SET DIR("A",1)=""
+13 SET DIR("A",2)=" The response from a remote VistA can take some time."
+14 SET DIR("A",3)=""
+15 SET DIR("A")="Do you want to request a report from a remote VistA? "
+16 SET DIR("B")="YES"
+17 SET DIR("?",1)="Yes to query remote system using the displayed parameters."
+18 SET DIR("?",2)="No to abort request action."
+19 SET DIR("?")="Enter '^' to exit."
+20 SET DIR(0)="YA"
+21 DO ^DIR
+22 SET XTVSRQ=$GET(Y)
+23 IF ($DATA(DUOUT))!($DATA(DTOUT))!($DATA(DIROUT))!(XTVSRQ=0)
Begin DoDot:1
+24 WRITE !!,"Size Report prompt not answered!"
+25 SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI(XTVPSPRM)
+26 IF ($PIECE(UNLKRSLT,"^")'=1)
WRITE !!," <* UNLOCK ERROR. Check LOCK file Integrity. *>"
+27 DO JUSTPAWS^XTVSLAPI($PIECE(UNLKRSLT,"^",2))
End DoDot:1
+28 ;
+29 KILL DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+30 ;
+31 ; If query remote system, select package to report
+32 IF XTVSRQ=1
Begin DoDot:1
+33 WRITE !!," ...Loading Parameters...",!
+34 SET XTVSRMCT=4
+35 DO OPEN^%ZISH("XTMP",DEFDIR,XTVPSPRM,"R")
+36 USE IO
+37 FOR
SET LINEITEM=""
READ LINEITEM:5
if $$STATUS^%ZISH
QUIT
IF LINEITEM]""
Begin DoDot:2
+38 DO ADD2MSG(LINEITEM,"XTVS REQ MSG",.XTVSRMCT)
+39 ;^TMP("XTVS-PARAM-CAP",$J) needed for $$SELPKG^XTVSLPDC(0) (XT*7.3*152)
DO SCAPARY^XTVSLP(LINEITEM)
End DoDot:2
+40 DO CLOSE^%ZISH("XTMP")
+41 ;
+42 SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI(XTVPSPRM)
+43 IF ($PIECE(UNLKRSLT,"^")'=1)
WRITE !!," <* UNLOCK ERROR. Check LOCK file Integrity. *>"
+44 WRITE !,$PIECE(UNLKRSLT,"^",2),!
+45 ;
+46 SET PKGNAME=$$SELPKG^XTVSLPDC(0)
+47 SET LINEITEM=""
End DoDot:1
+48 ;
+49 IF PKGNAME=0
IF XTVSRQ=1
DO JUSTPAWS^XTVSLAPI("VistA Package not selected!")
+50 ; If package selected, select VistA site (Domain)
+51 IF PKGNAME'=0
Begin DoDot:1
+52 SET LASTSPKG=PKGNAME
+53 SET LINEITEM=^TMP("XTVS-PARAM-CAP",$JOB,PKGNAME)
+54 KILL DIC,X,Y,DTOUT,DUOUT
+55 SET DIC="^DIC(4.2,"
+56 SET DIC(0)="AEQ"
+57 SET DIC("A")="Domain server to query: "
+58 ;Screen "CLOSED" domains
SET DIC("S")="I $P(^(0),U,2)'=""C"""
+59 DO ^DIC
+60 ;Query address for size rpt
IF '$DATA(DUOUT)
IF '$DATA(DTOUT)
IF (+Y>-1)
SET XMY("S.XTVS PKG EXTRACT SERVER@"_$PIECE(Y,"^",2))=""
+61 IF ($DATA(DUOUT))!($DATA(DTOUT))!(+Y=-1)
DO JUSTPAWS^XTVSLAPI("VistA Domain not selected!")
+62 KILL DIC,X,Y,DTOUT,DUOUT
End DoDot:1
+63 ;
+64 ; If site selected, send query message
+65 IF ($DATA(XMY))
Begin DoDot:1
+66 NEW XMTEXT,XMDUZ,XMSUB,XDATE,XMMG,XMZ,TMP
+67 SET ^TMP("XTVS REQ MSG",$JOB,1)="REQUESTED BY: "_$$NETNAME^XMXUTIL(DUZ)
+68 ; No Extract requested
SET ^TMP("XTVS REQ MSG",$JOB,2)="Extract Indicator: 0"
+69 ; Request Single Package Size rpt
SET ^TMP("XTVS REQ MSG",$JOB,3)="Report Indicator: 2"
+70 ; Package to report at remote site
SET ^TMP("XTVS REQ MSG",$JOB,4)="Package Parameters: "_LINEITEM
+71 SET XMDUZ=DUZ
+72 SET XMSUB="XTVS: PACKAGE FILE EXTRACT & REPORT REQUEST"
+73 SET XMTEXT="^TMP(""XTVS REQ MSG"","_$JOB_","
+74 DO ^XMD
+75 IF +$GET(XMZ)<1
Begin DoDot:2
+76 DO JUSTPAWS^XTVSLAPI("Error sending query message: "_XMMG_"!")
End DoDot:2
+77 IF +$GET(XMZ)>0
Begin DoDot:2
+78 DO JUSTPAWS^XTVSLAPI("Query message sent! Message # "_XMZ)
End DoDot:2
End DoDot:1
+79 ;
+80 KILL ^TMP("XTVS REQ MSG",$JOB),^TMP("XTVS-PARAM-CAP",$JOB)
+81 ;
+82 QUIT
+83 ;
ADD2MSG(LINEITEM,ARRYNAME,XTVSRMCT) ;Add a parameters to Request Message array (XT*7.3*152)
+1 NEW EXTSTR
+2 SET EXTSTR=$EXTRACT(LINEITEM,1,255)
+3 SET XTVSRMCT=XTVSRMCT+1
+4 IF $LENGTH(LINEITEM)'>255
SET ^TMP(ARRYNAME,$JOB,XTVSRMCT)=LINEITEM
+5 IF $LENGTH(LINEITEM)>255
SET ^TMP(ARRYNAME,$JOB,XTVSRMCT)=EXTSTR
Begin DoDot:1
+6 ; Recurse to process next 255 characters
DO ADD2MSG($EXTRACT(LINEITEM,256,9999999),ARRYNAME,.XTVSRMCT)
End DoDot:1
+7 QUIT
+8 ;
SWAPHEAD ;Report of all packages, toggle action header and report header
+1 ; -- Protocol: XTVS PKG RPT SWAP HEADER
+2 NEW SWAPPD
+3 SET SWAPPD=0
+4 IF VALMHDR(1)=""
KILL VALMHDR
DO HDR
SET SWAPPD=1
+5 IF 'SWAPPD
IF VALMHDR(1)'=""
KILL VALMHDR
DO HDRA
+6 SET VALMBCK="R"
+7 QUIT
