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

A1VSLAPI.m

Go to the documentation of this file.
  1. A1VSLAPI ;Albany FO/GTS - VistA Package Sizing Manager; 27-JUN-2016
  1. ;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
  1. ; APIs
  1. ;
  1. EMAILEXT ; Extract & E-Mail ^XTMP(""A1SIZE"","_$JOB_")
  1. ; -- Option: A1VS EXT-EMAIL PKG DATA
  1. ;
  1. NEW EXTRSLT
  1. SET EXTRSLT=$$PKGEXT^A1VSLNA1()
  1. IF 'EXTRSLT,$D(^XTMP("A1SIZE",$JOB)) DO
  1. . NEW A1INSTMM,A1TOMM,XMERR,XMZ,A1TYPE
  1. . ;
  1. . KILL XMERR
  1. . SET A1INSTMM("ADDR FLAGS")="R" ;Do not Restrict addressing
  1. . SET A1TYPE="S"
  1. . DO TOWHOM^XMXAPIU(DUZ,,A1TYPE,.A1INSTMM)
  1. . IF +$G(XMERR)'>0 DO
  1. .. NEW XMY,XMTEXT,XMDUZ,XMSUB,A1LPCNT,XDATE
  1. .. SET A1LPCNT=""
  1. .. FOR SET A1LPCNT=$O(^TMP("XMY",$J,A1LPCNT)) QUIT:A1LPCNT="" SET XMY(A1LPCNT)=""
  1. .. SET XMDUZ=DUZ
  1. .. SET XDATE=$P(^XTMP("A1SIZE",$JOB,0),"^")
  1. .. SET XDATE=$$FMTE^XLFDT(XDATE,"1P")
  1. .. SET XMSUB="PACKAGE FILE EXTRACT ("_$P(^XTMP("A1SIZE",$JOB,0),"^",2)_" ; "_XDATE_" ; $JOB#: "_$JOB_")"
  1. .. SET XMTEXT="^XTMP(""A1SIZE"","_$JOB_","
  1. .. DO ENT^XMPG
  1. .. IF +XMZ>0 DO JUSTPAWS^A1VSLAPI("^XTMP(""A1SIZE"","_$JOB_") E-Mailed via PackMan. [MSG #:"_XMZ_"]")
  1. .. IF +XMZ'>0 DO JUSTPAWS^A1VSLAPI("Error: ^XTMP(""A1SIZE"","_$JOB_") not sent in Packman. ["_XMMG_"]")
  1. . IF $P(EXTRSLT,"^",2)'>0 KILL ^TMP("XMY",$J),^XTMP("A1SIZE",$JOB)
  1. ;
  1. IF EXTRSLT DO JUSTPAWS^A1VSLAPI("^XTMP(""A1SIZE"","_$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 A1VS EDITOR key
  1. NEW A1VSSEC
  1. DO OWNSKEY^XUSRB(.A1VSSEC,"A1VS EDITOR")
  1. QUIT +$G(A1VSSEC(0))
  1. ;
  1. YNCHK(APROMPT) ; Yes/No Prompt
  1. ;INPUT
  1. ; APROMPT - Prompt to display before Y/N question
  1. ;OUTPUT
  1. ; value of Y returned from DIR Y/N prompt
  1. ;
  1. NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
  1. SET DIR("A")=APROMPT
  1. SET DIR(0)="Y^A"
  1. SET DIR("B")="NO"
  1. DO ^DIR
  1. Q Y
  1. ;
  1. SELXTMP(BEGIN,END,A1OFFSET) ;Select XTMPSIZE.DAT file
  1. ;
  1. SET:'$D(A1OFFSET) A1OFFSET=0
  1. D FULL^VALM1
  1. SET DIR("A",1)=""
  1. SET DIR("A")="Select the XTMPSIZE*.DAT Package Parameter file item number"
  1. SET DIR(0)="N:"_BEGIN_":"_END
  1. DO ^DIR
  1. IF ($D(DTOUT))!($D(DUOUT)) QUIT -1
  1. QUIT Y+A1OFFSET
  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("A1VS PKG MGR RPT",$J,LMTMPNDE)) Q:+LMTMPNDE=0 DO
  1. .. W !,^TMP("A1VS PKG MGR RPT",$J,LMTMPNDE,0)
  1. . D CLOSE^%ZISH("DELIMFL1")
  1. QUIT
  1. ;
  1. SNDEXT(A1SVSUBJ,XQSND,A1EXTARY) ;Send VistA Size report
  1. ; -- Protocol: A1VS PKG MGR RPT MAIL ACTION
  1. ;
  1. ;INPUT:
  1. ; A1SVSUBJ - Subject of message generated
  1. ; XQSND - User's DUZ, Group Name, or S.server name
  1. ; A1EXTARY - Array containing msg text
  1. ;
  1. N A1INSTMM,A1INSTVA,A1TASKMM,A1TASKVA,A1TOMM,A1TOVA,XMERR,XMZ,A1LPCNT,A1TYPE
  1. ;
  1. DO FULL^VALM1
  1. ;
  1. S A1INSTMM("ADDR FLAGS")="R" ;Do not Restrict addressing
  1. S A1TYPE="S"
  1. K XMERR
  1. D TOWHOM^XMXAPIU(DUZ,,A1TYPE,.A1INSTMM)
  1. ;
  1. ;Check Network addresses and mail attachmt
  1. S A1INSTVA("ADDR FLAGS")="R" ;Do not Restrict addressing
  1. S A1INSTVA("FROM")="VISTA_PACKAGE_MANAGER_RPT"
  1. S A1SVSUBJ=$E(A1SVSUBJ,1,65)
  1. S A1LPCNT=""
  1. F S A1LPCNT=$O(^TMP("XMY",$J,A1LPCNT)) Q:A1LPCNT="" S A1TOVA(A1LPCNT)=""
  1. ;
  1. I +$G(XMERR)'>0 DO
  1. .W !," [Creating attachments..."
  1. .D OUTLKARY(A1EXTARY,"^TMP($J,""A1NETMSG"")",A1SVSUBJ,1)
  1. .D SENDMSG^XMXAPI(XQSND,A1SVSUBJ,"^TMP($J,""A1NETMSG"")",.A1TOVA,.A1INSTVA,.A1TASKVA)
  1. ;
  1. K ^TMP("XMY",$J),^TMP("XMY0",$J),^TMP($J,"A1NETMSG")
  1. SET VALMBCK="R"
  1. Q
  1. ;
  1. OUTLKARY(A1PMARY,A1OTLK,A1SVSUBJ,A1RT) ;Create attachmts array
  1. ;INPUT:
  1. ; A1PMARY - Array containing raw message text
  1. ; A1OTLK - Array containing message text for network addresses
  1. ; A1SVSUBJ - Message subject
  1. ; A1RT - Real Time processing from UI
  1. ;
  1. N A1FILNAM,A1DTTM,A1CRLF,A1STR,A1NODE,A1OUTNOD,A1NODATA,A1CHAR
  1. S:+$G(A1RT)=0 A1RT=0
  1. S:+$G(A1RT) A1CHAR=0
  1. S A1STR=""
  1. S A1NODATA=0
  1. S A1CRLF=$C(13,10)
  1. S A1DTTM=$$NOW^XLFDT
  1. K @A1OTLK
  1. S @A1OTLK@(1)="Attachment Generated......: "_$$FMTE^XLFDT(A1DTTM)_A1CRLF
  1. S @A1OTLK@(2)=" "
  1. S @A1OTLK@(3)="Extract Requested......: "_A1SVSUBJ_A1CRLF
  1. S @A1OTLK@(4)=" "
  1. ;
  1. S A1FILNAM="VistAPkgSize_"_$P(A1DTTM,".",1)_"_"_$P(A1DTTM,".",2)_".txt"
  1. S @A1OTLK@(5)="Attached VistA Size Report file.....: "_A1FILNAM_A1CRLF
  1. S:($O(@A1PMARY@(0))="") A1NODATA=1
  1. S @A1OTLK@(6)=" "
  1. S:(A1NODATA=0) @A1OTLK@(7)=" "
  1. S:(A1NODATA=1) @A1OTLK@(7)="No report!!"
  1. ;
  1. ;Begin file output
  1. S @A1OTLK@(8)=$$UUBEGFN(A1FILNAM)
  1. S A1NODE=0
  1. S A1OUTNOD=8
  1. F S A1NODE=$O(@A1PMARY@(A1NODE)) Q:(A1NODE="") Q:($P($G(@A1PMARY@(A1NODE)),"^",1)="CURRENT") DO
  1. . I +$G(A1RT) D:A1NODE#100=0 HANGCHAR(.A1CHAR) ; Display progress character
  1. . S A1STR=A1STR_@A1PMARY@(A1NODE,0)_A1CRLF
  1. . D ENCODE(.A1STR,.A1OUTNOD,A1OTLK)
  1. ;
  1. F Q:$L(A1STR<45) D ENCODE(.A1STR,.A1OUTNOD,A1OTLK)
  1. S:(A1STR'="") @A1OTLK@(A1OUTNOD+1)=$$UUEN(A1STR)
  1. S @A1OTLK@(A1OUTNOD+2)=" "
  1. S @A1OTLK@(A1OUTNOD+3)="end"
  1. ;
  1. SET VALMBCK="R"
  1. QUIT
  1. ;
  1. UUBEGFN(A1FILENM) ; Construct uuencode "begin" coding
  1. ; Call with A1FILENM = name of uuencoded file attachmt
  1. ;
  1. ; Returns A1X = string with "begin..."_file name
  1. ;
  1. N A1X
  1. S A1X="begin 644 "_A1FILENM
  1. Q A1X
  1. ;
  1. ENCODE(A1STR,A1DTANOD,A1OTLK) ;Encode a string, keep remainder for next line
  1. ;INPUT:
  1. ; A1STR - String to send in msg; call by reference, Remainder returned in A1STR
  1. ; A1DTANOD - Number of next Node to store msg line in array
  1. ; A1OTLK - Array containing msg text for network addresses
  1. ;
  1. N A1QUIT,A1LEN,A1X
  1. S A1QUIT=0,A1LEN=$L(A1STR)
  1. F D Q:A1QUIT
  1. . I $L(A1STR)<45 S A1QUIT=1 Q
  1. . S A1X=$E(A1STR,1,45)
  1. . S A1DTANOD=A1DTANOD+1,@A1OTLK@(A1DTANOD)=$$UUEN(A1X)
  1. . S A1STR=$E(A1STR,46,A1LEN)
  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,A1I,A1X,S,TMP,X,Y
  1. S TMP="",LEN=$L(STR)
  1. F A1I=1:3:LEN D
  1. . S A1X=$E(STR,A1I,A1I+2)
  1. . I $L(A1X)<3 S A1X=A1X_$E(" ",1,3-$L(A1X))
  1. . S S=$A(A1X,1)*256+$A(A1X,2)*256+$A(A1X,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. ;
  1. HANGCHAR(A1CHAR) ; Display Hang Characters
  1. ;Input
  1. ; A1CHAR - Last "Hang Character" displayed
  1. NEW A1BS,A1D,A1S
  1. SET:'$D(A1CHAR) A1CHAR=0
  1. SET A1D="-"
  1. SET A1S="\"
  1. SET A1BS="/"
  1. NEW A1RESET,A1Y
  1. SET A1Y=$Y
  1. DO IOXY^XGF(IOSL-1,62) ;IA #3173 ;;TO DO: GTS - instead of IOSL, use current line #
  1. SET A1RESET=0
  1. SET:A1CHAR=0 A1CHAR=A1BS
  1. IF 'A1RESET,A1CHAR=A1D SET A1CHAR=A1S SET A1RESET=1
  1. IF 'A1RESET,A1CHAR=A1S SET A1CHAR=A1BS SET A1RESET=1
  1. IF 'A1RESET,A1CHAR=A1BS SET A1CHAR=A1D SET A1RESET=1
  1. WRITE A1CHAR
  1. IF 1 ;Needed for ^DIC screen calls
  1. Q
  1. ;
  1. EXTPKG(LISTTMP) ;loop through PACKAGE file & extract data
  1. ;
  1. K ^XTMP("A1SIZE",$J) S ^XTMP("A1SIZE",$J,0)=DT
  1. S VPIEN=0 F S VPIEN=$O(^DIC(9.4,VPIEN)) Q:'VPIEN S VPNAME=$P(^DIC(9.4,VPIEN,0),"^") D SETXTMP
  1. K VPNAME,VPN,VPLOW,VPHIGH,VPOTHER,VPNAT,VPRNGE
  1. Q
  1. ;
  1. SETXTMP ; set ^XTMP global with PACKAGE data
  1. ;
  1. ; Piece 1 = Namespace
  1. ; Piece 2 = Lower File Number Range
  1. ; Piece 3 = Highest File Number Range
  1. ; Piece 4 = Other Namepaces separated by "|"
  1. ;
  1. NEW VPPARPKG,PARNTNME
  1. SET VPNAT=$G(^DIC(9.4,VPIEN,7)),VPNAT=$P(VPNAT,"^",3),VPPARPKG=$P($GET(^DIC(9.4,VPIEN,15002)),"^",2),PARNTNME=""
  1. QUIT:VPNAT'="I"
  1. S VPN=$P(^DIC(9.4,VPIEN,0),"^",2)
  1. S (VPEXCPT,VPOTHER,VPRNGE)=""
  1. S VP11=$G(^DIC(9.4,VPIEN,11)),VPLOW=$P(VP11,"^"),VPHIGH=$P(VP11,"^",2)
  1. S VPIEN2=0 F S VPIEN2=$O(^DIC(9.4,VPIEN,14,VPIEN2)) Q:'VPIEN2 S VPOTHER=VPOTHER_^DIC(9.4,VPIEN,14,VPIEN2,0)_"|"
  1. S VPIEN2=0 F S VPIEN2=$O(^DIC(9.4,VPIEN,"EX",VPIEN2)) Q:'VPIEN2 S VPEXCPT=VPEXCPT_^DIC(9.4,VPIEN,"EX",VPIEN2,0)_"|"
  1. ;
  1. ;Get Ranges from multiple field 15001.1
  1. IF +$$FLDNUM^DILFD(9.4,"LOW-HIGH RANGE")=15001.1,$D(^DIC(9.4,VPIEN,15001)) DO
  1. .S VPRNGE=""
  1. .S VPIEN2=0
  1. .F S VPIEN2=$O(^DIC(9.4,VPIEN,15001.1,VPIEN2)) Q:'VPIEN2 DO
  1. ..S VPLNUM=$P($G(^DIC(9.4,VPIEN,15001.1,VPIEN2,0)),"^")
  1. ..S VPHNUM=$P($G(^DIC(9.4,VPIEN,15001.1,VPIEN2,0)),"^",2)
  1. ..S VPRNGE=VPRNGE_VPLNUM_"-"_VPHNUM_"|"
  1. ;
  1. ;Get file numbers from multiple field 15001
  1. IF +$$FLDNUM^DILFD(9.4,"FILE NUMBER")=15001,$D(^DIC(9.4,VPIEN,15001)) DO
  1. .S VPIEN2=0
  1. .FOR S VPIEN2=$O(^DIC(9.4,VPIEN,15001,VPIEN2)) Q:'VPIEN2 DO
  1. ..S (VPFNUM,VPLNUM,VPHNUM)=""
  1. ..S VPFNUM=^DIC(9.4,VPIEN,15001,VPIEN2,0)
  1. ..S:+VPFNUM>0 ^XTMP("A1SIZE",$J,VPNAME,VPFNUM)=""
  1. ;
  1. ;Get PARENT PACKAGE field (#15003)
  1. IF VPPARPKG]"" DO
  1. .SET PARNTNME=$P($G(^DIC(9.4,VPPARPKG,0)),"^")
  1. ;
  1. SET ^XTMP("A1SIZE",$J,VPNAME)=VPN_"^"_VPLOW_"^"_VPHIGH_"^"_VPOTHER_"^"_VPEXCPT_"^"_VPRNGE_"^"_PARNTNME
  1. QUIT
  1. ;
  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. DO ^DIR
  1. QUIT
  1. ;
  1. FEXT(XTMPARY) ;Return Package File Multiple entries
  1. ; INPUT: XTMPARY - Package Extract Array [^XTMP("A1SER")]
  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