XT73P143 ;Albany FO/GTS - VistA Package Sizing Manager; 24-JUN-2016
;;7.3;TOOLKIT;**143**;Apr 25, 1995;Build 116
;
ENPOST ; -- main entry point for XT*7.3*143 post-init
NEW XTVSSTAT
IF $D(^XTMP("XTSIZE")) DO
. NEW XTDOLRJ
. DO BMES^XPDUTL(" o Deleting any existing global extract files [^XTMP(""XTSIZE"")]")
. SET XTDOLRJ=""
. FOR SET XTDOLRJ=$O(^XTMP("XTSIZE",XTDOLRJ)) Q:XTDOLRJ="" DO
. . KILL ^XTMP("XTSIZE",XTDOLRJ)
. . DO MES^XPDUTL(" ^XTMP(""XTSIZE"","_XTDOLRJ_") ...deleted.")
;
DO BMES^XPDUTL(" o Unloading Forum File extract global [^XTMP(""XTSIZE"")]")
MERGE ^XTMP("XTSIZE")=@XPDGREF@("XTVSEXT")
;
IF '$D(^XTMP("XTSIZE")) DO
. DO BMES^XPDUTL(" ** ERROR: Forum File extract global [^XTMP(""XTSIZE"")] was")
. DO MES^XPDUTL(" ** NOT INCLUDED in KIDS Transport! **")
. DO MES^XPDUTL(" ** CONTACT THE PATCH DEVELOPER!!! **")
;
IF $D(^XTMP("XTSIZE")) DO
. DO BMES^XPDUTL(" o Loading Forum File extract global [^XTMP(""XTSIZE"")] into Packman message.")
. NEW XMY,XMTEXT,XMDUZ,XMSUB,XTLPCNT,XDATE,XDOLRJ
. SET XMY(DUZ)=""
. SET XMDUZ=DUZ
. SET XDOLRJ=$O(^XTMP("XTSIZE",""))
. SET XDATE=$P($P(^XTMP("XTSIZE",XDOLRJ,0),"^",3),"-") ; Date from 3rd pce [date of extract]
. SET XDATE=$$FMTE^XLFDT(XDATE,"1P")
. SET XMSUB="FORUM PACKAGE FILE EXTRACT with XT*7.3*143 ("_$P(^XTMP("XTSIZE",XDOLRJ,0),"^",4)_" ; "_XDATE_" ; $JOB#: "_XDOLRJ_")"
. SET XMTEXT="^XTMP(""XTSIZE"","_XDOLRJ_","
. DO ENT^XMPG
. IF +XMZ>0 DO
. . DO BMES^XPDUTL(" ...^XTMP(""XTSIZE"","_XDOLRJ_") E-Mailed via PackMan. [MSG #:"_XMZ_"]")
. . DO MES^XPDUTL(" Check your VA Mailman mailbox on this VistA system!")
. . KILL ^TMP("XMY",$J),^XTMP("XTSIZE",XDOLRJ)
. IF +XMZ'>0 DO
. . DO BMES^XPDUTL(" ...Error: ^XTMP(""XTSIZE"","_XDOLRJ_") not sent in Packman.")
. . DO MES^XPDUTL(" ^XTMP(""XTSIZE"","_XDOLRJ_") global was not deleted.")
. . DO MES^XPDUTL(" Use VistA Package Size Extract Manager to send in a Packman message.")
;
SET XTVSSTAT=$$ADDPTPLT()
IF +XTVSSTAT'=2 DO BMES^XPDUTL(" o 'XTVS PKG MGT PARAMETERS' addition to PARAMETER TEMPLATE file (#8989.52) "_$SELECT(+XTVSSTAT:"succeeded.",1:"failed."))
IF +XTVSSTAT<1 DO MES^XPDUTL(" Error: "_$P(XTVSSTAT,"^",2))
IF +XTVSSTAT=2 DO
. DO BMES^XPDUTL(" o "_$P(XTVSSTAT,"^",2))
. DO BMES^XPDUTL(" ...no need to add '"_$$TEMPNAME_"' to file #8989.52.")
QUIT
;
; -- Add XTVS PKG MGT PARAMETERS to file 8989.52
ADDPTPLT() ;* Create Parameter Template entry
NEW RESULT,DA,DIE,DIC,DR,Y,X,ERR,XTVSDA0,XTVSDA1
SET RESULT="1^SUCCESS"
SET DA=$$FIND1^DIC(8989.52,"","BX",$$TEMPNAME,"","","ERR")
IF +DA>0 SET RESULT="2^'"_$$TEMPNAME_"' Parameter Template entry exists."
;
; Add XTVS PKG MGT PARAMETERS Parameter Template
IF +DA'>0 DO
. KILL DO
. SET DIC="^XTV(8989.52,",DIC(0)="LU" ;Do not execute Input Transforms on .01 field
. SET X=$$TEMPNAME()
. DO FILE^DICN
. SET XTVSDA1=+Y
. IF +XTVSDA1'>0 SET RESULT="0^PARAMETER TEMPLATE file entry failure!"
. IF +XTVSDA1>0 DO
. . NEW DA,Y,X
. . SET DA(1)=XTVSDA1
. . SET DIC=DIC_DA(1)_",10,",DIC(0)="L" ;Add entry to Parameters multiple
. . SET X=1
. . DO ^DIC
. . SET XTVSDA0=+Y
. . IF +XTVSDA0'>0 SET RESULT="0^PARAMETER TEMPLATE Parameters Sub-file entry failure!"
. . IF XTVSDA0>0 DO
. . . NEW DA,DR,Y,X,DIE
. . . ; Add values to PARAMETERS Multiple (#10)
. . . SET DA=XTVSDA0
. . . SET DA(1)=XTVSDA1
. . . SET DIE="^XTV(8989.52,"_DA(1)_",10,"
. . . KILL DIC
. . . SET DR=".02///"_$$PARAMVAL()
. . . D ^DIE
. . SET DA=XTVSDA1
. . SET DIE="^XTV(8989.52,"
. . SET DR=".02///"_$$DISPTEXT()_";.03///"_$$USEENTYF()
. . DO ^DIE
;
QUIT RESULT
;
; -- Parameter Template definition APIs
TEMPNAME() ; -- return Parameter Template name (fld #.01)
QUIT "XTVS PKG MGT PARAMETERS"
;
DISPTEXT() ; -- return display text (fld #.02)
QUIT "Package Size Parameter Edit"
;
USEENTYF() ; -- return entity for which parameters are entered (fld #.03)
QUIT "DOMAIN"
;
PARAMVAL() ; -- return Parameter (Parameters multiple fld #.02)
QUIT "XTVS PACKAGE MGR DEFAULT DIR"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXT73P143 4171 printed Nov 22, 2024@17:50:31 Page 2
XT73P143 ;Albany FO/GTS - VistA Package Sizing Manager; 24-JUN-2016
+1 ;;7.3;TOOLKIT;**143**;Apr 25, 1995;Build 116
+2 ;
ENPOST ; -- main entry point for XT*7.3*143 post-init
+1 NEW XTVSSTAT
+2 IF $DATA(^XTMP("XTSIZE"))
Begin DoDot:1
+3 NEW XTDOLRJ
+4 DO BMES^XPDUTL(" o Deleting any existing global extract files [^XTMP(""XTSIZE"")]")
+5 SET XTDOLRJ=""
+6 FOR
SET XTDOLRJ=$ORDER(^XTMP("XTSIZE",XTDOLRJ))
if XTDOLRJ=""
QUIT
Begin DoDot:2
+7 KILL ^XTMP("XTSIZE",XTDOLRJ)
+8 DO MES^XPDUTL(" ^XTMP(""XTSIZE"","_XTDOLRJ_") ...deleted.")
End DoDot:2
End DoDot:1
+9 ;
+10 DO BMES^XPDUTL(" o Unloading Forum File extract global [^XTMP(""XTSIZE"")]")
+11 MERGE ^XTMP("XTSIZE")=@XPDGREF@("XTVSEXT")
+12 ;
+13 IF '$DATA(^XTMP("XTSIZE"))
Begin DoDot:1
+14 DO BMES^XPDUTL(" ** ERROR: Forum File extract global [^XTMP(""XTSIZE"")] was")
+15 DO MES^XPDUTL(" ** NOT INCLUDED in KIDS Transport! **")
+16 DO MES^XPDUTL(" ** CONTACT THE PATCH DEVELOPER!!! **")
End DoDot:1
+17 ;
+18 IF $DATA(^XTMP("XTSIZE"))
Begin DoDot:1
+19 DO BMES^XPDUTL(" o Loading Forum File extract global [^XTMP(""XTSIZE"")] into Packman message.")
+20 NEW XMY,XMTEXT,XMDUZ,XMSUB,XTLPCNT,XDATE,XDOLRJ
+21 SET XMY(DUZ)=""
+22 SET XMDUZ=DUZ
+23 SET XDOLRJ=$ORDER(^XTMP("XTSIZE",""))
+24 ; Date from 3rd pce [date of extract]
SET XDATE=$PIECE($PIECE(^XTMP("XTSIZE",XDOLRJ,0),"^",3),"-")
+25 SET XDATE=$$FMTE^XLFDT(XDATE,"1P")
+26 SET XMSUB="FORUM PACKAGE FILE EXTRACT with XT*7.3*143 ("_$PIECE(^XTMP("XTSIZE",XDOLRJ,0),"^",4)_" ; "_XDATE_" ; $JOB#: "_XDOLRJ_")"
+27 SET XMTEXT="^XTMP(""XTSIZE"","_XDOLRJ_","
+28 DO ENT^XMPG
+29 IF +XMZ>0
Begin DoDot:2
+30 DO BMES^XPDUTL(" ...^XTMP(""XTSIZE"","_XDOLRJ_") E-Mailed via PackMan. [MSG #:"_XMZ_"]")
+31 DO MES^XPDUTL(" Check your VA Mailman mailbox on this VistA system!")
+32 KILL ^TMP("XMY",$JOB),^XTMP("XTSIZE",XDOLRJ)
End DoDot:2
+33 IF +XMZ'>0
Begin DoDot:2
+34 DO BMES^XPDUTL(" ...Error: ^XTMP(""XTSIZE"","_XDOLRJ_") not sent in Packman.")
+35 DO MES^XPDUTL(" ^XTMP(""XTSIZE"","_XDOLRJ_") global was not deleted.")
+36 DO MES^XPDUTL(" Use VistA Package Size Extract Manager to send in a Packman message.")
End DoDot:2
End DoDot:1
+37 ;
+38 SET XTVSSTAT=$$ADDPTPLT()
+39 IF +XTVSSTAT'=2
DO BMES^XPDUTL(" o 'XTVS PKG MGT PARAMETERS' addition to PARAMETER TEMPLATE file (#8989.52) "_$SELECT(+XTVSSTAT:"succeeded.",1:"failed."))
+40 IF +XTVSSTAT<1
DO MES^XPDUTL(" Error: "_$PIECE(XTVSSTAT,"^",2))
+41 IF +XTVSSTAT=2
Begin DoDot:1
+42 DO BMES^XPDUTL(" o "_$PIECE(XTVSSTAT,"^",2))
+43 DO BMES^XPDUTL(" ...no need to add '"_$$TEMPNAME_"' to file #8989.52.")
End DoDot:1
+44 QUIT
+45 ;
+46 ; -- Add XTVS PKG MGT PARAMETERS to file 8989.52
ADDPTPLT() ;* Create Parameter Template entry
+1 NEW RESULT,DA,DIE,DIC,DR,Y,X,ERR,XTVSDA0,XTVSDA1
+2 SET RESULT="1^SUCCESS"
+3 SET DA=$$FIND1^DIC(8989.52,"","BX",$$TEMPNAME,"","","ERR")
+4 IF +DA>0
SET RESULT="2^'"_$$TEMPNAME_"' Parameter Template entry exists."
+5 ;
+6 ; Add XTVS PKG MGT PARAMETERS Parameter Template
+7 IF +DA'>0
Begin DoDot:1
+8 KILL DO
+9 ;Do not execute Input Transforms on .01 field
SET DIC="^XTV(8989.52,"
SET DIC(0)="LU"
+10 SET X=$$TEMPNAME()
+11 DO FILE^DICN
+12 SET XTVSDA1=+Y
+13 IF +XTVSDA1'>0
SET RESULT="0^PARAMETER TEMPLATE file entry failure!"
+14 IF +XTVSDA1>0
Begin DoDot:2
+15 NEW DA,Y,X
+16 SET DA(1)=XTVSDA1
+17 ;Add entry to Parameters multiple
SET DIC=DIC_DA(1)_",10,"
SET DIC(0)="L"
+18 SET X=1
+19 DO ^DIC
+20 SET XTVSDA0=+Y
+21 IF +XTVSDA0'>0
SET RESULT="0^PARAMETER TEMPLATE Parameters Sub-file entry failure!"
+22 IF XTVSDA0>0
Begin DoDot:3
+23 NEW DA,DR,Y,X,DIE
+24 ; Add values to PARAMETERS Multiple (#10)
+25 SET DA=XTVSDA0
+26 SET DA(1)=XTVSDA1
+27 SET DIE="^XTV(8989.52,"_DA(1)_",10,"
+28 KILL DIC
+29 SET DR=".02///"_$$PARAMVAL()
+30 DO ^DIE
End DoDot:3
+31 SET DA=XTVSDA1
+32 SET DIE="^XTV(8989.52,"
+33 SET DR=".02///"_$$DISPTEXT()_";.03///"_$$USEENTYF()
+34 DO ^DIE
End DoDot:2
End DoDot:1
+35 ;
+36 QUIT RESULT
+37 ;
+38 ; -- Parameter Template definition APIs
TEMPNAME() ; -- return Parameter Template name (fld #.01)
+1 QUIT "XTVS PKG MGT PARAMETERS"
+2 ;
DISPTEXT() ; -- return display text (fld #.02)
+1 QUIT "Package Size Parameter Edit"
+2 ;
USEENTYF() ; -- return entity for which parameters are entered (fld #.03)
+1 QUIT "DOMAIN"
+2 ;
PARAMVAL() ; -- return Parameter (Parameters multiple fld #.02)
+1 QUIT "XTVS PACKAGE MGR DEFAULT DIR"
