PSNFTP ;HP/ART - PPS-N National Drug File Updates File Transfer ;09/25/2015
;;4.0;NATIONAL DRUG FILE;**513**; 30 Oct 98;Build 53
;Supported ICRs/IAs
;External reference to $$DECRYP^XUSRB1() supported by DBIA 2241
;External reference to ^%ZISH supported by DBIA 2320
;External reference to USE^%ZISUTL supported by DBIA 2119
;External reference to $$OS^%ZOSV supported by DBIA 10097
;External reference to ^XLFDT supported by DBIA 10103
;External reference to ^XMD supported by DBIA 10070
;External reference to ^PS(59.7 supported by DBIA #2613
;External reference to ^XUSEC supported by DBIA #10076
;
;SAC Exemption For use of Cache function $ZF(-1, was granted 10/23/15 by SACC committee
;
EN ; Main Entry Point for PPS-N National Drug File Updates File Transfer
;If a scheduled job initiates the PSNSCJOB=1 will be defined.
I $$GET1^DIQ(57.23,1,9,"I")="Y" Q
;
N PSRC,PSOS,PSREMFIL,PSFILE,PSFFND,DIE,DA,DR,LOCDIR,PSUID,PSNDNLDB
N PSPREV,PSLAST,PSNEW,PSERRMSG,PSSIZE,PSWRKDIR,PSOLDF,PSFDCNT,PSOS2,PRSC,PSNPS,PSOUNXLD,X,XPV
D NOW^%DTC S PSNDNLDB=%
S PSFFND=0,(PSFDCNT,PSRC)=1
S PSOS=$$GETOS
S (PSFILE,PSREMFIL,PSOLDF)=""
S PSWRKDIR=$$GETD()
I PSOS["UNIX",'$$DIREXIST^PSNFTP2(PSWRKDIR) D MAKEDIR^PSNFTP2(PSWRKDIR)
K DIE,DA,DR
S DIE="^PS(57.23,",DA=1,DR="9///Y" D ^DIE K DIE,DA,DR
F D Q:+PSRC<1
. S PSERRMSG(1)="0^RETRIEVAL VERSION in PPS-N UPDATE CONTROL (#57.23) file is not defined"
. ;last file downloaded
. S PSLAST=$$GET1^DIQ(57.23,1,8)
. I PSLAST="" D Q
. . S PSRC=PSERRMSG(1)
. . D MAILFTP(0,"undeterminedFileName","",$P(PSRC,U,2))
. . W "Determine remote file name failed ",PSOS," rc=",PSRC,!
. ;
. S PSNEW=PSLAST+1
. S (PSFILE,PSREMFIL)="PPS_"_PSLAST_"PRV_"_PSNEW_"NEW.DAT"
. I PSFDCNT=1 S PSOLDF=PSFILE
. S PSFDCNT=PSFDCNT+1
. I 'PSFFND W !!,"Beginning download for Update file name: ",PSREMFIL
. I PSFFND W !!,"Continuing with the next file sequence. Attempting download",!," for: "_PSREMFIL
. W !!
. ;ping the remote server
. D PING(.PSRC,PSOS)
. USE 0
. I '+PSRC D Q
. . D MAILFTP(0,PSREMFIL,"",$P(PSRC,U,2)) W "Server ping failed ",PSOS," rc=",PSRC,!
. W "Server ping successful ",PSOS," rc=",PSRC,!
. S PSOS2="",PSOS2=$S(PSOS["VMS":"VMS",PSOS["UNIX":"LINIX",1:"LINUX")_"DEL"
. I PSOS["VMS" D
. . ;D @PSOS2^PSNFTP2(PSRC,PSWRKDIR,"PSNPING.COM")
. . ;D @PSOS2^PSNFTP2(PSRC,PSWRKDIR,"PSNPING.LOG")
. ;
. I PSOS["LINIX" D
. . D @PSOS2^PSNFTP2(PSRC,PSWRKDIR,"PSNPING.LOG")
. ;
. ;transfer a file
. S PSRC=PSERRMSG(1)
. D FTP(.PSRC,PSOS,PSREMFIL,.PSERRMSG)
. U 0
. I +PSOS=1 D
. . ;D VMSDEL^PSNFTP2(PSRC,PSWRKDIR,"PSNFTP.COM")
. . ;D VMSDEL^PSNFTP2(PSRC,PSWRKDIR,"PSNFTP.LOG")
. . ;D VMSDEL^PSNFTP2(PSRC,PSWRKDIR,"PSNSFTP.DAT")
. I +PSOS=3 D
. . D LINUXDEL(PSRC,PSWRKDIR,"PSNFTP.sh")
. . D LINUXDEL(PSRC,PSWRKDIR,"PSNFTP.LOG")
. . D LINUXDEL(PSRC,PSWRKDIR,"PSNSFTP.DAT")
. . D LINUXDEL(PSRC,PSWRKDIR,"PSNPING.LOG")
. ;
. I +PSRC=0&(PSFFND) D Q
. . W !!,PSREMFIL_" does not exist.",!!,"PPS-N/NDF Download process is complete.",!
. ;
. I +PSRC=0&('PSFFND) D Q
. . D MAILFTP(0,PSREMFIL,"",$P(PSRC,U,2))
. . Q:PSOLDF=PSREMFIL
. . W "file transfer failed ",PSOS," rc=",PSRC,!
. ;
. I +PSRC=-1&('PSFFND) D Q
. . D MAILFTP(0,PSREMFIL,"",$P(PSRC,U,2))
. . Q:PSOLDF=PSREMFIL
. . W "remote file not found ",PSOS," rc=",PSRC,!
. ;
. ;update PPS-N UPDATE CONTROL:RETRIEVAL VERSION (#57.23:8)
. I +PSRC=1 W "file transfer successful ",PSOS," rc=",PSRC,!
. Q:+PSRC'=1
. S PSFFND=1
. K DIE,DA,DR
. S DIE="^PS(57.23,",DA=1,DR="8///"_PSNEW D ^DIE K DIE,DA,DR
. S PSSIZE=""
. ;
. ;**VMS file size
. I +PSOS=1 D FILSIZE^PSNFTP2(PSWRKDIR,PSFILE,.PSSIZE,"")
. ;
. ;**linux file size
. I +PSOS=3 D
. . S XPV="S PV=$ZF(-1,""stat -c%s "_PSWRKDIR_PSFILE_">"_PSWRKDIR_"PSNSIZE.DAT"")"
. . X XPV
. . S PSXLOG="",PSXLOG=$$FTG^%ZISH(PSWRKDIR,"PSNSIZE.DAT",$NAME(^TMP("PSNFSIZELOG",$J,1)),3)
. . I $D(^TMP("PSNFSIZELOG",$J,1)) S PSSIZE=^TMP("PSNFSIZELOG",$J,1)
. ;
. D MAILFTP(1,PSFILE,PSSIZE,""),DELFILES^PSNFTP2(PSWRKDIR)
. W !!,"Completed download for: ",PSREMFIL,!!
. D UPDTCTRL
. S PRSC=0
K DIE,DA,DR
S DIE="^PS(57.23,",DA=1,DR="9///N" D ^DIE K DIE,DA,DR
D NOW^%DTC S DIE="^PS(57.23,1,4,",DA=1,DR="3///"_% D ^DIE K DIE,DA,DR
K DIE,DA,DR
Q
;
PING(PSRC,PSOS) ; Check for availability of server (ping)
;Inputs: PSRC - reference to return code
; PSOS - current OS
;Output: PSRC - populated return code
;
N PSERRMSG,PSADDR,PSCOMFIL,PSLOGFIL,PSFILES
S PSERRMSG(1)="0^Remote Server Address in the PPS-N Site Parameters is not defined or invalid"
S PSERRMSG(2)="0^"_$S($$GETOS["VMS":"VMS",$$GETOS["LINUX":"Unix/Linux",1:"")_" Local Directory in the PPS-N Site Parameters is not defined or invalid"
;S PSERRMSG(2)="0^Local Directory in the PPS-N Site Parameters is not defined or invalid"
S PSRC=1
S PSADDR=$$GET1^DIQ(57.23,1,20) I PSADDR="" S PSRC=PSERRMSG(1) Q
;S PSWRKDIR="USER$:[SFTP.PPSN]"
S PSWRKDIR=$$GETD() I PSWRKDIR="" S PSRC=PSERRMSG(2) Q
S PSCOMFIL="PSNPING.COM"
S PSLOGFIL="PSNPING.LOG"
;
;VMS
I +PSOS=1 D
. D VMSPING(.PSRC,PSADDR,PSWRKDIR,PSCOMFIL,PSLOGFIL)
. S PSFILES(PSCOMFIL)=""
. I '$$DELFILES(PSWRKDIR,.PSFILES) W !,"File cleanup/delete failed.",!
;
;Linux
I +PSOS=3 D LINXPING(.PSRC,PSADDR,PSWRKDIR,PSLOGFIL)
;
;Windows
I +PSOS=2 D WINPING(.PSRC,PSADDR,PSWRKDIR,PSLOGFIL)
Q
;
FTP(PSRC,PSOS,PSREMFIL,PSERRMSG) ; ftp (get) a file
;Inputs: PSRC - reference to return code
; PSOS - current OS
; PSREMFIL - remote file name
;Output: PSRC - populated return code
;
N PSADDR,PSNUSER,PSREMDIR,PSCOMFIL,PSSHFILE
N PSLOCDIR,PSCMDFIL,PSLOGFIL,PSDATFIL
S PSERRMSG(1)="0^REMOTE SERVER ADDRESS in PPS-N UPDATE CONTROL (#57.23) file is not defined"
S PSERRMSG(2)="0^REMOTE SFTP USER ID in PPS-N UPDATE CONTROL (#57.23) file is not defined"
S PSERRMSG(3)="0^PRIMARY HFS DIRECTORY in KERNEL SYSTEM PARAMETERS (#8989.3) file is not defined"
S PSERRMSG(4)="0^DIRECTORY PATH in PPS-N UPDATE CONTROL (#57.23) file is not defined"
S PSERRMSG(5)="0^REMOTE DIRECTORY ACCESS in PPS-N UPDATE CONTROL (#57.23) file is not defined"
S PSRC=1
S PSADDR=$$GET1^DIQ(57.23,1,20) I PSADDR="" S PSRC=PSERRMSG(1) Q
S PSNUSER=$$GET1^DIQ(57.23,1,22) I PSNUSER="" S PSRC=PSERRMSG(2) Q
S PSWRKDIR=$$GETD() I PSWRKDIR="" S PSRC=PSERRMSG(3) Q
S PSLOCDIR=$$GETD() I PSLOCDIR="" S PSRC=PSERRMSG(4) Q
S PSREMDIR=$$GET1^DIQ(57.23,1,21) I PSREMDIR="" S PSRC=PSERRMSG(5) Q
S PSCOMFIL="PSNFTP.COM"
S PSSHFILE="PSNFTP.sh"
S PSCMDFIL="PSNFTPCMDS.txt"
S PSLOGFIL="PSNFTP.LOG"
S PSDATFIL="PSNSFTP.DAT"
D SAVEKEYS^PSNFTP2(PSWRKDIR)
;
;VMS
I +PSOS=1 D
. D VMSFTP^PSNFTP2(.PSRC,PSADDR,PSNUSER,PSWRKDIR,PSLOCDIR,PSREMDIR,PSREMFIL,PSCOMFIL,PSLOGFIL,PSDATFIL,.PSERRMSG)
. S PSFILES(PSCOMFIL)="",PSFILES("VSSHID.")="",PSFILES("VSSHKEY.")="",PSFILES("VSSHKEY.PUB")=""
. I '$$DELFILES(PSWRKDIR,.PSFILES) W !,"File cleanup/delete failed.",!
;
;Linux
I +PSOS=3 D
. S PSLOCDIR=$E(PSLOCDIR,1,($L(PSLOCDIR)-1)) ; chop off trailing /
. D LINUXFTP^PSNFTP2(.PSRC,PSADDR,PSNUSER,PSWRKDIR,PSLOCDIR,PSREMDIR,PSREMFIL,PSSHFILE,PSLOGFIL,PSDATFIL)
. S PSFILES(PSSHFILE)="",PSFILES("VSSHKEY")="",PSFILES("uxsshkey")=""
. I '$$DELFILES(PSWRKDIR,.PSFILES) W !,"File cleanup/delete failed.",!
;
;Windows
I +PSOS=2 D
. S PSLOCDIR=$E(PSLOCDIR,1,($L(PSLOCDIR)-1)) ; chop off trailing \
. D WINFTP^PSNFTP2(.PSRC,PSADDR,PSUID,PSWRKDIR,PSLOCDIR,PSREMDIR,PSREMFIL,PSCMDFIL,PSLOGFIL)
. S PSFILES(PSCMDFIL)=""
. I '$$DELFILES(PSWRKDIR,.PSFILES) WRITE !,"File cleanup/delete failed.",!
Q
;
GETOS() ;Determine OS
;Returns: PSOS - local OS
N PSOS S PSOS=$$OS^%ZOSV()
S PSOS=$S(PSOS["VMS":"1-VMS",PSOS["NT":"2-MSW",PSOS["UNIX":"3-LINUX",1:"0-")
Q PSOS
;
VMSPING(PSRC,PSADDR,PSWRKDIR,PSCOMFIL,PSLOGFIL) ; PING VMS server to ensure it is available
;Inputs: PSRC - return code, by reference
; PSADDR - remote server address
; PSWRKDIR - local work directory name
; PSCOMFIL - .com file name
; PSLOGFIL - log file name
;Output: PSRC - populated return code
;
;check parameters
I $G(PSADDR)="" S PSRC="0^no target server address" Q
I $G(PSWRKDIR)="" S PSRC="0^no local work directory name" Q
I $G(PSCOMFIL)="" S PSRC="0^no .com file name" Q
I $G(PSLOGFIL)="" S PSRC="0^no log file name" Q
; Create .COM file
N POP
D OPEN^%ZISH("FILE1",PSWRKDIR,PSCOMFIL,"W")
I POP S PSRC="0^failed to open ping .com file" Q
D USE^%ZISUTL("FILE1")
W "$ SET VERIFY=(PROCEDURE,IMAGE)",!
W "$ SET DEFAULT "_PSWRKDIR,!
W "$ TCPIP",!
W "PING "_PSADDR,!
W "EXIT",!
W "$ EXIT 3",!
D CLOSE^%ZISH("FILE1")
; Execute .COM file, create logfile
N PSZFRC
S PSZFRC=$ZF(-1,"@"_PSWRKDIR_PSCOMFIL_"/OUTPUT="_PSWRKDIR_PSLOGFIL)
; Error check
I PSZFRC=-1 S PSRC="0^VMS OS command execution failed" Q
; Read Logfile into working global, check for error
K ^TMP("PSNPINGLOG",$J)
N PSXLOG,PSPNG,PSPNG1
S PSXLOG=$$FTG^%ZISH(PSWRKDIR,PSLOGFIL,$NAME(^TMP("PSNPINGLOG",$J,1)),3)
S PSPNG="",PSPNG1=0
F S PSPNG=$O(^TMP("PSNPINGLOG",$J,PSPNG)) Q:PSPNG="" D
. S PSPNG1=$G(^TMP("PSNPINGLOG",$J,PSPNG))
. I PSPNG1["0 packets received" S PSRC="0^Remote server - "_PSADDR_" - did not respond"
. I PSPNG1["%SYSTEM" S PSRC="0^Remote server - "_PSADDR_" - did not respond"
D DELFILES^PSNFTP2($G(PSWRKDIR),$G(PSLOGFIL),$G(PSCOMFIL),"")
Q
;
LINXPING(PSRC,PSADDR,PSWRKDIR,PSLOGFIL) ; PING Unix/Linux server to ensure it is available
;Inputs: PSRC - return code, by reference
; PSADDR - remote server address
; PSWRKDIR - local work directory name
; PSLOGFIL - log file name
;Output: PSRC - populated return code
;
;check parameters
I PSADDR="" S PSRC="0^no target server address" Q
I $G(PSWRKDIR)="" S PSRC="0^no local work directory name" Q
I $G(PSLOGFIL)="" S PSRC="0^no log file name" Q
; Execute ping, create logfile
N PSZFRC
S PSZFRC=$ZF(-1,"ping -c 4 "_PSADDR_">"_PSWRKDIR_PSLOGFIL)
; Error check
I PSZFRC=-1 S PSRC="0^Linux OS command execution failed" Q
; Read Logfile into working global, check for error
K ^TMP("PSNPINGLOG",$J)
N PSXLOG,PSPNG,PSPNG1 S PSPNG="",PSPNG1=0
S PSXLOG=$$FTG^%ZISH(PSWRKDIR,PSLOGFIL,$NAME(^TMP("PSNPINGLOG",$J,1)),3)
F S PSPNG=$O(^TMP("PSNPINGLOG",$J,PSPNG)) Q:PSPNG="" D
. S PSPNG1=$G(^TMP("PSNPINGLOG",$J,PSPNG))
. I PSPNG1["0 received" S PSRC="0^Remote server - "_PSADDR_" - did not respond"
;D DELFILES^PSNFTP2($G(PSWRKDIR),$G(PSLOGFIL))
Q
WINPING(PSRC,PSADDR,PSWRKDIR,PSLOGFIL) ; PING server to ensure it is available
;Inputs: PSRC - return code, by reference
; PSADDR - remote server address
; PSWRKDIR - local work directory name
; PSLOGFIL - log file name
;Output: PSRC - populated return code
;
;check parameters
I PSADDR="" S PSRC="0^no target server address" Q
I $G(PSWRKDIR)="" SET PSRC="0^no local work directory name" Q
I $G(PSLOGFIL)="" S PSRC="0^no log file name" Q
;
; Execute ping, create logfile
N PSZFRC
S PSZFRC=$ZF(-1,"ping "_PSADDR_">"_PSWRKDIR_PSLOGFIL)
; Error check
I PSZFRC=-1 S PSRC="0^Windows OS command execution failed" Q
;
; Read Logfile into working global, check for error
K ^TMP("PSNPINGLOG",$J)
N PSXLOG
S PSXLOG=$$FTG^%ZISH(PSWRKDIR,PSLOGFIL,$NAME(^TMP("PSNPINGLOG",$J,1)),3)
N PSPNG,PSPNG1
S PSPNG="",PSPNG1=0
F S PSPNG=$O(^TMP("PSNPINGLOG",$J,PSPNG)) Q:PSPNG="" D
. S PSPNG1=$G(^TMP("PSNPINGLOG",$J,PSPNG))
. I PSPNG1["Received = 0" S PSRC="0^Remote server - "_PSADDR_" - did not respond"
;
Q
MAILFTP(PSMSGTYP,PSFILE,PSSIZE,PSERRMSG) ; mail message to notify users of the NDF Update File download status
;Inputs: PSMSGTYP - message type - 1=file downloaded, 0=error
; PSFILE - file name
; PSSIZE - file size
; PSERRMSG - error message
;
N XMDUZ,XMSUB,XMTEXT,XMY,XMZ,PSMSGTXT,PSGRP
I PSERRMSG'="" D UPDTCTRL D
. N CTRLIEN,CTRLXIEN
. S CTRLIEN=$O(^PS(57.23,"B","PPSN",""))
. S CTRLXIEN=$O(^PS(57.23,1,4,"B",PSREMFIL,""),-1)
. S FDA(57.234,CTRLXIEN_","_"1,",4)=PSERRMSG
. D UPDATE^DIE("","FDA","CTRLIEN")
;
;SETUP PRODUCTION OR SQA
S PSNPS=$P($G(^PS(59.7,1,10)),"^",12)
S XMSUB="",XMDUZ="noreply@domain.ext"
I PSMSGTYP D
. ;I PSNPS'="" I PSNPS="P"!(PSNPS="S")!(PSNPS="T")
. S XMSUB="PPS-N/NDF File "_PSFILE_$S(PSSIZE="":"was not",1:"")_" DOWNLOADED"
. I PSNPS'="" I PSNPS="Q" S XMSUB="PPS-N/NDF File "_PSFILE_$S(PSSIZE="":"was not",1:"")_" DOWNLOADED FOR QA"
. I PSSIZE="" D MSGTEXT0(PSFILE,PSSIZE,"File could not be downloaded.") Q
. D MSGTEXT1(PSFILE,PSSIZE,.PSMSGTXT)
I 'PSMSGTYP D
. S XMSUB="ERROR: PPS-N/NDF File "_PSFILE_" "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
. D MSGTEXT0(PSFILE,PSERRMSG,.PSMSGTXT)
S XMTEXT="PSMSGTXT("
S DA=0 F S DA=$O(^XUSEC("PSNMGR",DA)) Q:'DA S XMY(DA)=""
S PSGRP=$$GET1^DIQ(57.23,1,5) I PSGRP'="" S XMY($$MG^PSNPPSMG(PSGRP))="" ;PRIMARY PPS-N MAIL GROUP
S PSGRP="",PSGRP=$$GET1^DIQ(57.23,1,6) I PSGRP'="" S XMY($$MG^PSNPPSMG(PSGRP))="" ;SECONDARY MAIL GROUP
D ^XMD
Q
;
MSGTEXT0(PSFILE,PSERRMSG,PSMSGTXT) ;build message text
;Inputs: PSFILE - file name
; PSERRMSG - error message
; PSMSGTXT - array reference for message text
;Output: populated PSMSGTXT
;
S PSMSGTXT(1)="**************************************************************************"
S PSMSGTXT(2)="*** An error occurred during download of the following Update file(s): ***"
S PSMSGTXT(3)="**************************************************************************"
S PSMSGTXT(4)="The following file(s) could not be downloaded:"
S PSMSGTXT(5)=""
S PSMSGTXT(6)=" Update file Name"
S PSMSGTXT(7)=" -------------------"
S PSMSGTXT(8)=" "_PSFILE
S PSMSGTXT(9)=""
S PSMSGTXT(10)="An error occurred for:"
S PSMSGTXT(11)=" File: "
S PSMSGTXT(12)=" IEN: "
S PSMSGTXT(13)=" Entry Name: "
S PSMSGTXT(14)="Update file section: "
S PSMSGTXT(15)=""
S PSMSGTXT(16)="Error Message: "_PSERRMSG_"."
S PSMSGTXT(17)=""
S PSMSGTXT(18)="How to correct your error:"
S PSMSGTXT(19)="1. Validate that the PPS-N Site Parameters settings are correct."
S PSMSGTXT(20)="2. Validate that PRV version above is the version installed locally."
S PSMSGTXT(21)="3. Rerun the download option to re-attempt retrieval."
S PSMSGTXT(22)="4. Contact the National Help Desk or enter a ticket."
S PSMSGTXT(23)=""
S PSMSGTXT(24)="Further details can be found on the Download/Install Status Report option."
Q
;
MSGTEXT1(PSFILE,PSSIZE,PSMSGTXT) ;build message text
;Inputs: PSFILE - file name
; PSSIZE - file size
; PSMSGTXT - array reference for message text
;Output: populated PSMSGTXT
;
S PSMSGTXT(1)="The PPS-N/NDF file "_PSFILE_" (Size "_PSSIZE_$S(PSSIZE["MB":"",1:" bytes")_")"
S PSMSGTXT(2)="has been DOWNLOADED and is available for installation via the scheduled"
S PSMSGTXT(3)="or manual process utilized at your site. The following VistA options will"
S PSMSGTXT(4)="be placed out of order while the NDF Update file is installed: Print PMI"
S PSMSGTXT(5)="Sheet, Patient Prescription Processing, Release Medication, and Reprint"
S PSMSGTXT(6)="an Outpatient Rx label."
Q
;
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>> SFTP COMMANDS FILE <<<<<<<<<<<<<<<<<<<<<<<<<<
CREATDAT(PSRC,PSDATFIL,PSWRKDIR,PSREMDIR,PSREMFIL) ; create .dat file with sftp commands - "PSNSFTP.DAT"
N POP
D OPEN^%ZISH("FILE1",PSWRKDIR,PSDATFIL,"W")
I POP S PSRC="0^failed to open sftp .dat file" Q
D USE^%ZISUTL("FILE1")
W "cd ",PSREMDIR,!
I +PSOS'=3 W "ascii",!
W "get ",PSREMFIL,!
W "exit",!
D CLOSE^%ZISH("FILE1")
Q
;
DELFILES(PSDIR,PSFILES) ;Delete Local Host File, any OS
;Inputs: PSDIR - directory (path) name - in proper format of OS, including trailing / or \
; PSFILES - array of file names, by reference
; Ex: PSFILES("FILE1.DAT")=""
;Returns:
; 1-Success for all deletions.
; 0-Failure on at least one deletion.
;
N PSRC
S PSRC=$$DEL^%ZISH(PSDIR,$NAME(PSFILES))
Q PSRC
;
LINUXDEL(PSRC,PSDIR,PSFILE) ;Delete Local Host File
;Inputs: PSRC - return code, by reference
; PSDIR - directory name
; PSFILE - file name
;Output: PSRC - populated return code
;
;check parameters
I $G(PSDIR)="" S PSRC="0^no directory name" Q
I $G(PSFILE)="" S PSRC="0^no file name" Q
S PSZFRC=$ZF(-1,"rm -f "_PSDIR_PSFILE)
I PSZFRC=-1 S PSRC="0^Linux OS command execution failed" Q
Q
;
GETD() ; get the right directory based on OS type
N CDIR,PSOSX S CDIR=""
S PSOSX=$$OS^%ZOSV()
I PSOSX["VMS" S CDIR=$$GET1^DIQ(57.23,1,1)
I PSOSX["UNIX" S CDIR=$$GET1^DIQ(57.23,1,3)
Q CDIR
;
UPDTCTRL ;
K CTRLIEN S CTRLIEN=$O(^PS(57.23,"B","PPSN",""))
K FDA S FDA(57.234,"+2,"_1_",",.01)=PSREMFIL D UPDATE^DIE("","FDA")
K CTRLXIEN S CTRLXIEN=$O(^PS(57.23,1,4,"B",PSREMFIL,""),-1)
K FDA S FDA(57.234,CTRLXIEN_","_CTRLIEN_",",1)=PSNDNLDB
D NOW^%DTC
S FDA(57.234,CTRLXIEN_","_CTRLIEN_",",2)=%
S FDA(57.234,CTRLXIEN_","_CTRLIEN_",",3)=PSSIZE
I $G(PSERRMSG)'="" S FDA(57.234,CTRLXIEN_","_CTRLIEN_",",4)=PSERRMSG
D UPDATE^DIE("","FDA","CTRLIEN")
S ^PS(57.23,1,4,"G",PSREMFIL)=$G(^PS(57.23,1,4,"G",PSREMFIL))+1
S ^PS(57.23,1,4,"G",PSREMFIL,CTRLXIEN)=$G(^PS(57.23,1,4,"G",PSREMFIL))
K FDA S FDA(57.23,CTRLIEN_",",30)=1 D FILE^DIE("","FDA") K FDA
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNFTP 17540 printed Nov 22, 2024@17:34:06 Page 2
PSNFTP ;HP/ART - PPS-N National Drug File Updates File Transfer ;09/25/2015
+1 ;;4.0;NATIONAL DRUG FILE;**513**; 30 Oct 98;Build 53
+2 ;Supported ICRs/IAs
+3 ;External reference to $$DECRYP^XUSRB1() supported by DBIA 2241
+4 ;External reference to ^%ZISH supported by DBIA 2320
+5 ;External reference to USE^%ZISUTL supported by DBIA 2119
+6 ;External reference to $$OS^%ZOSV supported by DBIA 10097
+7 ;External reference to ^XLFDT supported by DBIA 10103
+8 ;External reference to ^XMD supported by DBIA 10070
+9 ;External reference to ^PS(59.7 supported by DBIA #2613
+10 ;External reference to ^XUSEC supported by DBIA #10076
+11 ;
+12 ;SAC Exemption For use of Cache function $ZF(-1, was granted 10/23/15 by SACC committee
+13 ;
EN ; Main Entry Point for PPS-N National Drug File Updates File Transfer
+1 ;If a scheduled job initiates the PSNSCJOB=1 will be defined.
+2 IF $$GET1^DIQ(57.23,1,9,"I")="Y"
QUIT
+3 ;
+4 NEW PSRC,PSOS,PSREMFIL,PSFILE,PSFFND,DIE,DA,DR,LOCDIR,PSUID,PSNDNLDB
+5 NEW PSPREV,PSLAST,PSNEW,PSERRMSG,PSSIZE,PSWRKDIR,PSOLDF,PSFDCNT,PSOS2,PRSC,PSNPS,PSOUNXLD,X,XPV
+6 DO NOW^%DTC
SET PSNDNLDB=%
+7 SET PSFFND=0
SET (PSFDCNT,PSRC)=1
+8 SET PSOS=$$GETOS
+9 SET (PSFILE,PSREMFIL,PSOLDF)=""
+10 SET PSWRKDIR=$$GETD()
+11 IF PSOS["UNIX"
IF '$$DIREXIST^PSNFTP2(PSWRKDIR)
DO MAKEDIR^PSNFTP2(PSWRKDIR)
+12 KILL DIE,DA,DR
+13 SET DIE="^PS(57.23,"
SET DA=1
SET DR="9///Y"
DO ^DIE
KILL DIE,DA,DR
+14 FOR
Begin DoDot:1
+15 SET PSERRMSG(1)="0^RETRIEVAL VERSION in PPS-N UPDATE CONTROL (#57.23) file is not defined"
+16 ;last file downloaded
+17 SET PSLAST=$$GET1^DIQ(57.23,1,8)
+18 IF PSLAST=""
Begin DoDot:2
+19 SET PSRC=PSERRMSG(1)
+20 DO MAILFTP(0,"undeterminedFileName","",$PIECE(PSRC,U,2))
+21 WRITE "Determine remote file name failed ",PSOS," rc=",PSRC,!
End DoDot:2
QUIT
+22 ;
+23 SET PSNEW=PSLAST+1
+24 SET (PSFILE,PSREMFIL)="PPS_"_PSLAST_"PRV_"_PSNEW_"NEW.DAT"
+25 IF PSFDCNT=1
SET PSOLDF=PSFILE
+26 SET PSFDCNT=PSFDCNT+1
+27 IF 'PSFFND
WRITE !!,"Beginning download for Update file name: ",PSREMFIL
+28 IF PSFFND
WRITE !!,"Continuing with the next file sequence. Attempting download",!," for: "_PSREMFIL
+29 WRITE !!
+30 ;ping the remote server
+31 DO PING(.PSRC,PSOS)
+32 USE 0
+33 IF '+PSRC
Begin DoDot:2
+34 DO MAILFTP(0,PSREMFIL,"",$PIECE(PSRC,U,2))
WRITE "Server ping failed ",PSOS," rc=",PSRC,!
End DoDot:2
QUIT
+35 WRITE "Server ping successful ",PSOS," rc=",PSRC,!
+36 SET PSOS2=""
SET PSOS2=$SELECT(PSOS["VMS":"VMS",PSOS["UNIX":"LINIX",1:"LINUX")_"DEL"
+37 IF PSOS["VMS"
Begin DoDot:2
+38 ;D @PSOS2^PSNFTP2(PSRC,PSWRKDIR,"PSNPING.COM")
+39 ;D @PSOS2^PSNFTP2(PSRC,PSWRKDIR,"PSNPING.LOG")
End DoDot:2
+40 ;
+41 IF PSOS["LINIX"
Begin DoDot:2
+42 DO @PSOS2^PSNFTP2(PSRC,PSWRKDIR,"PSNPING.LOG")
End DoDot:2
+43 ;
+44 ;transfer a file
+45 SET PSRC=PSERRMSG(1)
+46 DO FTP(.PSRC,PSOS,PSREMFIL,.PSERRMSG)
+47 USE 0
+48 IF +PSOS=1
Begin DoDot:2
+49 ;D VMSDEL^PSNFTP2(PSRC,PSWRKDIR,"PSNFTP.COM")
+50 ;D VMSDEL^PSNFTP2(PSRC,PSWRKDIR,"PSNFTP.LOG")
+51 ;D VMSDEL^PSNFTP2(PSRC,PSWRKDIR,"PSNSFTP.DAT")
End DoDot:2
+52 IF +PSOS=3
Begin DoDot:2
+53 DO LINUXDEL(PSRC,PSWRKDIR,"PSNFTP.sh")
+54 DO LINUXDEL(PSRC,PSWRKDIR,"PSNFTP.LOG")
+55 DO LINUXDEL(PSRC,PSWRKDIR,"PSNSFTP.DAT")
+56 DO LINUXDEL(PSRC,PSWRKDIR,"PSNPING.LOG")
End DoDot:2
+57 ;
+58 IF +PSRC=0&(PSFFND)
Begin DoDot:2
+59 WRITE !!,PSREMFIL_" does not exist.",!!,"PPS-N/NDF Download process is complete.",!
End DoDot:2
QUIT
+60 ;
+61 IF +PSRC=0&('PSFFND)
Begin DoDot:2
+62 DO MAILFTP(0,PSREMFIL,"",$PIECE(PSRC,U,2))
+63 if PSOLDF=PSREMFIL
QUIT
+64 WRITE "file transfer failed ",PSOS," rc=",PSRC,!
End DoDot:2
QUIT
+65 ;
+66 IF +PSRC=-1&('PSFFND)
Begin DoDot:2
+67 DO MAILFTP(0,PSREMFIL,"",$PIECE(PSRC,U,2))
+68 if PSOLDF=PSREMFIL
QUIT
+69 WRITE "remote file not found ",PSOS," rc=",PSRC,!
End DoDot:2
QUIT
+70 ;
+71 ;update PPS-N UPDATE CONTROL:RETRIEVAL VERSION (#57.23:8)
+72 IF +PSRC=1
WRITE "file transfer successful ",PSOS," rc=",PSRC,!
+73 if +PSRC'=1
QUIT
+74 SET PSFFND=1
+75 KILL DIE,DA,DR
+76 SET DIE="^PS(57.23,"
SET DA=1
SET DR="8///"_PSNEW
DO ^DIE
KILL DIE,DA,DR
+77 SET PSSIZE=""
+78 ;
+79 ;**VMS file size
+80 IF +PSOS=1
DO FILSIZE^PSNFTP2(PSWRKDIR,PSFILE,.PSSIZE,"")
+81 ;
+82 ;**linux file size
+83 IF +PSOS=3
Begin DoDot:2
+84 SET XPV="S PV=$ZF(-1,""stat -c%s "_PSWRKDIR_PSFILE_">"_PSWRKDIR_"PSNSIZE.DAT"")"
+85 XECUTE XPV
+86 SET PSXLOG=""
SET PSXLOG=$$FTG^%ZISH(PSWRKDIR,"PSNSIZE.DAT",$NAME(^TMP("PSNFSIZELOG",$JOB,1)),3)
+87 IF $DATA(^TMP("PSNFSIZELOG",$JOB,1))
SET PSSIZE=^TMP("PSNFSIZELOG",$JOB,1)
End DoDot:2
+88 ;
+89 DO MAILFTP(1,PSFILE,PSSIZE,"")
DO DELFILES^PSNFTP2(PSWRKDIR)
+90 WRITE !!,"Completed download for: ",PSREMFIL,!!
+91 DO UPDTCTRL
+92 SET PRSC=0
End DoDot:1
if +PSRC<1
QUIT
+93 KILL DIE,DA,DR
+94 SET DIE="^PS(57.23,"
SET DA=1
SET DR="9///N"
DO ^DIE
KILL DIE,DA,DR
+95 DO NOW^%DTC
SET DIE="^PS(57.23,1,4,"
SET DA=1
SET DR="3///"_%
DO ^DIE
KILL DIE,DA,DR
+96 KILL DIE,DA,DR
+97 QUIT
+98 ;
PING(PSRC,PSOS) ; Check for availability of server (ping)
+1 ;Inputs: PSRC - reference to return code
+2 ; PSOS - current OS
+3 ;Output: PSRC - populated return code
+4 ;
+5 NEW PSERRMSG,PSADDR,PSCOMFIL,PSLOGFIL,PSFILES
+6 SET PSERRMSG(1)="0^Remote Server Address in the PPS-N Site Parameters is not defined or invalid"
+7 SET PSERRMSG(2)="0^"_$SELECT($$GETOS["VMS":"VMS",$$GETOS["LINUX":"Unix/Linux",1:"")_" Local Directory in the PPS-N Site Parameters is not defined or invalid"
+8 ;S PSERRMSG(2)="0^Local Directory in the PPS-N Site Parameters is not defined or invalid"
+9 SET PSRC=1
+10 SET PSADDR=$$GET1^DIQ(57.23,1,20)
IF PSADDR=""
SET PSRC=PSERRMSG(1)
QUIT
+11 ;S PSWRKDIR="USER$:[SFTP.PPSN]"
+12 SET PSWRKDIR=$$GETD()
IF PSWRKDIR=""
SET PSRC=PSERRMSG(2)
QUIT
+13 SET PSCOMFIL="PSNPING.COM"
+14 SET PSLOGFIL="PSNPING.LOG"
+15 ;
+16 ;VMS
+17 IF +PSOS=1
Begin DoDot:1
+18 DO VMSPING(.PSRC,PSADDR,PSWRKDIR,PSCOMFIL,PSLOGFIL)
+19 SET PSFILES(PSCOMFIL)=""
+20 IF '$$DELFILES(PSWRKDIR,.PSFILES)
WRITE !,"File cleanup/delete failed.",!
End DoDot:1
+21 ;
+22 ;Linux
+23 IF +PSOS=3
DO LINXPING(.PSRC,PSADDR,PSWRKDIR,PSLOGFIL)
+24 ;
+25 ;Windows
+26 IF +PSOS=2
DO WINPING(.PSRC,PSADDR,PSWRKDIR,PSLOGFIL)
+27 QUIT
+28 ;
FTP(PSRC,PSOS,PSREMFIL,PSERRMSG) ; ftp (get) a file
+1 ;Inputs: PSRC - reference to return code
+2 ; PSOS - current OS
+3 ; PSREMFIL - remote file name
+4 ;Output: PSRC - populated return code
+5 ;
+6 NEW PSADDR,PSNUSER,PSREMDIR,PSCOMFIL,PSSHFILE
+7 NEW PSLOCDIR,PSCMDFIL,PSLOGFIL,PSDATFIL
+8 SET PSERRMSG(1)="0^REMOTE SERVER ADDRESS in PPS-N UPDATE CONTROL (#57.23) file is not defined"
+9 SET PSERRMSG(2)="0^REMOTE SFTP USER ID in PPS-N UPDATE CONTROL (#57.23) file is not defined"
+10 SET PSERRMSG(3)="0^PRIMARY HFS DIRECTORY in KERNEL SYSTEM PARAMETERS (#8989.3) file is not defined"
+11 SET PSERRMSG(4)="0^DIRECTORY PATH in PPS-N UPDATE CONTROL (#57.23) file is not defined"
+12 SET PSERRMSG(5)="0^REMOTE DIRECTORY ACCESS in PPS-N UPDATE CONTROL (#57.23) file is not defined"
+13 SET PSRC=1
+14 SET PSADDR=$$GET1^DIQ(57.23,1,20)
IF PSADDR=""
SET PSRC=PSERRMSG(1)
QUIT
+15 SET PSNUSER=$$GET1^DIQ(57.23,1,22)
IF PSNUSER=""
SET PSRC=PSERRMSG(2)
QUIT
+16 SET PSWRKDIR=$$GETD()
IF PSWRKDIR=""
SET PSRC=PSERRMSG(3)
QUIT
+17 SET PSLOCDIR=$$GETD()
IF PSLOCDIR=""
SET PSRC=PSERRMSG(4)
QUIT
+18 SET PSREMDIR=$$GET1^DIQ(57.23,1,21)
IF PSREMDIR=""
SET PSRC=PSERRMSG(5)
QUIT
+19 SET PSCOMFIL="PSNFTP.COM"
+20 SET PSSHFILE="PSNFTP.sh"
+21 SET PSCMDFIL="PSNFTPCMDS.txt"
+22 SET PSLOGFIL="PSNFTP.LOG"
+23 SET PSDATFIL="PSNSFTP.DAT"
+24 DO SAVEKEYS^PSNFTP2(PSWRKDIR)
+25 ;
+26 ;VMS
+27 IF +PSOS=1
Begin DoDot:1
+28 DO VMSFTP^PSNFTP2(.PSRC,PSADDR,PSNUSER,PSWRKDIR,PSLOCDIR,PSREMDIR,PSREMFIL,PSCOMFIL,PSLOGFIL,PSDATFIL,.PSERRMSG)
+29 SET PSFILES(PSCOMFIL)=""
SET PSFILES("VSSHID.")=""
SET PSFILES("VSSHKEY.")=""
SET PSFILES("VSSHKEY.PUB")=""
+30 IF '$$DELFILES(PSWRKDIR,.PSFILES)
WRITE !,"File cleanup/delete failed.",!
End DoDot:1
+31 ;
+32 ;Linux
+33 IF +PSOS=3
Begin DoDot:1
+34 ; chop off trailing /
SET PSLOCDIR=$EXTRACT(PSLOCDIR,1,($LENGTH(PSLOCDIR)-1))
+35 DO LINUXFTP^PSNFTP2(.PSRC,PSADDR,PSNUSER,PSWRKDIR,PSLOCDIR,PSREMDIR,PSREMFIL,PSSHFILE,PSLOGFIL,PSDATFIL)
+36 SET PSFILES(PSSHFILE)=""
SET PSFILES("VSSHKEY")=""
SET PSFILES("uxsshkey")=""
+37 IF '$$DELFILES(PSWRKDIR,.PSFILES)
WRITE !,"File cleanup/delete failed.",!
End DoDot:1
+38 ;
+39 ;Windows
+40 IF +PSOS=2
Begin DoDot:1
+41 ; chop off trailing \
SET PSLOCDIR=$EXTRACT(PSLOCDIR,1,($LENGTH(PSLOCDIR)-1))
+42 DO WINFTP^PSNFTP2(.PSRC,PSADDR,PSUID,PSWRKDIR,PSLOCDIR,PSREMDIR,PSREMFIL,PSCMDFIL,PSLOGFIL)
+43 SET PSFILES(PSCMDFIL)=""
+44 IF '$$DELFILES(PSWRKDIR,.PSFILES)
WRITE !,"File cleanup/delete failed.",!
End DoDot:1
+45 QUIT
+46 ;
GETOS() ;Determine OS
+1 ;Returns: PSOS - local OS
+2 NEW PSOS
SET PSOS=$$OS^%ZOSV()
+3 SET PSOS=$SELECT(PSOS["VMS":"1-VMS",PSOS["NT":"2-MSW",PSOS["UNIX":"3-LINUX",1:"0-")
+4 QUIT PSOS
+5 ;
VMSPING(PSRC,PSADDR,PSWRKDIR,PSCOMFIL,PSLOGFIL) ; PING VMS server to ensure it is available
+1 ;Inputs: PSRC - return code, by reference
+2 ; PSADDR - remote server address
+3 ; PSWRKDIR - local work directory name
+4 ; PSCOMFIL - .com file name
+5 ; PSLOGFIL - log file name
+6 ;Output: PSRC - populated return code
+7 ;
+8 ;check parameters
+9 IF $GET(PSADDR)=""
SET PSRC="0^no target server address"
QUIT
+10 IF $GET(PSWRKDIR)=""
SET PSRC="0^no local work directory name"
QUIT
+11 IF $GET(PSCOMFIL)=""
SET PSRC="0^no .com file name"
QUIT
+12 IF $GET(PSLOGFIL)=""
SET PSRC="0^no log file name"
QUIT
+13 ; Create .COM file
+14 NEW POP
+15 DO OPEN^%ZISH("FILE1",PSWRKDIR,PSCOMFIL,"W")
+16 IF POP
SET PSRC="0^failed to open ping .com file"
QUIT
+17 DO USE^%ZISUTL("FILE1")
+18 WRITE "$ SET VERIFY=(PROCEDURE,IMAGE)",!
+19 WRITE "$ SET DEFAULT "_PSWRKDIR,!
+20 WRITE "$ TCPIP",!
+21 WRITE "PING "_PSADDR,!
+22 WRITE "EXIT",!
+23 WRITE "$ EXIT 3",!
+24 DO CLOSE^%ZISH("FILE1")
+25 ; Execute .COM file, create logfile
+26 NEW PSZFRC
+27 SET PSZFRC=$ZF(-1,"@"_PSWRKDIR_PSCOMFIL_"/OUTPUT="_PSWRKDIR_PSLOGFIL)
+28 ; Error check
+29 IF PSZFRC=-1
SET PSRC="0^VMS OS command execution failed"
QUIT
+30 ; Read Logfile into working global, check for error
+31 KILL ^TMP("PSNPINGLOG",$JOB)
+32 NEW PSXLOG,PSPNG,PSPNG1
+33 SET PSXLOG=$$FTG^%ZISH(PSWRKDIR,PSLOGFIL,$NAME(^TMP("PSNPINGLOG",$JOB,1)),3)
+34 SET PSPNG=""
SET PSPNG1=0
+35 FOR
SET PSPNG=$ORDER(^TMP("PSNPINGLOG",$JOB,PSPNG))
if PSPNG=""
QUIT
Begin DoDot:1
+36 SET PSPNG1=$GET(^TMP("PSNPINGLOG",$JOB,PSPNG))
+37 IF PSPNG1["0 packets received"
SET PSRC="0^Remote server - "_PSADDR_" - did not respond"
+38 IF PSPNG1["%SYSTEM"
SET PSRC="0^Remote server - "_PSADDR_" - did not respond"
End DoDot:1
+39 DO DELFILES^PSNFTP2($GET(PSWRKDIR),$GET(PSLOGFIL),$GET(PSCOMFIL),"")
+40 QUIT
+41 ;
LINXPING(PSRC,PSADDR,PSWRKDIR,PSLOGFIL) ; PING Unix/Linux server to ensure it is available
+1 ;Inputs: PSRC - return code, by reference
+2 ; PSADDR - remote server address
+3 ; PSWRKDIR - local work directory name
+4 ; PSLOGFIL - log file name
+5 ;Output: PSRC - populated return code
+6 ;
+7 ;check parameters
+8 IF PSADDR=""
SET PSRC="0^no target server address"
QUIT
+9 IF $GET(PSWRKDIR)=""
SET PSRC="0^no local work directory name"
QUIT
+10 IF $GET(PSLOGFIL)=""
SET PSRC="0^no log file name"
QUIT
+11 ; Execute ping, create logfile
+12 NEW PSZFRC
+13 SET PSZFRC=$ZF(-1,"ping -c 4 "_PSADDR_">"_PSWRKDIR_PSLOGFIL)
+14 ; Error check
+15 IF PSZFRC=-1
SET PSRC="0^Linux OS command execution failed"
QUIT
+16 ; Read Logfile into working global, check for error
+17 KILL ^TMP("PSNPINGLOG",$JOB)
+18 NEW PSXLOG,PSPNG,PSPNG1
SET PSPNG=""
SET PSPNG1=0
+19 SET PSXLOG=$$FTG^%ZISH(PSWRKDIR,PSLOGFIL,$NAME(^TMP("PSNPINGLOG",$JOB,1)),3)
+20 FOR
SET PSPNG=$ORDER(^TMP("PSNPINGLOG",$JOB,PSPNG))
if PSPNG=""
QUIT
Begin DoDot:1
+21 SET PSPNG1=$GET(^TMP("PSNPINGLOG",$JOB,PSPNG))
+22 IF PSPNG1["0 received"
SET PSRC="0^Remote server - "_PSADDR_" - did not respond"
End DoDot:1
+23 ;D DELFILES^PSNFTP2($G(PSWRKDIR),$G(PSLOGFIL))
+24 QUIT
WINPING(PSRC,PSADDR,PSWRKDIR,PSLOGFIL) ; PING server to ensure it is available
+1 ;Inputs: PSRC - return code, by reference
+2 ; PSADDR - remote server address
+3 ; PSWRKDIR - local work directory name
+4 ; PSLOGFIL - log file name
+5 ;Output: PSRC - populated return code
+6 ;
+7 ;check parameters
+8 IF PSADDR=""
SET PSRC="0^no target server address"
QUIT
+9 IF $GET(PSWRKDIR)=""
SET PSRC="0^no local work directory name"
QUIT
+10 IF $GET(PSLOGFIL)=""
SET PSRC="0^no log file name"
QUIT
+11 ;
+12 ; Execute ping, create logfile
+13 NEW PSZFRC
+14 SET PSZFRC=$ZF(-1,"ping "_PSADDR_">"_PSWRKDIR_PSLOGFIL)
+15 ; Error check
+16 IF PSZFRC=-1
SET PSRC="0^Windows OS command execution failed"
QUIT
+17 ;
+18 ; Read Logfile into working global, check for error
+19 KILL ^TMP("PSNPINGLOG",$JOB)
+20 NEW PSXLOG
+21 SET PSXLOG=$$FTG^%ZISH(PSWRKDIR,PSLOGFIL,$NAME(^TMP("PSNPINGLOG",$JOB,1)),3)
+22 NEW PSPNG,PSPNG1
+23 SET PSPNG=""
SET PSPNG1=0
+24 FOR
SET PSPNG=$ORDER(^TMP("PSNPINGLOG",$JOB,PSPNG))
if PSPNG=""
QUIT
Begin DoDot:1
+25 SET PSPNG1=$GET(^TMP("PSNPINGLOG",$JOB,PSPNG))
+26 IF PSPNG1["Received = 0"
SET PSRC="0^Remote server - "_PSADDR_" - did not respond"
End DoDot:1
+27 ;
+28 QUIT
MAILFTP(PSMSGTYP,PSFILE,PSSIZE,PSERRMSG) ; mail message to notify users of the NDF Update File download status
+1 ;Inputs: PSMSGTYP - message type - 1=file downloaded, 0=error
+2 ; PSFILE - file name
+3 ; PSSIZE - file size
+4 ; PSERRMSG - error message
+5 ;
+6 NEW XMDUZ,XMSUB,XMTEXT,XMY,XMZ,PSMSGTXT,PSGRP
+7 IF PSERRMSG'=""
DO UPDTCTRL
Begin DoDot:1
+8 NEW CTRLIEN,CTRLXIEN
+9 SET CTRLIEN=$ORDER(^PS(57.23,"B","PPSN",""))
+10 SET CTRLXIEN=$ORDER(^PS(57.23,1,4,"B",PSREMFIL,""),-1)
+11 SET FDA(57.234,CTRLXIEN_","_"1,",4)=PSERRMSG
+12 DO UPDATE^DIE("","FDA","CTRLIEN")
End DoDot:1
+13 ;
+14 ;SETUP PRODUCTION OR SQA
+15 SET PSNPS=$PIECE($GET(^PS(59.7,1,10)),"^",12)
+16 SET XMSUB=""
SET XMDUZ="noreply@domain.ext"
+17 IF PSMSGTYP
Begin DoDot:1
+18 ;I PSNPS'="" I PSNPS="P"!(PSNPS="S")!(PSNPS="T")
+19 SET XMSUB="PPS-N/NDF File "_PSFILE_$SELECT(PSSIZE="":"was not",1:"")_" DOWNLOADED"
+20 IF PSNPS'=""
IF PSNPS="Q"
SET XMSUB="PPS-N/NDF File "_PSFILE_$SELECT(PSSIZE="":"was not",1:"")_" DOWNLOADED FOR QA"
+21 IF PSSIZE=""
DO MSGTEXT0(PSFILE,PSSIZE,"File could not be downloaded.")
QUIT
+22 DO MSGTEXT1(PSFILE,PSSIZE,.PSMSGTXT)
End DoDot:1
+23 IF 'PSMSGTYP
Begin DoDot:1
+24 SET XMSUB="ERROR: PPS-N/NDF File "_PSFILE_" "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
+25 DO MSGTEXT0(PSFILE,PSERRMSG,.PSMSGTXT)
End DoDot:1
+26 SET XMTEXT="PSMSGTXT("
+27 SET DA=0
FOR
SET DA=$ORDER(^XUSEC("PSNMGR",DA))
if 'DA
QUIT
SET XMY(DA)=""
+28 ;PRIMARY PPS-N MAIL GROUP
SET PSGRP=$$GET1^DIQ(57.23,1,5)
IF PSGRP'=""
SET XMY($$MG^PSNPPSMG(PSGRP))=""
+29 ;SECONDARY MAIL GROUP
SET PSGRP=""
SET PSGRP=$$GET1^DIQ(57.23,1,6)
IF PSGRP'=""
SET XMY($$MG^PSNPPSMG(PSGRP))=""
+30 DO ^XMD
+31 QUIT
+32 ;
MSGTEXT0(PSFILE,PSERRMSG,PSMSGTXT) ;build message text
+1 ;Inputs: PSFILE - file name
+2 ; PSERRMSG - error message
+3 ; PSMSGTXT - array reference for message text
+4 ;Output: populated PSMSGTXT
+5 ;
+6 SET PSMSGTXT(1)="**************************************************************************"
+7 SET PSMSGTXT(2)="*** An error occurred during download of the following Update file(s): ***"
+8 SET PSMSGTXT(3)="**************************************************************************"
+9 SET PSMSGTXT(4)="The following file(s) could not be downloaded:"
+10 SET PSMSGTXT(5)=""
+11 SET PSMSGTXT(6)=" Update file Name"
+12 SET PSMSGTXT(7)=" -------------------"
+13 SET PSMSGTXT(8)=" "_PSFILE
+14 SET PSMSGTXT(9)=""
+15 SET PSMSGTXT(10)="An error occurred for:"
+16 SET PSMSGTXT(11)=" File: "
+17 SET PSMSGTXT(12)=" IEN: "
+18 SET PSMSGTXT(13)=" Entry Name: "
+19 SET PSMSGTXT(14)="Update file section: "
+20 SET PSMSGTXT(15)=""
+21 SET PSMSGTXT(16)="Error Message: "_PSERRMSG_"."
+22 SET PSMSGTXT(17)=""
+23 SET PSMSGTXT(18)="How to correct your error:"
+24 SET PSMSGTXT(19)="1. Validate that the PPS-N Site Parameters settings are correct."
+25 SET PSMSGTXT(20)="2. Validate that PRV version above is the version installed locally."
+26 SET PSMSGTXT(21)="3. Rerun the download option to re-attempt retrieval."
+27 SET PSMSGTXT(22)="4. Contact the National Help Desk or enter a ticket."
+28 SET PSMSGTXT(23)=""
+29 SET PSMSGTXT(24)="Further details can be found on the Download/Install Status Report option."
+30 QUIT
+31 ;
MSGTEXT1(PSFILE,PSSIZE,PSMSGTXT) ;build message text
+1 ;Inputs: PSFILE - file name
+2 ; PSSIZE - file size
+3 ; PSMSGTXT - array reference for message text
+4 ;Output: populated PSMSGTXT
+5 ;
+6 SET PSMSGTXT(1)="The PPS-N/NDF file "_PSFILE_" (Size "_PSSIZE_$SELECT(PSSIZE["MB":"",1:" bytes")_")"
+7 SET PSMSGTXT(2)="has been DOWNLOADED and is available for installation via the scheduled"
+8 SET PSMSGTXT(3)="or manual process utilized at your site. The following VistA options will"
+9 SET PSMSGTXT(4)="be placed out of order while the NDF Update file is installed: Print PMI"
+10 SET PSMSGTXT(5)="Sheet, Patient Prescription Processing, Release Medication, and Reprint"
+11 SET PSMSGTXT(6)="an Outpatient Rx label."
+12 QUIT
+13 ;
+14 ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>> SFTP COMMANDS FILE <<<<<<<<<<<<<<<<<<<<<<<<<<
CREATDAT(PSRC,PSDATFIL,PSWRKDIR,PSREMDIR,PSREMFIL) ; create .dat file with sftp commands - "PSNSFTP.DAT"
+1 NEW POP
+2 DO OPEN^%ZISH("FILE1",PSWRKDIR,PSDATFIL,"W")
+3 IF POP
SET PSRC="0^failed to open sftp .dat file"
QUIT
+4 DO USE^%ZISUTL("FILE1")
+5 WRITE "cd ",PSREMDIR,!
+6 IF +PSOS'=3
WRITE "ascii",!
+7 WRITE "get ",PSREMFIL,!
+8 WRITE "exit",!
+9 DO CLOSE^%ZISH("FILE1")
+10 QUIT
+11 ;
DELFILES(PSDIR,PSFILES) ;Delete Local Host File, any OS
+1 ;Inputs: PSDIR - directory (path) name - in proper format of OS, including trailing / or \
+2 ; PSFILES - array of file names, by reference
+3 ; Ex: PSFILES("FILE1.DAT")=""
+4 ;Returns:
+5 ; 1-Success for all deletions.
+6 ; 0-Failure on at least one deletion.
+7 ;
+8 NEW PSRC
+9 SET PSRC=$$DEL^%ZISH(PSDIR,$NAME(PSFILES))
+10 QUIT PSRC
+11 ;
LINUXDEL(PSRC,PSDIR,PSFILE) ;Delete Local Host File
+1 ;Inputs: PSRC - return code, by reference
+2 ; PSDIR - directory name
+3 ; PSFILE - file name
+4 ;Output: PSRC - populated return code
+5 ;
+6 ;check parameters
+7 IF $GET(PSDIR)=""
SET PSRC="0^no directory name"
QUIT
+8 IF $GET(PSFILE)=""
SET PSRC="0^no file name"
QUIT
+9 SET PSZFRC=$ZF(-1,"rm -f "_PSDIR_PSFILE)
+10 IF PSZFRC=-1
SET PSRC="0^Linux OS command execution failed"
QUIT
+11 QUIT
+12 ;
GETD() ; get the right directory based on OS type
+1 NEW CDIR,PSOSX
SET CDIR=""
+2 SET PSOSX=$$OS^%ZOSV()
+3 IF PSOSX["VMS"
SET CDIR=$$GET1^DIQ(57.23,1,1)
+4 IF PSOSX["UNIX"
SET CDIR=$$GET1^DIQ(57.23,1,3)
+5 QUIT CDIR
+6 ;
UPDTCTRL ;
+1 KILL CTRLIEN
SET CTRLIEN=$ORDER(^PS(57.23,"B","PPSN",""))
+2 KILL FDA
SET FDA(57.234,"+2,"_1_",",.01)=PSREMFIL
DO UPDATE^DIE("","FDA")
+3 KILL CTRLXIEN
SET CTRLXIEN=$ORDER(^PS(57.23,1,4,"B",PSREMFIL,""),-1)
+4 KILL FDA
SET FDA(57.234,CTRLXIEN_","_CTRLIEN_",",1)=PSNDNLDB
+5 DO NOW^%DTC
+6 SET FDA(57.234,CTRLXIEN_","_CTRLIEN_",",2)=%
+7 SET FDA(57.234,CTRLXIEN_","_CTRLIEN_",",3)=PSSIZE
+8 IF $GET(PSERRMSG)'=""
SET FDA(57.234,CTRLXIEN_","_CTRLIEN_",",4)=PSERRMSG
+9 DO UPDATE^DIE("","FDA","CTRLIEN")
+10 SET ^PS(57.23,1,4,"G",PSREMFIL)=$GET(^PS(57.23,1,4,"G",PSREMFIL))+1
+11 SET ^PS(57.23,1,4,"G",PSREMFIL,CTRLXIEN)=$GET(^PS(57.23,1,4,"G",PSREMFIL))
+12 KILL FDA
SET FDA(57.23,CTRLIEN_",",30)=1
DO FILE^DIE("","FDA")
KILL FDA
+13 QUIT
+14 ;
