Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XTVSCP

XTVSCP.m

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