XTVSLR ;Albany FO/GTS - VistA Package Sizing Manager; 27-JUN-2016
;;7.3;TOOLKIT;**143**;Apr 25, 1995;Build 116
;
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 XTTMPLNN
KILL ^TMP("XTVS PKG MGR RPT",$JOB)
SET XTTMPLNN=0
IF (+$G(FIRSTITM)>0),(+$G(LASTITM)>0) DO
. SET XTTMPLNN=$$SELXTMP^XTVSLAPI(FIRSTITM,LASTITM,5)
. IF XTTMPLNN>0 DO
.. SET XTVPSPRM=$P(^TMP("XTVS PACKAGE MGR",$J,XTTMPLNN,0),XTTMPLNN-5_") ",2)
.. IF XTVPSPRM]"" DO
... NEW CHKLKER
... SET CHKLKER=$$REQLOCK^XTVSLAPI(XTVPSPRM)
... IF 'CHKLKER DO JUSTPAWS^XTVSLAPI($P(CHKLKER,"^",2)) DO BUILD
... IF CHKLKER W !!," <* LOCK request denied! Try again later. *>" DO JUSTPAWS^XTVSLAPI($P(CHKLKER,"^",2)) SET VALMQUIT=""
.. IF XTVPSPRM']"" DO
... SET XTVPSPRM="NOT SELECTED!"
IF ((+$G(FIRSTITM)'>0)&(+$G(LASTITM)'>0))!(XTTMPLNN'>0) SET VALMQUIT="" ;SET XTVPSPRM="NOT SELECTED!"
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)
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 Report Protocol entry point
; -- Protocol: XTVS PKG MGR RPT QUERY REMOTE ACTION
;
DO REMRPTRQ(XTVPSPRM)
QUIT
;
; ListMan Report Action APIs
REMRPTRQ(XTVPSPRM) ; Request remote report file
; Called from APIs invoked by Protocols:
; XTVS PKG QUERY REMOTE VISTA SIZE ACTION
; XTVS PKG MGR RPT QUERY REMOTE ACTION
;
NEW LINEITEM,XTVSFQ,DIR,XMY,XTVSRPT,PRMDSPCT,XTVSPVAL,PKGNAME,XTVSRMCT
;
SET LINEITEM=""
SET PKGNAME=0
KILL XMY
;
D FULL^VALM1
;
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 XTVSFQ=$GET(Y)
IF ($DATA(DUOUT))!($DATA(DTOUT))!($DATA(DIROUT)) DO JUSTPAWS^XTVSLAPI("Size Report prompt not answered!")
KILL DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
;
; If query remote system, select package to report
IF XTVSFQ=1 DO
. NEW CHKLKER,UNLKRSLT
. SET CHKLKER=$$REQLOCK^XTVSLAPI(XTVPSPRM)
. IF CHKLKER W !!," <* LOCK request denied! Try again later. *>" DO JUSTPAWS^XTVSLAPI($P(CHKLKER,"^",2))
. IF 'CHKLKER DO
.. DO JUSTPAWS^XTVSLAPI($P(CHKLKER,"^",2))
.. W !!," ...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 ADD2MSG(LINEITEM,.XTVSRMCT)
.. DO CLOSE^%ZISH("XTMP")
.. ;
.. SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI(XTVPSPRM)
.. IF ($P(UNLKRSLT,"^")'=1) W !!," <* UNLOCK ERROR. Check LOCK file Integrity. *>"
.. DO JUSTPAWS^XTVSLAPI($P(UNLKRSLT,"^",2))
.. ;
.. SET PKGNAME=$$SELPKG^XTVSLPDC(0)
.. SET LINEITEM=""
;
; If package selected, select VistA site (Domain)
IF PKGNAME=0,XTVSFQ=1 DO JUSTPAWS^XTVSLAPI("VistA Package not selected!")
IF PKGNAME'=0 DO
. 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)
;
DO MSG
SET VALMBCK="R"
;
QUIT
;
ADD2MSG(LINEITEM,XTVSRMCT) ;Add a parameter to Request Message array & create ^TMP("XTVS-PARAM-CAP",$J)
SET XTVSRMCT=XTVSRMCT+1
SET ^TMP("XTVS REQ MSG",$J,XTVSRMCT)=LINEITEM ;Package to report at remote site
DO SCAPARY^XTVSLP(LINEITEM) ;^TMP("XTVS-PARAM-CAP",$J) needed for $$SELPKG^XTVSLPDC(0)
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 8298 printed Oct 16, 2024@18:42:55 Page 2
XTVSLR ;Albany FO/GTS - VistA Package Sizing Manager; 27-JUN-2016
+1 ;;7.3;TOOLKIT;**143**;Apr 25, 1995;Build 116
+2 ;
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 XTTMPLNN
+2 KILL ^TMP("XTVS PKG MGR RPT",$JOB)
+3 SET XTTMPLNN=0
+4 IF (+$GET(FIRSTITM)>0)
IF (+$GET(LASTITM)>0)
Begin DoDot:1
+5 SET XTTMPLNN=$$SELXTMP^XTVSLAPI(FIRSTITM,LASTITM,5)
+6 IF XTTMPLNN>0
Begin DoDot:2
+7 SET XTVPSPRM=$PIECE(^TMP("XTVS PACKAGE MGR",$JOB,XTTMPLNN,0),XTTMPLNN-5_") ",2)
+8 IF XTVPSPRM]""
Begin DoDot:3
+9 NEW CHKLKER
+10 SET CHKLKER=$$REQLOCK^XTVSLAPI(XTVPSPRM)
+11 IF 'CHKLKER
DO JUSTPAWS^XTVSLAPI($PIECE(CHKLKER,"^",2))
DO BUILD
+12 IF CHKLKER
WRITE !!," <* LOCK request denied! Try again later. *>"
DO JUSTPAWS^XTVSLAPI($PIECE(CHKLKER,"^",2))
SET VALMQUIT=""
End DoDot:3
+13 IF XTVPSPRM']""
Begin DoDot:3
+14 SET XTVPSPRM="NOT SELECTED!"
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;SET XTVPSPRM="NOT SELECTED!"
IF ((+$GET(FIRSTITM)'>0)&(+$GET(LASTITM)'>0))!(XTTMPLNN'>0)
SET VALMQUIT=""
+16 DO MSG
+17 QUIT
+18 ;
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)
+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 Report Protocol entry point
+1 ; -- Protocol: XTVS PKG MGR RPT QUERY REMOTE ACTION
+2 ;
+3 DO REMRPTRQ(XTVPSPRM)
+4 QUIT
+5 ;
+6 ; 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
+3 ; XTVS PKG MGR RPT QUERY REMOTE ACTION
+4 ;
+5 NEW LINEITEM,XTVSFQ,DIR,XMY,XTVSRPT,PRMDSPCT,XTVSPVAL,PKGNAME,XTVSRMCT
+6 ;
+7 SET LINEITEM=""
+8 SET PKGNAME=0
+9 KILL XMY
+10 ;
+11 DO FULL^VALM1
+12 ;
+13 SET DIR("A",1)=""
+14 SET DIR("A",2)=" The response from a remote VistA can take some time."
+15 SET DIR("A",3)=""
+16 SET DIR("A")="Do you want to request a report from a remote VistA? "
+17 SET DIR("B")="YES"
+18 SET DIR("?",1)="Yes to query remote system using the displayed parameters."
+19 SET DIR("?",2)="No to abort request action."
+20 SET DIR("?")="Enter '^' to exit."
+21 SET DIR(0)="YA"
+22 DO ^DIR
+23 SET XTVSFQ=$GET(Y)
+24 IF ($DATA(DUOUT))!($DATA(DTOUT))!($DATA(DIROUT))
DO JUSTPAWS^XTVSLAPI("Size Report prompt not answered!")
+25 KILL DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+26 ;
+27 ; If query remote system, select package to report
+28 IF XTVSFQ=1
Begin DoDot:1
+29 NEW CHKLKER,UNLKRSLT
+30 SET CHKLKER=$$REQLOCK^XTVSLAPI(XTVPSPRM)
+31 IF CHKLKER
WRITE !!," <* LOCK request denied! Try again later. *>"
DO JUSTPAWS^XTVSLAPI($PIECE(CHKLKER,"^",2))
+32 IF 'CHKLKER
Begin DoDot:2
+33 DO JUSTPAWS^XTVSLAPI($PIECE(CHKLKER,"^",2))
+34 WRITE !!," ...Loading Parameters..."
+35 SET XTVSRMCT=4
+36 DO OPEN^%ZISH("XTMP",DEFDIR,XTVPSPRM,"R")
+37 USE IO
+38 FOR
SET LINEITEM=""
READ LINEITEM:5
if $$STATUS^%ZISH
QUIT
IF LINEITEM]""
DO ADD2MSG(LINEITEM,.XTVSRMCT)
+39 DO CLOSE^%ZISH("XTMP")
+40 ;
+41 SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI(XTVPSPRM)
+42 IF ($PIECE(UNLKRSLT,"^")'=1)
WRITE !!," <* UNLOCK ERROR. Check LOCK file Integrity. *>"
+43 DO JUSTPAWS^XTVSLAPI($PIECE(UNLKRSLT,"^",2))
+44 ;
+45 SET PKGNAME=$$SELPKG^XTVSLPDC(0)
+46 SET LINEITEM=""
End DoDot:2
End DoDot:1
+47 ;
+48 ; If package selected, select VistA site (Domain)
+49 IF PKGNAME=0
IF XTVSFQ=1
DO JUSTPAWS^XTVSLAPI("VistA Package not selected!")
+50 IF PKGNAME'=0
Begin DoDot:1
+51 SET LINEITEM=^TMP("XTVS-PARAM-CAP",$JOB,PKGNAME)
+52 KILL DIC,X,Y,DTOUT,DUOUT
+53 SET DIC="^DIC(4.2,"
+54 SET DIC(0)="AEQ"
+55 SET DIC("A")="Domain server to query: "
+56 ;Screen "CLOSED" domains
SET DIC("S")="I $P(^(0),U,2)'=""C"""
+57 DO ^DIC
+58 ;Query address for size rpt
IF '$DATA(DUOUT)
IF '$DATA(DTOUT)
IF (+Y>-1)
SET XMY("S.XTVS PKG EXTRACT SERVER@"_$PIECE(Y,"^",2))=""
+59 IF ($DATA(DUOUT))!($DATA(DTOUT))!(+Y=-1)
DO JUSTPAWS^XTVSLAPI("VistA Domain not selected!")
+60 KILL DIC,X,Y,DTOUT,DUOUT
End DoDot:1
+61 ;
+62 ; If site selected, send query message
+63 IF ($DATA(XMY))
Begin DoDot:1
+64 NEW XMTEXT,XMDUZ,XMSUB,XDATE,XMMG,XMZ,TMP
+65 SET ^TMP("XTVS REQ MSG",$JOB,1)="REQUESTED BY: "_$$NETNAME^XMXUTIL(DUZ)
+66 ; No Extract requested
SET ^TMP("XTVS REQ MSG",$JOB,2)="Extract Indicator: 0"
+67 ; Request Single Package Size rpt
SET ^TMP("XTVS REQ MSG",$JOB,3)="Report Indicator: 2"
+68 ; Package to report at remote site
SET ^TMP("XTVS REQ MSG",$JOB,4)="Package Parameters: "_LINEITEM
+69 SET XMDUZ=DUZ
+70 SET XMSUB="XTVS: PACKAGE FILE EXTRACT & REPORT REQUEST"
+71 SET XMTEXT="^TMP(""XTVS REQ MSG"","_$JOB_","
+72 DO ^XMD
+73 IF +$GET(XMZ)<1
Begin DoDot:2
+74 DO JUSTPAWS^XTVSLAPI("Error sending query message: "_XMMG_"!")
End DoDot:2
+75 IF +$GET(XMZ)>0
Begin DoDot:2
+76 DO JUSTPAWS^XTVSLAPI("Query message sent! Message # "_XMZ)
End DoDot:2
End DoDot:1
+77 ;
+78 KILL ^TMP("XTVS REQ MSG",$JOB),^TMP("XTVS-PARAM-CAP",$JOB)
+79 ;
+80 DO MSG
+81 SET VALMBCK="R"
+82 ;
+83 QUIT
+84 ;
ADD2MSG(LINEITEM,XTVSRMCT) ;Add a parameter to Request Message array & create ^TMP("XTVS-PARAM-CAP",$J)
+1 SET XTVSRMCT=XTVSRMCT+1
+2 ;Package to report at remote site
SET ^TMP("XTVS REQ MSG",$JOB,XTVSRMCT)=LINEITEM
+3 ;^TMP("XTVS-PARAM-CAP",$J) needed for $$SELPKG^XTVSLPDC(0)
DO SCAPARY^XTVSLP(LINEITEM)
+4 QUIT
+5 ;
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
