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