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

A1VSLN.m

Go to the documentation of this file.
  1. A1VSLN ;Albany FO/GTS - VistA Package Sizing Manager; 30-JUN-2016
  1. ;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
  1. ;
  1. EN ; -- main entry point for A1VS PKG MGR EXTRACT MNGR
  1. D EN^VALM("A1VS PKG MGR EXTRACT MNGR")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. SET VALMHDR(1)=" VistA Package Size Analysis Manager - Extract Manager"
  1. SET VALMHDR(2)=" Version: "_$$VERNUM^A1VSLM()_" Build: "_$$BLDNUM^A1VSLM()
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. DO KILL ;Kill all processing & data arrays and video attributes & control arrays
  1. SET VALMCNT=0
  1. DO ADD^A1VSLAPI(.VALMCNT," ")
  1. DO ADD^A1VSLAPI(.VALMCNT," Extracted package ^XTMP global list")
  1. DO ADD^A1VSLAPI(.VALMCNT," ")
  1. DO ADD^A1VSLAPI(.VALMCNT," Process ID System Date/Time")
  1. DO ADD^A1VSLAPI(.VALMCNT," ----------------------------------------------------")
  1. DO ADD^A1VSLAPI(.VALMCNT," ")
  1. ;;DO FNDXTMP("^TMP(""A1VS PKG MGR EXTRACT"","_$JOB_")") ;; TO DO: GTS - Left for Array passing in parameter example; REMOVE CODE!
  1. DO FNDXTMP
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. D KILL
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. REFRESH ; -- On Return from another Template or action, refresh A1VS PKG MGR EXTRACT MNGR List Template array
  1. NEW LNENUM,A1DOLRJ
  1. DO KILL^A1VSLN ;Kill all processing & data arrays and video attributes & control arrays for A1VS PKG MGR EXTRACT MNGR template
  1. SET EMGRTARY="^TMP(""A1VS PKG MGR EXTRACT"","_$J_")"
  1. SET LNENUM=0
  1. DO RTRNADD^A1VSLAPI(EMGRTARY,.LNENUM," ")
  1. DO RTRNADD^A1VSLAPI(EMGRTARY,.LNENUM," Extracted package ^XTMP global list")
  1. DO RTRNADD^A1VSLAPI(EMGRTARY,.LNENUM," ")
  1. DO RTRNADD^A1VSLAPI(EMGRTARY,.LNENUM," Process ID System Date/Time")
  1. DO RTRNADD^A1VSLAPI(EMGRTARY,.LNENUM," ----------------------------------------------------")
  1. DO RTRNADD^A1VSLAPI(EMGRTARY,.LNENUM," ")
  1. ;
  1. SET A1DOLRJ=0
  1. FOR SET A1DOLRJ=$O(^XTMP("A1SIZE",A1DOLRJ)) Q:+A1DOLRJ=0 DO
  1. . NEW DATE,EXSYS
  1. . SET DATE=$P(^XTMP("A1SIZE",A1DOLRJ,0),"^")
  1. . SET EXSYS=$P(^XTMP("A1SIZE",A1DOLRJ,0),"^",2)
  1. . SET DATE=$$FMTE^XLFDT(DATE,"1P")
  1. . DO RTRNADD^A1VSLAPI(EMGRTARY,.LNENUM,$J(A1DOLRJ,13)_$J(EXSYS,15)_$J(DATE,27))
  1. IF LNENUM'>6 DO RTRNADD^A1VSLAPI(EMGRTARY,.LNENUM," No Extracts defined.")
  1. QUIT
  1. ;
  1. KILL ; -- Cleanup local and global display arrays
  1. DO CLEAN^VALM10 ;Kill data and video control arrays
  1. DO KILL^VALM10() ;Kill Video attributes
  1. KILL ^TMP("A1VS PKG MGR EXTRACT",$JOB)
  1. KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
  1. QUIT
  1. ;
  1. FNDXTMP ; List Package Extracts
  1. NEW A1DOLRJ
  1. SET A1DOLRJ=0
  1. FOR SET A1DOLRJ=$O(^XTMP("A1SIZE",A1DOLRJ)) Q:+A1DOLRJ=0 DO
  1. . NEW DATE,EXSYS
  1. . SET DATE=$P(^XTMP("A1SIZE",A1DOLRJ,0),"^")
  1. . SET EXSYS=$P(^XTMP("A1SIZE",A1DOLRJ,0),"^",2)
  1. . SET DATE=$$FMTE^XLFDT(DATE,"1P")
  1. . DO ADD^A1VSLAPI(.VALMCNT,$J(A1DOLRJ,13)_$J(EXSYS,15)_$J(DATE,27))
  1. IF VALMCNT'>6 DO ADD^A1VSLAPI(.VALMCNT," No Extracts defined.")
  1. QUIT
  1. ;
  1. SELDOLRJ() ; Select a Process ID
  1. ;OUTPUT:
  1. ; RESULT : Selected PID
  1. ; : -1 (failure)
  1. NEW RESULT,DIR,X,Y
  1. D FULL^VALM1
  1. SET DIR("A",1)=""
  1. SET DIR("A")="Enter the Extract Process ID ($JOB) number"
  1. SET DIR("?")="Enter a number from the list."
  1. SET DIR(0)="N::"
  1. DO ^DIR
  1. SET:'$D(DIRUT) RESULT=Y
  1. SET:$D(DIRUT) RESULT=0
  1. Q RESULT
  1. ;
  1. CRTPMCLN ;Kill temporary globals created by 'A1VS PKG EXT CRT PARAM ACTION' Protocol
  1. KILL ^TMP("A1VS-FILERPT",$J),^TMP("A1SIZE",$J),^TMP("A1SIZE","IDX",$J)
  1. QUIT
  1. ;
  1. ;PROTOCOL entry points
  1. DE ; -- Delete Extracts
  1. ; -- Protocol: A1VS PKG EXTRACT DEL ACTION
  1. NEW PROCID
  1. SET PROCID=$$SELDOLRJ() ;Prompt user to enter a Process ID
  1. ;
  1. IF 'PROCID DO JUSTPAWS^A1VSLAPI("No Process ID selected.")
  1. IF (PROCID),('$D(^XTMP("A1SIZE",PROCID))) DO JUSTPAWS^A1VSLAPI("^XTMP(""A1SIZE"","_PROCID_") is NOT defined!")
  1. IF (PROCID),($D(^XTMP("A1SIZE",PROCID))) DO
  1. . NEW X,Y,DIR
  1. . SET DIR("A",1)=""
  1. . SET DIR("A")="Do you want to delete ^XTMP(""A1SIZE"","_PROCID_")"
  1. . SET DIR("B")="NO"
  1. . SET DIR(0)="Y::"
  1. . DO ^DIR
  1. . IF ('$D(DTOUT)),('$D(DUOUT)),(($G(Y)=1)) KILL ^XTMP("A1SIZE",PROCID) DO KILL,INIT
  1. . IF ($D(DTOUT))!($D(DUOUT))!(($G(Y)=0)) DO
  1. .. DO JUSTPAWS^A1VSLAPI("^XTMP(""A1SIZE"","_PROCID_") NOT DELETED!")
  1. ;
  1. KILL X,Y,DTOUT,DIRUT,DUOUT
  1. SET VALMBCK="R"
  1. QUIT
  1. ;
  1. ED ; - Extract Display
  1. ; -- Protocol: A1VS PKG MGR EXT DISP ACTION
  1. ;
  1. NEW XPID,QCHK
  1. SET QCHK=0
  1. SET XPID=$$SELDOLRJ() ;Prompt user to enter a Process ID
  1. ;
  1. IF 'XPID DO JUSTPAWS^A1VSLAPI("No Process ID selected.") SET QCHK=1
  1. IF (XPID),('$D(^XTMP("A1SIZE",XPID))) DO JUSTPAWS^A1VSLAPI("^XTMP(""A1SIZE"","_XPID_") is NOT defined!") SET QCHK=1
  1. IF 'QCHK DO EN^A1VSLDE
  1. SET VALMBCK="R"
  1. QUIT
  1. ;
  1. PEXT ; -- Create Extract
  1. ; -- Protocol: A1VS PKG EXTRACT CREATE ACTION
  1. ;
  1. NEW EXTRSLT
  1. SET EXTRSLT=$$PKGEXT^A1VSLNA1()
  1. DO REFRESH
  1. SET VALMBCK="R"
  1. QUIT
  1. ;
  1. CRTPARM ; Display Package Parameter file from selected ^XTMP("A1SIZE") extract global
  1. ; -- Protocol: A1VS PKG EXT CRT PARAM ACTION
  1. ;
  1. NEW XPID,QCHK
  1. SET QCHK=0
  1. SET XPID=$$SELDOLRJ() ;Prompt user to enter a Process ID
  1. ;
  1. IF 'XPID DO JUSTPAWS^A1VSLAPI("No Process ID selected.") SET QCHK=1
  1. IF (XPID),('$D(^XTMP("A1SIZE",XPID))) DO JUSTPAWS^A1VSLAPI("^XTMP(""A1SIZE"","_XPID_") is NOT defined!") SET QCHK=1
  1. IF 'QCHK DO
  1. . DO XTMPORD^A1VSLNA1(XPID) ; Create ^TMP("A1SIZE"), Parameter file ; & ^TMP("A1SIZE","IDX"), Family Tree Index
  1. . KILL ^TMP("A1SIZE","IDX",$J) ; Cleanup Family Tree Index
  1. . DO EN^A1VSCP(XPID) ;Display Corrections report
  1. . DO CRTPMCLN ; KILL ^TMP globals
  1. . DO REFRESH
  1. ;
  1. SET VALMBCK="R"
  1. QUIT
  1. ;
  1. EEXT ; Email ^XTMP("A1SIZE") extract global
  1. ; -- Protocol: A1VS PKG EXT EMAIL ACTION
  1. ;
  1. NEW XPID,QCHK
  1. SET QCHK=0
  1. SET XPID=$$SELDOLRJ() ;Prompt user to enter a Process ID
  1. ;
  1. IF 'XPID DO JUSTPAWS^A1VSLAPI("No Process ID selected.") SET QCHK=1
  1. IF (XPID),('$D(^XTMP("A1SIZE",XPID))) DO JUSTPAWS^A1VSLAPI("^XTMP(""A1SIZE"","_XPID_") is NOT defined!") SET QCHK=1
  1. IF 'QCHK DO
  1. . NEW A1INSTMM,A1TOMM,XMERR,XMZ,A1TYPE
  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,XDATE,A1LPCNT
  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",XPID,0),"^")
  1. .. SET XDATE=$$FMTE^XLFDT(XDATE,"1P")
  1. .. SET XMSUB="PACKAGE FILE EXTRACT ("_$P(^XTMP("A1SIZE",XPID,0),"^",2)_" ; "_XDATE_" ; $JOB#: "_XPID_")"
  1. .. SET XMTEXT="^XTMP(""A1SIZE"","_XPID_","
  1. .. DO ENT^XMPG
  1. .. IF +XMZ>0 DO JUSTPAWS^A1VSLAPI("^XTMP(""A1SIZE"","_XPID_") E-Mailed via PackMan. [MSG #:"_XMZ_"]")
  1. .. IF +XMZ'>0 DO JUSTPAWS^A1VSLAPI("Error: ^XTMP(""A1SIZE"","_XPID_") not sent in Packman. ["_XMZ_"]")
  1. ;
  1. SET VALMBCK="R"
  1. QUIT