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

XTVSLAPI.m

Go to the documentation of this file.
  1. XTVSLAPI ;ALBANY FO/GTS - VistA Package Sizing Manager; 27-JUN-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. ; APIs
  1. ;
  1. EMAILEXT ; - Send Package File Extract via Packman; Extract & Email ^XTMP(""XTSIZE"","_$JOB_")
  1. ; -- Option: XTVS PKG MGR EXT PACKAGE MSG
  1. ;
  1. NEW EXTRSLT
  1. SET EXTRSLT=$$PKGEXT^XTVSLNA1()
  1. IF 'EXTRSLT,$D(^XTMP("XTSIZE",$JOB)) DO
  1. . NEW XTINSTMM,XTTOMM,XMERR,XMZ,XTTYPE
  1. . ;
  1. . WRITE !!," The message can take some time to be sent.",!
  1. . KILL XMERR
  1. . SET XTINSTMM("ADDR FLAGS")="R" ;Do not Restrict addressing
  1. . SET XTTYPE="S"
  1. . DO TOWHOM^XMXAPIU(DUZ,,XTTYPE,.XTINSTMM)
  1. . IF +$G(XMERR)'>0 DO
  1. .. NEW XMY,XMTEXT,XMDUZ,XMSUB,XTLPCNT,XDATE
  1. .. SET XTLPCNT=""
  1. .. FOR SET XTLPCNT=$O(^TMP("XMY",$J,XTLPCNT)) QUIT:XTLPCNT="" SET XMY(XTLPCNT)=""
  1. .. SET XMDUZ=DUZ
  1. .. SET XDATE=$P($P(^XTMP("XTSIZE",$JOB,0),"^",3),"-") ; Date from 3rd pce [date of extract]
  1. .. SET XDATE=$$FMTE^XLFDT(XDATE,"1P")
  1. .. SET XMSUB="PACKAGE FILE EXTRACT ("_$P(^XTMP("XTSIZE",$JOB,0),"^",4)_" ; "_XDATE_" ; $JOB#: "_$JOB_")"
  1. .. SET XMTEXT="^XTMP(""XTSIZE"","_$JOB_","
  1. .. DO ENT^XMPG
  1. .. IF +XMZ>0 DO JUSTPAWS^XTVSLAPI("^XTMP(""XTSIZE"","_$JOB_") Emailed via PackMan. [MSG #:"_XMZ_"]")
  1. .. IF +XMZ'>0 DO JUSTPAWS^XTVSLAPI("Error: ^XTMP(""XTSIZE"","_$JOB_") not sent in Packman. ["_XMMG_"]")
  1. . IF $P(EXTRSLT,"^",2)'>0 KILL ^TMP("XMY",$J),^XTMP("XTSIZE",$JOB)
  1. ;
  1. IF EXTRSLT DO JUSTPAWS^XTVSLAPI("^XTMP(""XTSIZE"","_$JOB_") global exists. Use Extract Manager to access it.")
  1. QUIT
  1. ;
  1. ADD(VALMCNT,MSG,LRBOLD,STRTBLD,ENDBLD) ; -- add line to build display
  1. ;Input
  1. ; VALMCNT - Current array node number
  1. ; MSG - Message to add to ListMan Display
  1. ; LRBOLD - Turns Bold text on - off
  1. ; STRTBLD - Column position to begin Bold Text
  1. ; ENDBLD - Number of columns to apply Bold Text
  1. ;
  1. SET VALMCNT=VALMCNT+1
  1. DO SET^VALM10(VALMCNT,MSG)
  1. IF $GET(LRBOLD) DO
  1. . SET:'$G(STRTBLD) STRTBLD=1
  1. . SET:'$G(ENDBLD) ENDBLD=79
  1. . DO CNTRL^VALM10(VALMCNT,STRTBLD,ENDBLD,IOUON,IOUOFF)
  1. QUIT
  1. ;
  1. SPLITADD(VALMCNT,MSG,ADDSPACE) ; -- add line to build display
  1. ;Input
  1. ; VALMCNT - Current array node number
  1. ; MSG - Message to add to ListMan Display
  1. ; ADDSPACE - Add space indicator (1 - add space, 0 - no space
  1. ;
  1. NEW SEGMENTS,TOTNODES,PCE,MSGPCE,START,END
  1. SET:(+$G(ADDSPACE)'=1) ADDSPACE=0
  1. SET SEGMENTS=$L(MSG)/80
  1. SET TOTNODES=+$P(SEGMENTS,".")
  1. IF ADDSPACE,(+$P(SEGMENTS,".",2)>0) SET TOTNODES=TOTNODES+1
  1. FOR PCE=0:1:TOTNODES DO
  1. . SET START=1+(PCE*80)
  1. . SET END=80+(PCE*80)
  1. . SET MSGPCE=$E(MSG,START,END)
  1. . SET VALMCNT=VALMCNT+1
  1. . DO SET^VALM10(VALMCNT,MSGPCE)
  1. QUIT
  1. ;
  1. RTRNADD(EMGRTARY,LNENUM,MSG) ; Add a line to EMGRTARY array
  1. ;INPUT
  1. ; EMGRTARY - Extract Management array [Passed by value for Indirect use]
  1. ; LNENUM - Last Node number in the EMGRTARY array
  1. ; MSG - Message to store in next line on EMGRTARY array
  1. ;
  1. SET LNENUM=LNENUM+1
  1. SET @EMGRTARY@(LNENUM,0)=MSG
  1. QUIT
  1. ;
  1. EDITPCHK() ; -- does DUZ have XTVS EDITOR key
  1. NEW XTVSSEC
  1. DO OWNSKEY^XUSRB(.XTVSSEC,"XTVS EDITOR")
  1. QUIT +$G(XTVSSEC(0))
  1. ;
  1. YNCHK(APROMPT,DEFANS) ; Yes/No Prompt
  1. ;INPUT
  1. ; APROMPT - Prompt to display before Y/N question [DIR("A")]
  1. ; DEFANS - Default Y/N answer [DIR("B")] (optional - defaults to NO)
  1. ;OUTPUT
  1. ; XTSVRSLT - value of Y when DIR Y/N prompt answer = Yes/No
  1. ; 0^-1 when Timeout, ^ or ^^ out. 3rd ^ piece = 1 when Timeout [0^-1^1].
  1. ;
  1. NEW DIR,DIRUT,DTOUT,DUOUT,X,Y,XTSVRSLT
  1. SET DIR("A")=APROMPT
  1. SET DIR(0)="Y^A"
  1. SET DIR("B")=$G(DEFANS)
  1. IF '$D(DEFANS) SET DIR("B")="NO"
  1. DO ^DIR
  1. SET XTSVRSLT=Y_"^"_Y
  1. IF $D(DTOUT)!$D(DUOUT)!$D(DIROUT) SET XTSVRSLT="0"_"^-1"_$S($D(DTOUT):"^1",1:"^")
  1. QUIT XTSVRSLT
  1. ;
  1. SELXTMP(BEGIN,END) ;Select XTMPSIZE.DAT file
  1. ; RETURN: Selected XTMPSIZE file name
  1. ;
  1. NEW SELARY,ITEMNUM,FILENME,YVAL
  1. SET SELARY=""
  1. SET ITEMNUM=$$XTMP2SEL(BEGIN,END,.SELARY)
  1. IF ITEMNUM>0 DO
  1. . NEW PARAMSTR,QSTHLP1
  1. . SET QSTHLP1=" Enter the name or number (1-"_ITEMNUM_") of the parameter file."
  1. . SET PARAMSTR("MINLNG")=10
  1. . SET PARAMSTR("PATRN")="1""XTMPSIZE"".ANP"
  1. . SET PARAMSTR("MAXLNG")=30
  1. . SET PARAMSTR("DEFANS")=$G(XTVPSPRM)
  1. . SET PARAMSTR("ADDITM")=0
  1. . SET YVAL=+$$SELITEM^XTVSLP(QSTHLP1,.ITEMNUM,.SELARY,.PARAMSTR)
  1. . IF (+$G(YVAL)>0)&(+$G(YVAL)<(ITEMNUM+1)) SET FILENME=SELARY(YVAL) W " ",FILENME
  1. ;
  1. IF ITEMNUM'>0 DO JUSTPAWS^XTVSLAPI(" There are no XTMPSIZE files to select!")
  1. ;
  1. QUIT $G(FILENME)
  1. ;
  1. WRTTXTFL(FILENME,STORPATH) ; Output Package Manager Report to Text file
  1. NEW POPERR,LMTMPNDE
  1. SET (D1,POPERR)=""
  1. ;
  1. ;If write delimited report to a file
  1. IF FILENME]"" DO QUIT:POPERR
  1. . DO OPEN^%ZISH("DELIMFL1",STORPATH,FILENME,"A")
  1. . SET:POP POPERR=POP
  1. . QUIT:POPERR
  1. . U IO
  1. . SET LMTMPNDE=0
  1. . FOR SET LMTMPNDE=$O(^TMP("XTVS PKG MGR RPT",$J,LMTMPNDE)) Q:+LMTMPNDE=0 DO
  1. .. W !,^TMP("XTVS PKG MGR RPT",$J,LMTMPNDE,0)
  1. . D CLOSE^%ZISH("DELIMFL1")
  1. QUIT
  1. ;
  1. SNDEXT(XTSVSUBJ,XQSND,XTEXTARY) ;Send VistA Size report
  1. ; -- Protocol: XTVS PKG MGR RPT MAIL ACTION
  1. ;
  1. ;INPUT:
  1. ; XTSVSUBJ - Subject of message generated
  1. ; XQSND - User's DUZ, Group Name, or S.server name
  1. ; XTEXTARY - Array containing msg text
  1. ;
  1. N XTINSTMM,XTINSTVA,XTTASKMM,XTTASKVA,XTTOMM,XTTOVA,XMERR,XMZ,XTLPCNT,XTTYPE
  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. .N XTFORMAT
  1. .WRITE !!,"NOTE: Attachments sent to VA MailMan addresses will be unreadable."
  1. .WRITE !," Send the the report in a message if sending to a VA Mailman address."
  1. .SET XTFORMAT=$$MSGORATC^XTVSLAPI("the VistA Size Report")
  1. .IF XTFORMAT'="M",XTFORMAT'="A" DO JUSTPAWS(" Message not sent!")
  1. .; Report in message
  1. .IF XTFORMAT="M" DO
  1. .. D SENDMSG^XMXAPI(XQSND,XTSVSUBJ,XTEXTARY,.XTTOVA,.XTINSTVA,.XTTASKVA)
  1. .. D JUSTPAWS("MSG#: "_XTTASKVA_" created!")
  1. .; Report in attachment
  1. .IF XTFORMAT="A" DO
  1. .. W !," [Creating attachments..."
  1. .. D OUTLKARY(XTEXTARY,"^TMP($J,""XTNETMSG"")",XTSVSUBJ,1)
  1. .. D SENDMSG^XMXAPI(XQSND,XTSVSUBJ,"^TMP($J,""XTNETMSG"")",.XTTOVA,.XTINSTVA,.XTTASKVA)
  1. .. D JUSTPAWS("MSG#: "_XTTASKVA_" created!")
  1. ;
  1. K ^TMP("XMY",$J),^TMP("XMY0",$J),^TMP($J,"XTNETMSG")
  1. DO MSG^XTVSLR
  1. SET VALMBCK="R"
  1. Q
  1. ;
  1. MSGORATC(XTQTXT) ; Query message or text attachment
  1. ; INPUT:
  1. ; XTQTXT - Report name text to include in user prompt
  1. ;
  1. ; OUTPUT:
  1. ; RESULT -
  1. ; M : Message - Send report in a message
  1. ; A : Attachment - Send report as a text file attachment to the message
  1. ; -1 : Fail/Error condition
  1. ;
  1. NEW RESULT
  1. SET DIR("A")="Send "_XTQTXT_" as a message or a text file attachment: "
  1. SET DIR("B")="A"
  1. SET DIR(0)="SAB^M:Message;A:Attachment"
  1. SET DIR("?")="Enter 'M' to send the report in a message or 'A' to send in a file attached to a message."
  1. D ^DIR
  1. SET RESULT=$SELECT($D(DIRUT):-1,1:Y)
  1. QUIT RESULT
  1. ;
  1. OUTLKARY(XTPMARY,XTOTLK,XTSVSUBJ,XTRT) ;Create attachmts array
  1. ;INPUT:
  1. ; XTPMARY - Array containing raw message 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
  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. S XTFILNAM="VistAPkgSize_"_$P(XTDTTM,".",1)_"_"_$P(XTDTTM,".",2)_".txt"
  1. S @XTOTLK@(5)="Attached VistA Size Report 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 report!!"
  1. ;
  1. ;Begin file output
  1. S @XTOTLK@(8)=$$UUBEGFN(XTFILNAM)
  1. S XTNODE=0
  1. S XTOUTNOD=8
  1. F S XTNODE=$O(@XTPMARY@(XTNODE)) Q:(XTNODE="") Q:($P($G(@XTPMARY@(XTNODE)),"^",1)="CURRENT") DO
  1. . I +$G(XTRT) D:XTNODE#100=0 HANGCHAR(.XTCHAR) ; Display progress character
  1. . S XTSTR=XTSTR_@XTPMARY@(XTNODE,0)_XTCRLF
  1. . D ENCODE(.XTSTR,.XTOUTNOD,XTOTLK)
  1. ;
  1. F Q:$L(XTSTR<45) D ENCODE(.XTSTR,.XTOUTNOD,XTOTLK)
  1. S:(XTSTR'="") @XTOTLK@(XTOUTNOD+1)=$$UUEN(XTSTR)
  1. S @XTOTLK@(XTOUTNOD+2)=" "
  1. S @XTOTLK@(XTOUTNOD+3)="end"
  1. ;
  1. SET VALMBCK="R"
  1. QUIT
  1. ;
  1. UUBEGFN(XTFILENM) ; Construct uuencode "begin" coding
  1. ; Call with XTFILENM = name of uuencoded file attachmt
  1. ;
  1. ; Returns XTX = string with "begin..."_file name
  1. ;
  1. N XTX
  1. S XTX="begin 644 "_XTFILENM
  1. Q XTX
  1. ;
  1. ENCODE(XTSTR,XTDTANOD,XTOTLK) ;Encode a string, keep remainder for next line
  1. ;INPUT:
  1. ; XTSTR - String to send in msg; call by reference, Remainder returned in XTSTR
  1. ; XTDTANOD - Number of next Node to store msg line in array
  1. ; XTOTLK - Array containing msg text for network addresses
  1. ;
  1. N XTQUIT,XTLEN,XTX
  1. S XTQUIT=0,XTLEN=$L(XTSTR)
  1. F D Q:XTQUIT
  1. . I $L(XTSTR)<45 S XTQUIT=1 Q
  1. . S XTX=$E(XTSTR,1,45)
  1. . S XTDTANOD=XTDTANOD+1,@XTOTLK@(XTDTANOD)=$$UUEN(XTX)
  1. . S XTSTR=$E(XTSTR,46,XTLEN)
  1. Q
  1. ;
  1. UUEN(STR) ; Uuencode string passed in.
  1. ;Input
  1. ; STR - String to Encode
  1. ;
  1. ;Output
  1. ; TMP - Encoded string
  1. ;
  1. N J,K,LEN,XTI,XTX,S,TMP,X,Y
  1. S TMP="",LEN=$L(STR)
  1. F XTI=1:3:LEN D
  1. . S XTX=$E(STR,XTI,XTI+2)
  1. . I $L(XTX)<3 S XTX=XTX_$E(" ",1,3-$L(XTX))
  1. . S S=$A(XTX,1)*256+$A(XTX,2)*256+$A(XTX,3),Y=""
  1. . F K=0:1:23 S Y=(S\(2**K)#2)_Y
  1. . F K=1:6:24 D
  1. . . S J=$$DEC^XLFUTL($E(Y,K,K+5),2)
  1. . . S TMP=TMP_$C(J+32)
  1. S TMP=$C(LEN+32)_TMP
  1. Q TMP
  1. ;
  1. HANGCHAR(XTCHAR) ; Display Hang Characters
  1. ;Input
  1. ; XTCHAR - Last "Hang Character" displayed
  1. NEW XTBS,XTD,XTS
  1. SET:'$D(XTCHAR) XTCHAR=0
  1. SET XTD="-"
  1. SET XTS="\"
  1. SET XTBS="/"
  1. NEW XTRESET,XTY
  1. SET XTY=$Y
  1. DO IOXY^XGF(IOSL-1,62) ;IA #3173
  1. SET XTRESET=0
  1. SET:XTCHAR=0 XTCHAR=XTBS
  1. IF 'XTRESET,XTCHAR=XTD SET XTCHAR=XTS SET XTRESET=1
  1. IF 'XTRESET,XTCHAR=XTS SET XTCHAR=XTBS SET XTRESET=1
  1. IF 'XTRESET,XTCHAR=XTBS SET XTCHAR=XTD SET XTRESET=1
  1. WRITE XTCHAR
  1. IF 1 ;Needed for ^DIC screen calls
  1. Q
  1. ;
  1. JUSTPAWS(MSG) ; Press Return to Continue
  1. NEW DIR,X,Y,DTOUT,DIRUT,DUOUT
  1. IF $G(MSG)="" SET MSG=""
  1. IF MSG]"" DO
  1. . SET DIR("A",1)=" "
  1. . SET DIR("A",2)=" "_MSG
  1. . SET DIR("A",3)=" "
  1. SET DIR("A")="Press Return to continue"
  1. SET DIR(0)="E"
  1. SET DIR("?")="Press the Enter/Return Key to continue"
  1. DO ^DIR
  1. QUIT
  1. ;
  1. FEXT(XTMPARY) ;Return Package File Multiple entries
  1. ; INPUT: XTMPARY - Package Extract Array [^XTMP("XTSIZE")]
  1. ; OUTPUT: FILELIST - Pipe (|) delimited list of File Multiple entries
  1. ;
  1. NEW FILELIST,FLNMNODE
  1. SET FILELIST=""
  1. SET FLNMNODE=0
  1. FOR SET FLNMNODE=$O(@XTMPARY@(FLNMNODE)) QUIT:FLNMNODE="" DO
  1. . SET FILELIST=FILELIST_FLNMNODE_"|"
  1. QUIT FILELIST
  1. ;
  1. LISTOUT(SELARY) ; List the packages for selection
  1. NEW ITEMNMBR,DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y
  1. SET Y=0
  1. SET ITEMNMBR=""
  1. FOR SET ITEMNMBR=$O(SELARY(ITEMNMBR)) QUIT:+ITEMNMBR=0 QUIT:$D(DIRUT) WRITE !," ",ITEMNMBR,": ",SELARY(ITEMNMBR) DO:'(ITEMNMBR#20) PAUSE^VALM1
  1. QUIT
  1. ;
  1. UNLCKPFL(FILENAME) ; UnLOCK a Parameter file
  1. NEW UNLKFNME,LOCKRSLT,DEFDIR
  1. SET LOCKRSLT=0
  1. SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
  1. SET UNLKFNME=$P(FILENAME,".")_".LCK"
  1. ;
  1. ;Check PID owning LOCK
  1. KILL FLSLIST,LOCKLIST
  1. SET FLSLIST(UNLKFNME)=""
  1. SET LOCKRSLT=$$LIST^%ZISH(DEFDIR,"FLSLIST","LOCKLIST")
  1. KILL FLSLIST,LOCKLIST
  1. ;
  1. IF +LOCKRSLT=0 SET LOCKRSLT="-1^UNLOCK Failure: Parameter file "_FILENAME_" was not LOCKED."
  1. IF '$D(OPTUNLCK),(+LOCKRSLT=1) SET LOCKRSLT=$$CHKPID(DEFDIR,FILENAME) ;Do not check from XTVS PKG MGR PARAM UNLOCK ACTION
  1. ;
  1. IF $P(LOCKRSLT,"^")=1 DO
  1. . NEW DELLKFL
  1. . SET DELLKFL(UNLKFNME)=""
  1. . SET LOCKRSLT=$$DEL^%ZISH(DEFDIR,$NA(DELLKFL))
  1. . KILL DELLKFL(UNLKFNME) ;Delete Parameter Lock file
  1. . IF LOCKRSLT=1 SET LOCKRSLT="1^Parameter file "_FILENAME_" LOCK released."
  1. . IF LOCKRSLT=0 SET LOCKRSLT="0^UNLOCK failed: Parameter file "_FILENAME_"!"
  1. . ;
  1. QUIT LOCKRSLT
  1. ;
  1. CHKPID(DEFDIR,FILENAME) ; Check PID in .LCK against $JOB
  1. NEW DOLRJ,CKDOLRJ,UNLKFNME
  1. SET UNLKFNME=$P(FILENAME,".")_".LCK"
  1. SET DOLRJ=""
  1. DO OPEN^%ZISH("CKHNDL",DEFDIR,UNLKFNME,"R")
  1. SET CKDOLRJ=$S('POP:1,1:0) ;Pop = 0, file opened
  1. IF 'CKDOLRJ SET CKDOLRJ="-1^LOCK Check Failure: Parameter file has been UNLOCKED by another process!"
  1. IF $P(CKDOLRJ,"^")=1 DO
  1. . USE IO
  1. . READ DOLRJ:5
  1. . DO CLOSE^%ZISH("CKHNDL")
  1. . IF $JOB=DOLRJ SET CKDOLRJ=1
  1. . IF $JOB'=DOLRJ SET CKDOLRJ="0^Parameter file "_FILENAME_" LOCKED by another user."
  1. QUIT CKDOLRJ
  1. ;
  1. REQLOCK(FILENAME) ; Check LOCK on a Parameter file. If unlocked, set LOCK
  1. ;RETURN: Code^msg
  1. ; Code 0 - Obtained LOCK
  1. ; 1 - LOCK failed
  1. NEW FILENME,LOCKRSLT,DOLRJ,EXTDIR
  1. KILL FLSLIST,LOCKLIST
  1. SET EXTDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
  1. SET FILENME=$P(FILENAME,".")_".LCK"
  1. SET FLSLIST(FILENME)=""
  1. ;
  1. ;Check for existing Lock
  1. SET LOCKRSLT=$$LIST^%ZISH(EXTDIR,"FLSLIST","LOCKLIST")
  1. KILL FLSLIST,LOCKLIST
  1. IF LOCKRSLT=1 DO
  1. . DO OPEN^%ZISH("CKHNDL",EXTDIR,FILENME,"R")
  1. . USE IO
  1. . FOR S DOLRJ="" READ DOLRJ:5 Q:$$STATUS^%ZISH DO
  1. .. SET LOCKRSLT=LOCKRSLT_"^Parameter file "_FILENAME_" LOCKED by $JOB PID "_$S(DOLRJ]"":DOLRJ,1:"{unknown}")
  1. . DO CLOSE^%ZISH("CKHNDL")
  1. ;
  1. ;File not locked, LOCK it
  1. IF LOCKRSLT=0 DO
  1. . NEW LOCKERR
  1. . SET LOCKERR=0
  1. . DO OPEN^%ZISH("LKHNDL",EXTDIR,FILENME,"W")
  1. . SET LOCKERR=$S(POP>0:1,1:0)
  1. . IF 'LOCKERR DO
  1. .. USE IO
  1. .. WRITE $JOB
  1. .. SET LOCKRSLT=LOCKRSLT_"^"_FILENAME_" LOCK obtained."
  1. . DO CLOSE^%ZISH("LKHNDL")
  1. . IF LOCKERR SET LOCKRSLT="1^LOCK request for parameter file "_FILENAME_" FAILED."
  1. QUIT LOCKRSLT
  1. ;
  1. NOTCE(NTCTEXT,XTVSADDR,PKGNAME) ; Send Package extract notice msg to requester
  1. ; Input:
  1. ; NTCTEXT - Notice Text to share with reader (text~TAG^ROUTINE)
  1. ; XTVSADDR - Recipients E-Mail address
  1. ; PKGNAME - Name of package that had data cleanup during extract
  1. ;
  1. NEW XMERR,XMY,XMTEXT,XMDUZ,XMSUB,ERRTEXT
  1. KILL ^TMP("XTVS-REMOTE-ERROR",$JOB)
  1. IF PKGNAME]"" DO
  1. . SET ^TMP("XTVS-REMOTE-ERROR",$JOB,1)="Notice for Package Extract on "_^%ZOSF("PROD")_"."
  1. . SET ^TMP("XTVS-REMOTE-ERROR",$JOB,2)="Data was cleaned up on "_PKGNAME_" extract."
  1. . SET ^TMP("XTVS-REMOTE-ERROR",$JOB,3)=$P(NTCTEXT,"~")
  1. SET XMDUZ="VISTA PACKAGE SIZE ANALYSIS MANAGER"
  1. SET XMY(XTVSADDR)=""
  1. SET XMTEXT="^TMP(""XTVS-REMOTE-ERROR"","_$JOB_","
  1. SET XMSUB="PACKAGE EXTRACT ("_^%ZOSF("PROD")_") ; data cleanup!"
  1. DO ^XMD
  1. IF +XMZ'>0 DO
  1. . SET ERRTEXT="'Extract cleanup notice message' FAILED to return to "_XTVSADDR_"."
  1. . DO APPERROR^%ZTER($S($P(NTCTEXT,"~",2)]"":$P(NTCTEXT,"~",2)_" : ",1:"")_"Package extract error")
  1. KILL ^TMP("XTVS-REMOTE-ERROR",$JOB)
  1. QUIT
  1. ;
  1. RMTPKGMG(MSGTEXT,XTVSADDR,PKGNAME) ; Send Package extract notice msg to requester.
  1. ; Only invoked by SRVREXT^XTVSSVR when a remote package size report is requested for a single package and fails
  1. ; Input:
  1. ; MSGTEXT - Text to share with reader
  1. ; XTVSADDR - Recipients E-Mail address
  1. ; PKGNAME - Name of package that had data cleanup during extract
  1. ;
  1. NEW XMERR,XMY,XMTEXT,XMDUZ,XMSUB,ERRTEXT
  1. KILL ^TMP("XTVS-REMOTE-ERROR",$JOB)
  1. IF PKGNAME]"" DO
  1. . SET ^TMP("XTVS-REMOTE-ERROR",$JOB,1)="Package Size Report warning for "_^%ZOSF("PROD")_"."
  1. . SET ^TMP("XTVS-REMOTE-ERROR",$JOB,2)=MSGTEXT
  1. SET XMDUZ=DUZ
  1. SET XMY(XTVSADDR)=""
  1. SET XMTEXT="^TMP(""XTVS-REMOTE-ERROR"","_$JOB_","
  1. SET XMSUB="PACKAGE REPORT NOTICE ("_^%ZOSF("PROD")_") ; Report process warning."
  1. DO ^XMD
  1. IF +XMZ'>0 DO
  1. . SET ERRTEXT="'Package Report Notice' FAILED to return to "_XTVSADDR_"."
  1. . DO APPERROR^%ZTER("TALLYRPT^XTVSRFL : Package extract error")
  1. KILL ^TMP("XTVS-REMOTE-ERROR",$JOB)
  1. QUIT
  1. ;
  1. INSRTX(X,SELARY,ITEMNUM) ;Insert item into SELARY in cardinal order
  1. NEW SELITNUM,INSRTPOS,CURITNME,CURITMNM
  1. SET INSRTPOS=0
  1. FOR SELITNUM=1:1:ITEMNUM Q:INSRTPOS>0 DO
  1. . SET CURITNME=$P(SELARY(SELITNUM),"^")
  1. . IF X']CURITNME SET INSRTPOS=SELITNUM
  1. IF INSRTPOS>0 FOR CURITMNM=ITEMNUM:-1:INSRTPOS SET SELARY(CURITMNM+1)=SELARY(CURITMNM) ;Move all entries following duplicate item
  1. IF INSRTPOS=0 SET INSRTPOS=ITEMNUM+1
  1. SET SELARY(INSRTPOS)=X
  1. SET X=INSRTPOS
  1. SET ITEMNUM=ITEMNUM+1
  1. QUIT
  1. ;
  1. XTMP2SEL(FIRSTITM,LASTITM,SELARY) ; Move XTMPSIZE from LM List to SELARY
  1. ; Default values if not defined:
  1. ; FIRSTITM - 1
  1. ; LASTITM - Larger of 1 or FIRSTITM when LASTITM > FIRSTITM
  1. ;
  1. ; E.G. Pull XTMPSIZE file from: ^TMP("XTVS PACKAGE MGR",7566,6,0)=" 1) XTMPSIZE_CLINICAL_6-15-21.DAT"
  1. ;
  1. NEW ITEMNUM,FILENME,LINENUM
  1. ;
  1. SET FIRSTITM=$S($G(FIRSTITM):+FIRSTITM,1:1)
  1. SET LASTITM=$S($G(LASTITM):+LASTITM,1:1)
  1. SET LASTITM=$S(FIRSTITM>LASTITM:FIRSTITM,1:LASTITM)
  1. ;
  1. SET ITEMNUM=0
  1. FOR LINENUM=FIRSTITM:1:LASTITM DO
  1. . SET FILENME=$P(^TMP("XTVS PACKAGE MGR",$J,LINENUM,0),") ",2)
  1. . SET ITEMNUM=ITEMNUM+1
  1. . SET SELARY(ITEMNUM)=FILENME
  1. QUIT ITEMNUM