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

PSOSPMU1.m

Go to the documentation of this file.
  1. PSOSPMU1 ;BIRM/MFR - State Prescription Monitoring Program Utilities ;10/07/12
  1. ;;7.0;OUTPATIENT PHARMACY;**408,437,451,625,630,662,696,746**;DEC 1997;Build 106
  1. ;
  1. GATHER(STATE,BEGDTTM,ENDDTTM,RECTYPE,RTSONLY,LIST) ; Gathers all CS prescriptions for Data Range
  1. ;Input: STATE - Pointer to the STATE file (#5)
  1. ; BEGDTTM - Date Range Begin Date/Time
  1. ; ENDDTTM - Date Range End Date/Time
  1. ; RECTYPE - Record Type for Released Rx's only (N: New / R: Revise)
  1. ; RTSONLY - Return To Stock Fills Only (1: YES / 0: NO)
  1. ; LIST - List of Filter(s) to be screened (LIST="PR" or "DR" or "PA" or "NC" or "RX", LIST(PROV IEN) or (LIST(PAT IEN) or LIST(RXIEN,FILL)
  1. ;Output: $$GATHER - Number of Rx's found
  1. ; ^TMP("PSOSPMRX",$J,STATE,RX,FILL)=Record Type (N/R/V) - List of Rx's gathered
  1. ; ^TMP("PSOSPMST",$J,$$RXSITE^PSOBPSUT(RXIEN,0))="" Zero Report - saving SITEs with RXs
  1. N GATHER,XREF,RXRLDT,RXIEN,RXFILL,FILL,RTSDT,ENDRTSDT
  1. S GATHER=0 K ^TMP("PSOSPMRX",$J),^TMP("PSOSPMST",$J) ;adding for Zero Report
  1. I '$D(LIST) S LIST="NC" ; send all Rxs for a date range if no other criteria
  1. ; - Gathering Released Original Fills/Refills/Partials
  1. I '$G(RTSONLY) D
  1. . F XREF="AL","AM" D
  1. . . S RXRLDT=BEGDTTM,ENDRLDT=ENDDTTM S:'$P(ENDRLDT,".",2) ENDRLDT=ENDRLDT+.25
  1. . . F S RXRLDT=$O(^PSRX(XREF,RXRLDT)) Q:'RXRLDT!(RXRLDT>ENDRLDT) D
  1. . . . S RXIEN=0 F S RXIEN=$O(^PSRX(XREF,RXRLDT,RXIEN)) Q:'RXIEN D
  1. . . . . S RXFILL="" F S RXFILL=$O(^PSRX(XREF,RXRLDT,RXIEN,RXFILL)) Q:RXFILL="" D
  1. . . . . . S FILL=$S(XREF="AL":RXFILL,1:"P"_RXFILL)
  1. . . . . . I $$FILTER^PSOSPML7(.LIST,RXIEN,FILL) Q
  1. . . . . . I $$SCREEN^PSOSPMUT(RXIEN,FILL) Q
  1. . . . . . I $$RXSTATEZ^PSOBPSUT(RXIEN,0,STATE)=STATE S ^TMP("PSOSPMST",$J,$$RXSITE^PSOBPSUT(RXIEN,0))=""
  1. . . . . . I $$RXSTATEP^PSOBPSUT(RXIEN,0,STATE)'[("^"_STATE_"^") Q ;P662
  1. . . . . . S ^TMP("PSOSPMRX",$J,STATE,RXIEN,FILL)=RECTYPE
  1. . . . . . S GATHER=GATHER+1
  1. ;
  1. ; ASAP 1995 does not support transmissions of Return To Stock fills in the same file
  1. I $$GET1^DIQ(58.41,STATE,1,"I")="1995",'$G(RTSONLY) Q GATHER
  1. ;
  1. I LIST'="NC" Q GATHER ; PSO*7*625/PSU-792 don't gather return to stock fills if user selects "PR", "DR", "PA", "DV", or "RX" criteria filters via MA option
  1. ;
  1. ; - Gathering Fills Returned To Stock
  1. S RTSDT=BEGDTTM-.0000001,ENDRTSDT=ENDDTTM
  1. S:'$P(ENDRTSDT,".",2) ENDRTSDT=ENDRTSDT+.25
  1. F S RTSDT=$O(^PSRX("ARTS",RTSDT)) Q:'RTSDT!(RTSDT>ENDRTSDT) D
  1. . S RXIEN=0 F S RXIEN=$O(^PSRX("ARTS",RTSDT,RXIEN)) Q:'RXIEN D
  1. . . S RTSIEN=0 F S RTSIEN=$O(^PSRX("ARTS",RTSDT,RXIEN,RTSIEN)) Q:'RTSIEN D
  1. . . . S FILL=$$GET1^DIQ(52.07,RTSIEN_","_RXIEN,1,"I")
  1. . . . ; Rx Fill was never sent to SPMP so no need to VOID it
  1. . . . I '$D(^PS(58.42,"ARX",RXIEN,FILL)) Q
  1. . . . I $$RXRLDT^PSOBPSUT(RXIEN,FILL) Q
  1. . . . I $$SCREEN^PSOSPMUT(RXIEN,FILL) Q
  1. . . . I $D(^TMP("PSOSPMRX",$J,STATE,RXIEN,FILL)) Q
  1. . . . I $$RXSTATEZ^PSOBPSUT(RXIEN,0,STATE)=STATE S ^TMP("PSOSPMST",$J,$$RXSITE^PSOBPSUT(RXIEN,0))=""
  1. . . . N MBMST,STATECK ;P696 Start
  1. . . . S MBMST=$$GET1^DIQ(58.41,STATE,21,"I")
  1. . . . I (+MBMST=2) S STATECK=$$VOIDST^PSOSPMV(RXIEN,FILL) D Q
  1. . . . . I STATE=STATECK S ^TMP("PSOSPMRX",$J,STATECK,RXIEN,FILL)="V" S GATHER=GATHER+1 ;P696 End
  1. . . . I $$RXSTATEP^PSOBPSUT(RXIEN,0,STATE)'[("^"_STATE_"^") Q ;P662
  1. . . . S ^TMP("PSOSPMRX",$J,STATE,RXIEN,FILL)="V"
  1. . . . ;S ^TMP("PSOSPMST",$J,$$RXSITE^PSOBPSUT(RXIEN,0))="" ;PSO*7*625
  1. . . . S GATHER=GATHER+1
  1. Q GATHER
  1. ;
  1. BLDBAT(EXPTYPE,BEGRLDT,ENDRLDT) ; Given a list of Rx's builds a new Export Batch
  1. ; Input: (r) EXPTYPE - Export Type ((MA)naul/(SC)heduled/(RX) Single Rx)/(VD) Void Only/(ZR) Zero Report
  1. ; (o) BEGRLDT - Begin Release Date (FM Format) (Required for M and S batches)
  1. ; (o) ENDRLDT - End Release Date (FM Format) (Required for M and S batches)
  1. ; (r) List of Rx's: ^TMP("PSOSPMRX",$J,STATE,RXIEN,RXFILL)=Record Type ((N)ew/(R)evise/(V)oid)
  1. ; Note: This ^TMP global will be cleaned up at the end
  1. ;Output: BATCHIEN - New Batch IEN (Pointer to #58.42) OR "01^Error Message"
  1. N STATE,SPOK,RX,FILL,BATCHIEN,DRUGIEN,%,DIC,DR,DA,X,Y,XX,DINUM,DLAYGO,DD,DO,NDC,RECTYPE
  1. I '$O(^TMP("PSOSPMRX",$J,0)) Q "-1^No prescription data"
  1. ;
  1. S (STATE,RX)=0,FILL=""
  1. F S STATE=$O(^TMP("PSOSPMRX",$J,STATE)) Q:'STATE D I $P(BATCHIEN,"^")=-1 Q
  1. . S XX=$$SPOK^PSOSPMUT(STATE) I $P(XX,"^",1)=-1 S BATCHIEN=XX Q
  1. . F L +^PS(58.42,0):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) Q:$T H 3
  1. . S (DINUM,BATCHIEN)=$O(^PS(58.42,999999999999),-1)+1
  1. . I EXPTYPE'="VD" W !!,"Creating Batch #",DINUM," for ",$$GET1^DIQ(58.41,STATE,.01),"..."
  1. . S DIC="^PS(58.42,",X=DINUM,DIC(0)="",DIC("DR")="1////"_STATE_";2///"_EXPTYPE_";8///"_$$NOW^XLFDT()
  1. . I $G(DUZ)>0 I $D(^XUSEC("PSO SPMP ADMIN",DUZ)) S DIC("DR")=DIC("DR")_";10////"_DUZ ; PSO*7*625 - PSU-14 VOID
  1. . I $G(BEGRLDT) D
  1. . . S DIC("DR")=DIC("DR")_";4///"_BEGRLDT_";5///"_$G(ENDRLDT)
  1. . S DLAYGO=58.42 K DD,DO D FILE^DICN K DD,DO
  1. . L -^PS(58.42,0)
  1. . I Y=-1 S BATCHIEN="-1^Export Batch could not be created" Q
  1. . F S RX=$O(^TMP("PSOSPMRX",$J,STATE,RX)) Q:'RX D
  1. . . S DRUGIEN=$$GET1^DIQ(52,RX,6,"I")
  1. . . F S FILL=$O(^TMP("PSOSPMRX",$J,STATE,RX,FILL)) Q:FILL="" D
  1. . . . K DIC,DINUM,DA S DIC="^PS(58.42,"_BATCHIEN_",""RX"",",DIC(0)="",DA(1)=BATCHIEN
  1. . . . S RECTYPE=^TMP("PSOSPMRX",$J,STATE,RX,FILL)
  1. . . . I RECTYPE="V" D
  1. . . . . S NDC=$$GETNDC(RX,FILL)
  1. . . . E D
  1. . . . . I $L($$NUMERIC^PSOASAP0($$GET1^DIQ(50,DRUGIEN,31)))=11 D
  1. . . . . . S NDC=$$GET1^DIQ(50,DRUGIEN,31)
  1. . . . . E S NDC=$$GETNDC^PSONDCUT(RX,+FILL)
  1. . . . S X=RX,DIC("DR")="1///"_FILL_";2///"_RECTYPE_";3///"_NDC
  1. . . . S DLAYGO=58.42001 K DD,DO D FILE^DICN K DD,DO
  1. . I EXPTYPE'="VD" W "Done."
  1. K ^TMP("PSOSPMRX",$J)
  1. Q BATCHIEN
  1. ;
  1. LOADRTS(RXIEN,FILL,ARRAY) ; Load ARRAY with Return To Stock Information
  1. ;Input: RXIEN - Pointer to PRESCRIPTION file (#52)
  1. ; FILL - Fill # - "0":Original / "1"..:Refill #1... / "P1"..:Partial 1...
  1. ;Output:ARRAY - Return Array (most recent Return To Stock data for the fill)
  1. N RTSIEN,NODE0,NODE1,NDC
  1. K ARRAY S RTSIEN=0
  1. F S RTSIEN=$O(^PSRX(RXIEN,"RTS",RTSIEN)) Q:'RTSIEN D
  1. . S NODE0=$G(^PSRX(RXIEN,"RTS",RTSIEN,0))
  1. . I $P(NODE0,"^",2)'=FILL Q
  1. . S NODE1=$G(^PSRX(RXIEN,"RTS",RTSIEN,1))
  1. . S NDC=$$GETNDC(RXIEN,FILL) I NDC="" S NDC=$P(NODE0,"^",15)
  1. . S ARRAY("DIVISION")=$P(NODE0,"^",13) ; Division
  1. . S ARRAY("RELDTTM")=$P(NODE1,"^",2) ; Release Date/Time
  1. . S ARRAY("NDC")=NDC ; NDC
  1. . S ARRAY("QTY")=$P(NODE0,"^",4) ; Quantity
  1. . S ARRAY("DAYSUP")=$P(NODE0,"^",5) ; Days Supply
  1. . S ARRAY("RPHIEN")=$P(NODE0,"^",9) ; Pharmacist IEN
  1. . S ARRAY("PRVIEN")=$P(NODE1,"^",1) ; Provider IEN
  1. Q
  1. ;
  1. GETNDC(RXIEN,FILL) ; Get the SENT NDC for the Return To Stock (VOID) record
  1. ;Input: RXIEN - Pointer to PRESCRIPTION file (#52)
  1. ; FILL - Fill # - "0":Original / "1"..:Refill #1... / "P1"..:Partial 1...
  1. ;Output: $$GETNDC - Return To Stock NDC
  1. N GETRSNDC,BATCH,RXREC,RXREC0
  1. I '$G(RXIEN)!$G(FILL)="" Q ""
  1. S GETRSNDC=""
  1. S BATCH="" F S BATCH=$O(^PS(58.42,"ARX",RXIEN,FILL,BATCH),-1) Q:'BATCH D I GETRSNDC'="" Q
  1. . S RXREC="" F S RXREC=$O(^PS(58.42,"ARX",RXIEN,FILL,BATCH,RXREC),-1) Q:'RXREC D I GETRSNDC'="" Q
  1. . . S RXREC0=$G(^PS(58.42,BATCH,"RX",RXREC,0)) I $P(RXREC0,"^",3)="V" Q
  1. . . S GETRSNDC=$P(RXREC0,"^",4)
  1. Q GETRSNDC
  1. ;
  1. PREPFILE(STATE,DATETIME,RTSONLY,DEBUG) ; Prepare Files (FTP Script and Output Data files)
  1. ;Input: STATE - Pointer to STATE file (#5)
  1. ; DATETIME - Date/Time for the file names (format: YYYYMMDDHHMMSS)
  1. ; RTSONLY - Return To Stock Only Batch? (1: YES)
  1. ; DEBUG - Debug Mode? (1:YES / 0:NO)
  1. N PSOOS,LOCDIR,PREFIX,FILEXT,RENAME,FTPIP,FTPUSR,FTPPORT,FTPDIR,FTPFILE,INPTFILE,EXPFILE,LOGFILE
  1. ; - Operating System
  1. S PSOOS=$$OS^%ZOSV()
  1. ;
  1. I +$$SPOK^PSOSPMUT(STATE)=-1 Q $$SPOK^PSOSPMUT(STATE)
  1. ;
  1. ; - Retrieving the Local Directory for the corresponding OS
  1. I PSOOS["VMS" S LOCDIR=$$GET1^DIQ(58.41,STATE,4)
  1. I PSOOS["UNIX" S LOCDIR=$$GET1^DIQ(58.41,STATE,15)
  1. ;
  1. S PREFIX=$$GET1^DIQ(58.41,STATE,5)
  1. S FILEXT=$$GET1^DIQ(58.41,STATE,6)
  1. S RENAME=$$GET1^DIQ(58.41,STATE,17,"I")
  1. S FTPIP=$$GET1^DIQ(58.41,STATE,7)
  1. S FTPUSR=$$GET1^DIQ(58.41,STATE,8)
  1. S FTPPORT=$$GET1^DIQ(58.41,STATE,9)
  1. S FTPDIR=$$GET1^DIQ(58.41,STATE,10)
  1. ;
  1. S INPTFILE="SPMP_FTP_"_DATETIME_".INP"
  1. I PSOOS["VMS" S FTPFILE="SPMP_FTP_"_DATETIME_".COM"
  1. S LOGFILE="SPMP_FTP_"_DATETIME_".LOG"
  1. S EXPFILE=PREFIX_DATETIME_$S(RENAME:".UP",1:FILEXT)
  1. I $G(RTSONLY) S EXPFILE="BACK_"_EXPFILE
  1. ;
  1. D OPEN^%ZISH("INPTFILE",LOCDIR,INPTFILE,"W") I POP Q "-1^FTP Script file <"_LOCDIR_INPTFILE_"> could not be created."
  1. D USE^%ZISUTL("INPTFILE")
  1. W:FTPDIR'="" "cd "_FTPDIR,!
  1. W "put "_$S(PSOOS["UNIX":LOCDIR,1:"")_EXPFILE,!
  1. W:PSOOS["UNIX" "lcd "_LOCDIR,!
  1. W:RENAME "rename "_EXPFILE_" "_$P(EXPFILE,".UP")_FILEXT,!
  1. W:PSOOS["VMS" "lrm "_EXPFILE,!
  1. ; W:PSOOS["UNIX" "!rm -f "_LOCDIR_EXPFILE,!
  1. W "exit",!
  1. D CLOSE^%ZISH("INPTFILE")
  1. I POP Q "-1^FTP Input file <"_INPTFILE_"> cannot be created."
  1. ;
  1. ; This sFTP command file is not needed for Linux/Unix
  1. I PSOOS["VMS" D I POP Q "-1^FTP Script file <"_LOCDIR_FTPFILE_"> could not be created."
  1. . D OPEN^%ZISH("FTPFILE",LOCDIR,FTPFILE,"W")
  1. . D USE^%ZISUTL("FTPFILE")
  1. . ; VMS Secure FTP
  1. . I PSOOS["VMS" D
  1. . . W "$ SET VERIFY=(PROCEDURE,IMAGE)",!
  1. . . I LOCDIR'="" W "$ SET DEFAULT "_LOCDIR,!
  1. . . W "$ sftp"_$S($G(DEBUG):" -""D3""",1:"")_$S(FTPPORT:" -oPort="_FTPPORT,1:"")_" -oIdentityFile="""_$$XVMSDIR(LOCDIR)_"VMSSSHID."" -""B"" "_INPTFILE_" -oUser="_FTPUSR_" "_FTPIP,!
  1. . . W "$ exit",!
  1. . D CLOSE^%ZISH("FTPFILE")
  1. ;
  1. I PSOOS["VMS" D I POP Q "-1^FTP Script file <"_LOCDIR_"VMSSSHID.> could not be created."
  1. . D OPEN^%ZISH("VMSSSHID",LOCDIR,"VMSSSHID.","W")
  1. . D USE^%ZISUTL("VMSSSHID")
  1. . W "IDKEY "_$$XVMSDIR(LOCDIR)_"VMSSSHKEY"
  1. . D CLOSE^%ZISH("FTPFILE")
  1. ;
  1. D SAVEKEYS(STATE,LOCDIR)
  1. ;
  1. Q (LOCDIR_"^"_EXPFILE_"^"_$G(FTPFILE)_"^"_$G(INPTFILE)_"^"_$G(LOGFILE)_"^"_PREFIX_DATETIME_FILEXT)
  1. ;
  1. FTPFILE(STATEIP,STATEUSR,LOCDIR,FTPFILE,EXPFILE,INPTFILE,LOGFILE,FTPPORT,DEBUG) ; Issue the Secure FTP command
  1. ;Input: STATEIP - State Server IP Address
  1. ; STATEUSR - Username at the State Server
  1. ; LOCDIR - Local Directory
  1. ; FTPFILE - sFTP executable batch file (VMS and NT only)
  1. ; EXPFILE - Data Export File
  1. ; INPTFILE - sFTP input file
  1. ; LOGFILE - sFTP Capture Log File (VMS only)
  1. ; FTPPORT - State Server Port #
  1. ; DEBUG - Debug Mode? (1:YES / 0:NO)
  1. N PSOOS,PV,XPV1
  1. S PSOOS=$$OS^%ZOSV()
  1. I PSOOS["VMS" S XPV1="S PV=$ZF(-1,""@"_LOCDIR_FTPFILE_"/OUTPUT="_LOCDIR_LOGFILE_""")"
  1. I PSOOS["UNIX" D
  1. . S XPV1="S PV=$ZF(-1,""sftp"_$S($G(DEBUG):" -oLogLevel=DEBUG1",1:"")_$S(FTPPORT:" -oPort="_FTPPORT,1:"")_" -oIdentityFile="""""_LOCDIR_"linuxsshkey"""" -b "_LOCDIR_INPTFILE
  1. . S XPV1=XPV1_" -oStrictHostKeyChecking=no -oUser="_$TR(STATEUSR,"""","")_" "_STATEIP_" >> "_LOCDIR_LOGFILE_""")"
  1. ;
  1. X XPV1 ; Execute the FTP command
  1. ;
  1. ; Error flag logic
  1. I PV=-1 Q "-1^Secure FTP Transmission failed"
  1. ;
  1. ; If Export File exists locally it means the sFTP did not finish because it removes the local file
  1. N FILEARR,ERROR
  1. ;I PSOOS["VMS" S FILEARR(EXPFILE)="" I $$FEXIST^%ZISH(LOCDIR,"FILEARR") S ERROR=1
  1. I PSOOS["VMS" I $$FEXIST^PSOSPMUT(LOCDIR,EXPFILE) S ERROR=1
  1. I PSOOS["UNIX" D
  1. . N XLOG,LOG,LINE
  1. . S ERROR=1 K ^TMP("PSOFTPLG",$J)
  1. . S XLOG=$$FTG^%ZISH(LOCDIR,LOGFILE,$NAME(^TMP("PSOFTPLG",$J,1)),3)
  1. . S (LOG,LINE)=0
  1. . F S LOG=$O(^TMP("PSOFTPLG",$J,LOG)) Q:LOG="" D I 'ERROR Q
  1. . . S LINE=$G(^TMP("PSOFTPLG",$J,LOG)) I $$UP^XLFSTR(LINE)["SFTP> EXIT" S ERROR=0
  1. ;
  1. I $G(ERROR) Q "-1^Secure FTP Transmission failed."
  1. ;
  1. Q ""
  1. ;
  1. DELFILES(LOCDIR,EXPFILE,INPTFILE,FTPFILE,LOGFILE) ; Delete Files
  1. ;Input: LOCDIR - Local Directory
  1. ; EXPFILE - Data Export File
  1. ; INPTFILE - sFTP input file
  1. ; FTPFILE - sFTP executable batch file (VMS and NT only)
  1. ; LOGFILE - sFTP Log Capture batch file (VMS and NT only)
  1. N FILE2DEL,PSOOS ;,FILEARR
  1. I $G(LOCDIR)="" Q
  1. S PSOOS=$$OS^%ZOSV()
  1. I $G(EXPFILE)'="",$$FEXIST^PSOSPMUT(LOCDIR,EXPFILE) S FILE2DEL(EXPFILE)=""
  1. S:$G(INPTFILE)'="" FILE2DEL(INPTFILE)=""
  1. S:$G(LOGFILE)'="" FILE2DEL(LOGFILE)=""
  1. I PSOOS["VMS" D
  1. . S:$G(FTPFILE)'="" FILE2DEL(FTPFILE)=""
  1. . S FILE2DEL("VMSSSHID.")=""
  1. . S FILE2DEL("VMSSSHKEY.")=""
  1. . S FILE2DEL("VMSSSHKEY.PUB")=""
  1. I PSOOS["UNIX" D
  1. . S FILE2DEL("VMSSSHKEY")=""
  1. . S FILE2DEL("linuxsshkey")=""
  1. D DEL^%ZISH(LOCDIR,"FILE2DEL")
  1. Q
  1. ;
  1. PAUSE ; Pauses screen until user hits Return
  1. N DIR
  1. W ! S DIR("A")="Press Return to continue",DIR(0)="E" D ^DIR
  1. Q
  1. ;
  1. XVMSDIR(VMSDIR) ; Converts a VMS directory
  1. ; Input: VMSDIR - OpenVMS directory name (e.g., "USER$:[SPMP]")
  1. ;Output: $$XVMSDIR - Converted VMS directory (e.g., "/USER$/SPMP/")
  1. Q "/"_$TR(VMSDIR,".[]:","///")
  1. ;
  1. SAVEKEYS(STATE,LOCDIR) ; Saves Key, converts SSH2 to OpenSSH when running on Linux
  1. ;Input: STATE - State to retrieve the keys from
  1. ; LOCDIR - Local directory where the keys should be saved to
  1. N WLINE,XPV
  1. I $$GET1^DIQ(58.41,STATE,18,"I")="SSH2" D
  1. . ;Saving the Private SSH Key
  1. . D OPEN^%ZISH("VMSSSHKEY",LOCDIR,"VMSSSHKEY","W")
  1. . D USE^%ZISUTL("VMSSSHKEY")
  1. . F WLINE=1:1 Q:'$D(^PS(58.41,STATE,"PRVKEY",WLINE)) D
  1. . . W $$DECRYP^XUSRB1(^PS(58.41,STATE,"PRVKEY",WLINE,0)),!
  1. . D CLOSE^%ZISH("VMSSSHKEY")
  1. ;
  1. I $$OS^%ZOSV()["VMS" D Q
  1. . ;Saving the Public SSH Key (Assuming SSH2 format) - VMS Only
  1. . D OPEN^%ZISH("VMSSSHKEY",LOCDIR,"VMSSSHKEY.PUB","W")
  1. . D USE^%ZISUTL("VMSSSHKEY")
  1. . F WLINE=1:1 Q:'$D(^PS(58.41,STATE,"PUBKEY",WLINE)) D
  1. . . W $$DECRYP^XUSRB1(^PS(58.41,STATE,"PUBKEY",WLINE,0)),!
  1. . D CLOSE^%ZISH("VMSSSHKEY")
  1. ;
  1. I $$OS^%ZOSV()["UNIX" D Q
  1. . ;If Key format is SSH2, convert VMSSSHKEY to OpenSSH format; Otherwise write directly from VistA
  1. . I $$GET1^DIQ(58.41,STATE,18,"I")="SSH2" D
  1. . . S XPV="S PV=$ZF(-1,""ssh-keygen -i -f "_LOCDIR_"VMSSSHKEY > "_LOCDIR_"linuxsshkey"")"
  1. . . X XPV
  1. . E D
  1. . . ;Saving the Private SSH Key (OpenSSH Format)
  1. . . D OPEN^%ZISH("linuxsshkey",LOCDIR,"linuxsshkey","W")
  1. . . D USE^%ZISUTL("linuxsshkey")
  1. . . F WLINE=1:1 Q:'$D(^PS(58.41,STATE,"PRVKEY",WLINE)) D
  1. . . . W $$DECRYP^XUSRB1(^PS(58.41,STATE,"PRVKEY",WLINE,0)),!
  1. . . D CLOSE^%ZISH("linuxsshkey")
  1. . S XPV="S PV=$ZF(-1,""chmod 600 "_LOCDIR_"linuxsshkey"")"
  1. . X XPV
  1. ;
  1. Q
  1. ;
  1. LINUXDIR() ; Returns the Linux Directory for SPMP sFTP
  1. N CURDIR,ROOTDIR,PSOVER
  1. I $$OS^%ZOSV()'="UNIX" Q ""
  1. S PSOVER=$$UP^XLFSTR($$VERSION^%ZOSV(1))
  1. I PSOVER'["CACHE",PSOVER'["IRIS" Q "" ;PSO*7*630
  1. ; Retrieving the current directory
  1. X "S CURDIR=$ZU(12)" S ROOTDIR=$P(CURDIR,"/",1,4)
  1. I $E(ROOTDIR,$L(ROOTDIR))="/" S $E(ROOTDIR,$L(ROOTDIR))=""
  1. Q ROOTDIR_"/user/sftp/spmp/"
  1. ;
  1. DIREXIST(DIR) ; Returns whether the Linux Directory for SPMP sFTP already exists
  1. ;Input: DIR - Linux Directory name to be checked
  1. N DIREXIST,PSOVER
  1. I DIR="" Q 0
  1. I $$OS^%ZOSV()'="UNIX" Q 0
  1. S PSOVER=$$UP^XLFSTR($$VERSION^%ZOSV(1))
  1. I PSOVER'["CACHE",PSOVER'["IRIS" Q 0 ;PSO*7*630
  1. I $E(DIR,$L(DIR))="/" S $E(DIR,$L(DIR))=""
  1. X "S DIREXIST=$ZSEARCH(DIR)"
  1. Q $S(DIREXIST="":0,1:1)
  1. ;
  1. MAKEDIR(DIR) ; Create a new directory
  1. ;Input: DIR - Linux Directory name to be created
  1. N MKDIR,PSOVER
  1. I $$OS^%ZOSV()'="UNIX" Q
  1. S PSOVER=$$UP^XLFSTR($$VERSION^%ZOSV(1))
  1. I PSOVER'["CACHE",PSOVER'["IRIS" Q ;PSO*7*630
  1. I $$DIREXIST(DIR) Q
  1. X "S MKDIR=$ZF(-1,""mkdir ""_DIR)"
  1. I 'MKDIR X "S MKDIR=$ZF(-1,""chmod 777 ""_DIR)"
  1. Q
  1. ;
  1. SETLN(NSPC,TEXT,REV,UND,HIG) ; Sets a line to be displayed in the Body section
  1. ;Input: NSPC - Namespace of the ^TMP global
  1. ; TEXT - Line of text to be added to Listman
  1. ; REV - Reverse video (1: YES / 0:NO)
  1. ; UND - Underlined (1: YES / 0: NO)
  1. ; HIG - Highlighted (1: YES / 0: NO)
  1. N X
  1. S:$G(TEXT)="" $E(TEXT,80)=""
  1. S:$L(TEXT)>80 TEXT=$E(TEXT,1,80)
  1. S LINE=LINE+1,^TMP(NSPC,$J,LINE,0)=$G(TEXT)
  1. ;
  1. I LINE>$G(PSOLSTLN) D SAVE^VALM10(LINE) S PSOLSTLN=LINE
  1. ;
  1. I $G(REV) D Q
  1. . D CNTRL^VALM10(LINE,1,$L(TEXT),IORVON,IORVOFF_IOINORM)
  1. . I $G(UND) D CNTRL^VALM10(LINE,$L(TEXT)+1,80,IOUON,IOINORM)
  1. I $G(UND) D CNTRL^VALM10(LINE,1,80,IOUON,IOINORM)
  1. I $G(HIG) D
  1. . D CNTRL^VALM10(LINE,HIG,80,IOINHI_$S($G(UND):IOUON,1:""),IOINORM)
  1. Q