- 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 Feb 19, 2025@00:08:47 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