- PSOSPMUT ;BIRM/MFR - State Prescription Monitoring Program Utilities ;10/07/12
- ;;7.0;OUTPATIENT PHARMACY;**408,451,549,625,630**;DEC 1997;Build 26
- ;
- EXPORT(BATCHIEN,MODE,BCKGRND,DEBUG,FLUSH) ; Export a SPMP Batch
- ;Input: BATCHIEN - Pointer to #58.41
- ; MODE - "VIEW" or "EXPORT"
- ; BCKGRND - Background? (1:YES / 0:NO)
- ; DEBUG - Debug Mode? (1:YES / 0:NO)
- ; FLUSH - Flush host? (1:YES / 0:NO)
- N X,RX,STATEIEN,PSOASVER,TRXTYPE,PSOTTCNT,PSOTPCNT,SITEIEN,RXIEN,FILLNUM,FILLIEN,PATIEN,DFN,VADM
- N RTSDATA,DATETIME,VAPA,XX,ASAP,LOCDIR,EXPFILE,EXPFILE2,FTPFILE,INPTFILE,DIE,DR,DA,PSOFTPOK,FILES
- N PSODELOK,PSOOS,RTSONLY,PSOSTIP,PSOSTUSR,PSONAME,PSOPORT,PSOAUTO,PSOSTDIR,PSOFLEXT,RENAME,DRUGIEN
- N PREIEN,RPHIEN,RTSREC,RXNODE,ZRS,ZRNODE,DEA,PSOVER
- S BCKGRND=+$G(BCKGRND),DEBUG=+$G(DEBUG),FLUSH=+$G(FLUSH) K ^TMP("PSOSPMEX",$J),ZRDEA
- ;
- I +$$SPOK($$GET1^DIQ(58.42,BATCHIEN,1,"I"))=-1 D Q
- . D LOGERROR(BATCHIEN,0,$P($$SPOK($$GET1^DIQ(58.42,BATCHIEN,1,"I")),"^",2),BCKGRND)
- ;
- ; The LOCK below prevents two concurrent transmission processes from getting the same filename
- F S DATETIME=$P($$FMTHL7^XLFDT($$HTFM^XLFDT($H)),"-") L +@("PMP"_DATETIME):0 Q:$T H 2
- ;
- S STATEIEN=$$GET1^DIQ(58.42,BATCHIEN,1,"I")
- S PSOASVER=$$GET1^DIQ(58.41,STATEIEN,1,"I")
- I $$GET1^DIQ(58.42,BATCHIEN,2,"I")="ZR" S PSOASVER=$$GET1^DIQ(58.41,STATEIEN,20) ;Zero Reporting
- S PSOFLEXT=$$GET1^DIQ(58.41,STATEIEN,6)
- S RENAME=$$GET1^DIQ(58.41,STATEIEN,17,"I")
- S PSOSTIP=$$GET1^DIQ(58.41,STATEIEN,7)
- S PSOPORT=$$GET1^DIQ(58.41,STATEIEN,9)
- ;
- ; The commands below will first 'flush' and then add the IP Address to the known_hosts file
- S PSOVER=$$UP^XLFSTR($$VERSION^%ZOSV(1))
- I MODE="EXPORT",$$OS^%ZOSV()="UNIX",(PSOVER["CACHE")!(PSOVER["IRIS") D ;PSO*7*630
- . I DEBUG,FLUSH X "S PV=$ZF(-1,""ssh-keygen -R ""_PSOSTIP)"
- . X "S PV=$ZF(-1,""ssh -oBatchMode=yes -oStrictHostKeyChecking=no -oLogLevel=quiet"_$S(PSOPORT:" -oPort="_PSOPORT,1:"")_" "_PSOSTIP_""")"
- ;
- S PSOSTUSR=$$GET1^DIQ(58.41,STATEIEN,8)
- S PSOSTDIR=$$GET1^DIQ(58.41,STATEIEN,10)
- S PSOAUTO=$S($$GET1^DIQ(58.41,STATEIEN,13,"I")="A":1,1:0)
- S PSOOS=$$OS^%ZOSV()
- ;
- I MODE="EXPORT",'$G(BCKGRND) W !!,"Exporting Batch #",BATCHIEN,":",!
- ;
- S RX=0
- F S RX=$O(^PS(58.42,BATCHIEN,"RX",RX)) Q:'RX D
- . S RXNODE=^PS(58.42,BATCHIEN,"RX",RX,0)
- . S RXIEN=+RXNODE,FILLNUM=$P(RXNODE,"^",2),PATIEN=$$GET1^DIQ(52,RXIEN,2,"I")
- . I MODE="EXPORT",$P(RXNODE,"^",3)'="V",'$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM) Q
- . ; PSO*7*625:PSU-14 - Allow VOID Export of Released Prescriptions in RX Batch Only
- . I MODE="EXPORT",$P(RXNODE,"^",3)="V",$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM),($$GET1^DIQ(58.42,BATCHIEN,2,"I")'="RX") Q ; PSO*7*625:PSU-14
- . ; Always the Pharmacy Division for the Original Fill
- . S SITEIEN=$$RXSITE^PSOBPSUT(RXIEN,0)
- . S ^TMP("PSOSPMEX",$J,SITEIEN,PATIEN,RXIEN,FILLNUM)=$P(RXNODE,"^",3)
- ;
- I $$GET1^DIQ(58.41,STATEIEN,20)'="",$$GET1^DIQ(58.42,BATCHIEN,2,"I")="ZR" D ;Zero report
- . S ZRS=0 S SITEIEN=""
- . F S ZRS=$O(^PS(58.42,BATCHIEN,"ZRS",ZRS)) Q:'ZRS D
- . . S ZRNODE=^PS(58.42,BATCHIEN,"ZRS",ZRS,0)
- . . S SITEIEN=+ZRNODE,DEA=$P(ZRNODE,"^",2)
- . . S ZRDEA(DEA)=SITEIEN
- . N DEA S (DEA,SITEIEN)=""
- . F S DEA=$O(ZRDEA(DEA)) Q:DEA="" D
- . . S SITEIEN=ZRDEA(DEA),^TMP("PSOSPMEX",$J,SITEIEN)=""
- ;
- I '$D(^TMP("PSOSPMEX",$J)) D L -@("PMP"_DATETIME) Q
- . D LOGERROR(BATCHIEN,0,"There were no eligible prescriptions in the batch #"_BATCHIEN,BCKGRND)
- ;
- I MODE="VIEW",PSOASVER'="1995" S XX="",$P(XX,"-",80)="" W !,XX,!
- I MODE="EXPORT" D I $P(FILES,"^",1)=-1 L -@("PMP"_DATETIME) Q
- . S RTSONLY=0 I $$GET1^DIQ(58.42,BATCHIEN,2,"I")="VD" S RTSONLY=1
- . I PSOOS["VMS" S LOCDIR=$$GET1^DIQ(58.41,STATEIEN,4)
- . I PSOOS["UNIX" D
- . . S LOCDIR=$$GET1^DIQ(58.41,STATEIEN,15)
- . . I '$$DIREXIST^PSOSPMU1(LOCDIR) D MAKEDIR^PSOSPMU1(LOCDIR)
- . S FILES=$$PREPFILE^PSOSPMU1(STATEIEN,DATETIME,RTSONLY,DEBUG)
- . I $P(FILES,"^",1)=-1 D LOGERROR(BATCHIEN,0,$P(FILES,"^",2),BCKGRND) Q
- . S EXPFILE=$P(FILES,"^",2)
- . S FTPFILE=$P(FILES,"^",3)
- . S INPTFILE=$P(FILES,"^",4)
- . S LOGFILE=$P(FILES,"^",5)
- . S EXPFILE2=$P(FILES,"^",6)
- . I 'BCKGRND W !,$S('PSOAUTO:"Step 1: ",1:""),"Writing to file ",LOCDIR_EXPFILE,"..."
- . D OPEN^%ZISH("EXPFILE",LOCDIR,EXPFILE,"W")
- . I POP D LOGERROR(BATCHIEN,0,"Export File <"_LOCDIR_EXPFILE_"> could not be created.",BCKGRND) S FILES=-1 Q
- . D USE^%ZISUTL("EXPFILE")
- ;----------------------------- ASAP Data Output (1995) -------------------------------
- I PSOASVER="1995" D
- . S (SITEIEN,PATIEN,RXIEN)=0
- . F S SITEIEN=$O(^TMP("PSOSPMEX",$J,SITEIEN)) Q:'SITEIEN D
- . . F S PATIEN=$O(^TMP("PSOSPMEX",$J,SITEIEN,PATIEN)) Q:'PATIEN D
- . . . K VADM,VAPA,PSONAME S DFN=PATIEN D DEM^VADPT,ADD^VADPT,SETNAME(PATIEN)
- . . . F S RXIEN=$O(^TMP("PSOSPMEX",$J,SITEIEN,PATIEN,RXIEN)) Q:'RXIEN D
- . . . . S FILLNUM=""
- . . . . F S FILLNUM=$O(^TMP("PSOSPMEX",$J,SITEIEN,PATIEN,RXIEN,FILLNUM)) Q:FILLNUM="" D
- . . . . . S RECTYPE=^TMP("PSOSPMEX",$J,SITEIEN,PATIEN,RXIEN,FILLNUM)
- . . . . . K RTSDATA I RECTYPE="V" D LOADRTS^PSOSPMU1(RXIEN,FILLNUM,.RTSDATA)
- . . . . . W $$ASAP95^PSOASAP0(RXIEN,+FILLNUM),!
- ;------------------------- ASAP Data Output (3.0 and above) --------------------------
- I PSOASVER'="1995" D
- . S TRXTYPE="S",PSOTTCNT=0
- . D LOADASAP^PSOSPMU0(PSOASVER,"B",.ASAP)
- . S (SITEIEN,PATIEN,RXIEN)=0
- . ;Writing Level 1: Transaction Header, Information Source
- . D WRITELEV(1,"ASAP")
- . F S SITEIEN=$O(^TMP("PSOSPMEX",$J,SITEIEN)) Q:'SITEIEN D
- . . S PSOTPCNT=0
- . . ;Writing Level 2: Pharmacy Header
- . . D WRITELEV(2,"ASAP")
- . . ;Zero Reporting
- . . I $$GET1^DIQ(58.42,BATCHIEN,2,"I")="ZR" D
- . . . ;Zero Reporting Writing Level 3: Patient Detail
- . . . D WRITELEV(3,"ASAP")
- . . . ;Zero Reporting Writing Level 4: Prescription Detail
- . . . D WRITELEV(4,"ASAP")
- . . F S PATIEN=$O(^TMP("PSOSPMEX",$J,SITEIEN,PATIEN)) Q:'PATIEN D
- . . . K VADM,VAPA,PSONAME S DFN=PATIEN D DEM^VADPT,ADD^VADPT,SETNAME(PATIEN)
- . . . S (DRUGIEN,FILLNUM,FILLIEN,PREIEN,RPHIEN,RTSREC)=0
- . . . ;Writing Level 3: Patient Detail
- . . . D WRITELEV(3,"ASAP")
- . . . F S RXIEN=$O(^TMP("PSOSPMEX",$J,SITEIEN,PATIEN,RXIEN)) Q:'RXIEN D
- . . . . S FILLNUM="",DRUGIEN=$$GET1^DIQ(52,RXIEN,6,"I")
- . . . . F S FILLNUM=$O(^TMP("PSOSPMEX",$J,SITEIEN,PATIEN,RXIEN,FILLNUM)) Q:FILLNUM="" D
- . . . . . S FILLIEN=$S(FILLNUM["P":+$P(FILLNUM,"P",2),1:+FILLNUM)
- . . . . . S RECTYPE=^TMP("PSOSPMEX",$J,SITEIEN,PATIEN,RXIEN,FILLNUM)
- . . . . . S PREIEN=$$PREIEN(RECTYPE,RXIEN,FILLNUM)
- . . . . . S RPHIEN=$$RPHIEN(RECTYPE,RXIEN,FILLNUM)
- . . . . . S RTSREC=0 K RTSDATA I RECTYPE="V" S RTSREC=1 D LOADRTS^PSOSPMU1(RXIEN,FILLNUM,.RTSDATA)
- . . . . . ;Writing Level 4: Prescription Detail
- . . . . . D WRITELEV(4,"ASAP")
- . . ;Writing Level 5: Pharmacy Trailer
- . . D WRITELEV(5,"ASAP")
- . ;Writing Level 6: Transaction Trailer
- . D WRITELEV(6,"ASAP")
- ; Close the file
- I MODE="EXPORT" D CLOSE^%ZISH("EXPFILE") I 'BCKGRND W "Done."
- ;------------------------- sFTP Transmission to the State -----------------------------
- I MODE="VIEW",PSOASVER'="1995" S XX="",$P(XX,"-",80)="" W !,XX
- S (PSOFTPOK,PSODELOK)=""
- I MODE="EXPORT" D
- . ; Automated Transmission (RSA keys)
- . I PSOAUTO D
- . . I 'BCKGRND W !!,"Transmitting file to the State (",$$GET1^DIQ(58.41,STATEIEN,7),")...",!
- . . S PSOFTPOK=$$FTPFILE^PSOSPMU1(PSOSTIP,PSOSTUSR,LOCDIR,FTPFILE,EXPFILE,INPTFILE,LOGFILE,PSOPORT,DEBUG)
- . ; Manual Transmission (Password)
- . K DTOUT,DUOUT
- . I 'PSOAUTO D
- . . W !!,"Step 2: Copy the "_$S(PSOSTDIR'="":"four",1:"three")_" lines of text below into the clipboard (highlight the"
- . . W !?8,"lines then right-click the mouse and select 'Copy').",!
- . . W:$G(PSOSTDIR)'="" !,"cd "_PSOSTDIR
- . . W !,"put "_$S(PSOOS["VMS":$$XVMSDIR^PSOSPMU1(LOCDIR),1:LOCDIR)_EXPFILE
- . . W:$G(RENAME) !,"rename "_EXPFILE_" "_$P(EXPFILE,".up",1)_PSOFLEXT
- . . W !,"exit",!
- . . K DIR,DTOUT,DUOUT S DIR(0)="E",DIR("A")="Then press <RETURN> to go to the next step." D ^DIR I $G(DTOUT)!$G(DUOUT) Q
- . . W !!,"Step 3: Enter the sFTP password and press <RETURN>"
- . . W !!,"Step 4: Once you get the 'sftp>' prompt, paste the text copied on step 2"
- . . W !?8,"(right-click the mouse and select 'Paste').",!!
- . . N XPV1,PV S XPV1="S PV=$ZF(-1,""sftp"_$S(PSOPORT:" -oPort="_PSOPORT,1:"")_" -oUser="_$TR(PSOSTUSR,"""","")_" "_PSOSTIP_""")"
- . . X XPV1
- . I $P(PSOFTPOK,"^",1)=-1 D LOGERROR(BATCHIEN,0,$P(PSOFTPOK,"^",2),BCKGRND,$G(LOGFILE))
- . ;Deleting files
- . D DELFILES^PSOSPMU1($G(LOCDIR),$G(EXPFILE),$G(INPTFILE),$G(FTPFILE),$G(LOGFILE))
- . I $P(PSOFTPOK,"^",1)=-1 Q
- . I 'PSOAUTO,$G(DTOUT)!$G(DUOUT) Q
- . I 'BCKGRND,PSOAUTO H 1 W !!,"File Successfully Transmitted.",!
- . I 'PSOAUTO D I $G(DTOUT)!$G(DUOUT)!'Y Q
- . . K DIR S DIR("A")="Was the file transmitted successfully",DIR(0)="Y",DIR("B")="N"
- . . D ^DIR
- . S DIE="^PS(58.42,",DA=BATCHIEN,DR="6///"_EXPFILE2_";7////"_DUZ_";9///"_$$NOW^XLFDT() D ^DIE
- W ! L -@("PMP"_DATETIME)
- Q
- ;
- WRITELEV(LEVEL,ARRAY) ; Write the ASAP Segments for each Level
- ;Input: LEVEL - ASAP level to print (1:Header, 2:Pharmacy, ...)
- ; ARRAY - Name of the Array containing the ASAP Data Definition (e.g., "ASAP")
- N NODE,SEGID,SEG0
- S NODE=ARRAY
- F S NODE=$Q(@NODE) Q:NODE=""!($E(NODE,$F(NODE,"("))'?1N) D
- . S SEGID=@NODE I SEGID="" Q
- . S SEG0=$G(@(ARRAY_"("""_SEGID_""")"))
- . ; Segment not in the Level
- . I $P(SEG0,"^",6)'=LEVEL Q
- . ; Segment Marked NOT USED
- . I $P(SEG0,"^",4)="N" Q
- . D WRITESEG(SEGID,LEVEL,ARRAY)
- Q
- ;
- WRITESEG(SEGID,LEVEL,ARRAY) ; Write the ASAP segment to the file
- ;Input: SEGID - ASAP Segment ID (e.g., "TH", "PAT", "DSP", ...)
- ; LEVEL - ASAP level to print (1:Header, 2:Pharmacy, ...)
- ; ARRAY - Name of the Array containing the ASAP Data Definition (e.g., "ASAP")
- N ELMPOS,LASTELEM
- I '$D(@ARRAY@(SEGID)) Q
- I $G(MODE)="VIEW",$P(@ARRAY,"^",4)'="" W ?$S(LEVEL<5:((LEVEL-1)*3),LEVEL=5:3,1:0)
- S LASTELEM=+$O(@ARRAY@(SEGID,""),-1)
- W SEGID D SEGCOUNT(LEVEL)
- F ELMPOS=1:1:LASTELEM D
- . ;Skipping Last Element if marked NOT USED (to solve issue with TH09 for 4.0 and TH13 for 3.0)
- . I ELMPOS=LASTELEM,$P(@ARRAY@(SEGID,ELMPOS),"^",6)="N" Q
- . ;Data Element Delimiter Char
- . W $P(@ARRAY,"^",2)
- . ; ASAP Data Element Marked NOT USED
- . I $P(@ARRAY@(SEGID,ELMPOS),"^",6)="N" Q
- . ; Writing Data Element Content to the file
- . D WRITEELM(SEGID,ELMPOS,ARRAY)
- ; Segment Terminator Character
- W $P(@ARRAY,"^",3)
- ; End of Segment Control Char(s) (e.g., Line-Feed ($C(10)), Carriage-Return ($C(13)),etc.)
- W:$P(@ARRAY,"^",4)'="" @($P(@ARRAY,"^",4))
- Q
- ;
- WRITEELM(SEGID,ELMPOS,ARRAY) ; Write the ASAP Data Element to file
- ;Input: SEGID - ASAP Segment ID (e.g., "TH", "PAT", "DSP", ...)
- ; ELMPOS - ASAP Data Element Position (1, 2, 3, ...)
- ; ARRAY - Name of the Array containing the ASAP Data Definition (e.g., "ASAP")
- N MEXPR,GETVALUE,VALUE,MAXLEN
- S MEXPR=$G(@ARRAY@(SEGID,ELMPOS,"VAL",1))
- ; Rechecking the M Expression value for Security purposes
- I '$$VALID^PSOSPMU3($P(@ARRAY,"^"),MEXPR) W "?" Q
- ; Retrieving and executing the M code for retrieving the ASAP Data Element value
- D
- . N $ETRAP,$ESTACK S $ETRAP="D ERROR^PSOSPMUT"
- . S GETVALUE="S VALUE="_MEXPR X GETVALUE
- ; Removing Control Characters from the Data Element Value
- S VALUE=$$ESC(VALUE)
- ; Triming Value according to the Data Element Maximum Length
- S MAXLEN=$P($G(@ARRAY@(SEGID,ELMPOS)),"^",4) S:MAXLEN>0 VALUE=$E(VALUE,1,MAXLEN)
- ; Replacing characters that match Segment Delimiter chars with "?"
- I MAXLEN>1,VALUE'=$P(@ARRAY,"^",3) S VALUE=$TR(VALUE,$P(@ARRAY,"^",3),"?")
- ; Replacing characters that match Data Element Delimiter chars with "?"
- I MAXLEN>1,VALUE'=$P(@ARRAY,"^",2) S VALUE=$TR(VALUE,$P(@ARRAY,"^",2),"?")
- ; Writing the Data Element Value
- W VALUE
- Q
- ;
- SEGCOUNT(LEVEL) ; Keeps track of Segment Count for TP and TT info
- ;Input: LEVEL - Level of the Segment where the Data Element is located
- ; TT Segment Count
- S PSOTTCNT=$G(PSOTTCNT)+1
- ; TP Segment Count
- I LEVEL'=1,LEVEL'=6 S PSOTPCNT=$G(PSOTPCNT)+1
- Q
- ;
- ERROR ; Error Trap Handling to catch errors on user-entered M SET expressions
- N ERROR
- D CLOSE^%ZISH("EXPFILE")
- S ERROR="ASAP Data Element: "_$G(SEGID)_$E(100+$G(ELMPOS),2,3)_" M Expression: "_$G(MEXPR)_" Error: "_$$EC^%ZOSV
- D LOGERROR($G(BATCHIEN),0,ERROR,$G(BCKGRND))
- D DELFILES^PSOSPMU1($G(LOCDIR),$G(EXPFILE),$G(INPTFILE),$G(FTPFILE))
- Q
- ;
- SCREEN(RXIEN,FILLNUM) ; Screens Rx's from being sent to the State
- ; Input: RXIEN - PRESCRIPTION file (#52) IEN
- ; FILLNUM - Fill Number
- ;Output: $$SCREEN - 1:YES/0:NO^Error/Warning Message^E:Error/W:Warning
- ;
- ; Not a Controlled Substance
- I '$$CSRX(RXIEN) Q "1^"_$$GET1^DIQ(52,RXIEN,6)_" is not a Controlled Substance Drug.^E"
- ;
- ; Fills Administered in Clinic exclusion
- I $$ADMCLN(RXIEN,FILLNUM) Q "1^Prescription fill was administered in clinic.^E"
- ;
- ; Released prior to Transmission Authorization Date (02/11/2013)
- I $$RXRLDT^PSOBPSUT(RXIEN,FILLNUM),$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM)<3130211 Q "1^Prescription fill released before 02/11/2013.^E"
- ;
- ; Non-Veteran Patient Exclusion (Based on parameter)
- N STATE,DFN,VAEL
- S STATE=$$RXSTATE^PSOBPSUT(RXIEN,0)
- I '$$GET1^DIQ(58.41,STATE,2,"I") D I '$G(VAEL(4)) Q "1^Patient "_$$GET1^DIQ(52,RXIEN,2)_" is not a Veteran.^E"
- . S DFN=$$GET1^DIQ(52,RXIEN,2,"I") D ELIG^VADPT
- ;
- Q 0
- ;
- CSRX(RXIEN) ; Controlled Substance Rx?
- ; Input: RXIEN - PRESCRIPTION file (#52) pointer
- ;Output: $$CS - 1:YES / 0:NO
- N DRGIEN,DEA
- S DRGIEN=$$GET1^DIQ(52,RXIEN,6,"I") I 'DRGIEN Q 0
- S DEA=$$GET1^DIQ(50,DRGIEN,3)
- I (DEA'["0"),(DEA'["M"),(DEA["2")!(DEA["3")!(DEA["4")!(DEA["5") Q 1
- Q 0
- ;
- ADMCLN(RXIEN,FILL) ; Returns whether the fill was administered in clinic or not
- ; Input: (r) RXIEN - Rx IEN (#52)
- ; (o) FILL - Refill #
- ; Output: 1 - Yes (Administered in Clinic) / 0 - No
- N ADMCLN
- I '$G(RXIEN) Q 0
- I 'FILL S ADMCLN=+$$GET1^DIQ(52,RXIEN,14,"I")
- I FILL S ADMCLN=+$$GET1^DIQ(52.1,FILL_","_RXIEN,23,"I")
- Q ADMCLN
- ;
- SPOK(STATE) ; State Parameters OK?
- ; Input: STATE - STATE file (#5) pointer
- N ZNODE,FNODE,F1NODE,X,STATENAM
- S STATENAM=$$GET1^DIQ(5,+$G(STATE),.01)
- I '$D(^PS(58.41,+$G(STATE),0)) Q "-1^PMP parameters missing for "_STATENAM
- S ZNODE=$G(^PS(58.41,STATE,0))
- I $P(ZNODE,"^",2)="" Q "-1^ASAP Version missing for "_STATENAM
- I $P(ZNODE,"^",4)="" Q "-1^Reporting Frequency missing for "_STATENAM
- S FNODE=$G(^PS(58.41,STATE,"FILE"))
- S F1NODE=$G(^PS(58.41,STATE,"FILE1"))
- I $$OS^%ZOSV()["VMS",$P(FNODE,"^",1)="" Q "-1^Local VMS Directory missing for "_STATENAM
- I $$OS^%ZOSV()["UNIX",$P(F1NODE,"^",1)="" Q "-1^Local Unix/Linux Directory missing for "_STATENAM
- I $P(FNODE,"^",4)="" Q "-1^State FTP Server IP Address missing for "_STATENAM
- I $P(FNODE,"^",5)="" Q "-1^State FTP Server username missing for "_STATENAM
- I $P(ZNODE,"^",6)="A",'$O(^PS(58.41,STATE,"PRVKEY",0)) Q "-1^SSH Keys missing for "_STATENAM
- Q 1
- ;
- SETNAME(DFN) ; Set array variable PSONAME with Patient name
- N NCIEN K PSONAME
- S NCIEN=$$GET1^DIQ(2,DFN,1.01,"I")
- I NCIEN,$$GET1^DIQ(20,NCIEN,1)'="",$$GET1^DIQ(20,NCIEN,2)'="" D Q
- . S PSONAME("LAST")=$$GET1^DIQ(20,NCIEN,1)
- . S PSONAME("FIRST")=$$GET1^DIQ(20,NCIEN,2)
- . S PSONAME("MIDDLE")=$$GET1^DIQ(20,NCIEN,3)
- . S PSONAME("PREFIX")=$$GET1^DIQ(20,NCIEN,4)
- . S PSONAME("SUFFIX")=$$GET1^DIQ(20,NCIEN,5)
- ;
- S PSONAME("LAST")=$P($G(VADM(1)),",",1)
- S PSONAME("FIRST")=$P($P($G(VADM(1)),",",2)," ",1)
- S PSONAME("MIDDLE")=$P($P($G(VADM(1)),",",2)," ",2)
- S PSONAME("SUFFIX")=""
- S PSONAME("PREFIX")=""
- Q
- ;
- LOGERROR(BATCHIEN,STATEIEN,ERROR,BCKGRND,LOGFILE) ; Log/Display an error in the transmission
- ;Input: (r) BATCHIEN - Pointer to the SPMP EXPORT BATCH file (#58.42)
- ; (r) STATEIEN - Pointer ot the STATE file (#5)
- ; (r) ERROR - Error Text
- ; (r) BCKGRND - Background execution (1: Yes / 0: No)
- ; (o) LOGFILE - Filename of the file containing the sFTP Log (VMS only)
- I '$G(BCKGRND) W !!,ERROR,!,$C(7) Q
- ;
- ;Builds mail message and sends it to users of PSO SPMP NOTIFICATIONS mail group
- N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,PSOMSG,USR,STANAME,LINE
- ;
- S STANAME=$S($G(BATCHIEN):$$GET1^DIQ(58.42,BATCHIEN,1),1:$$GET1^DIQ(5,STATEIEN,.01))
- S XMSUB=STANAME_" Prescription Monitoring Program Transmission Failed"
- S XMDUZ="SPMP TRANSMISSION"
- S PSOMSG(1)="There was a problem with the transmission of information about Controlled"
- S PSOMSG(2)="Substance prescriptions to the "_STANAME_" State Prescription Monitoring"
- s PSOMSG(3)="Program (SPMP)."
- S PSOMSG(4)="",LINE=5
- I $G(BATCHIEN) D
- . S PSOMSG(LINE)="Batch #: "_BATCHIEN,LINE=LINE+1
- . I $$GET1^DIQ(58.42,BATCHIEN,4,"I") D
- . . S PSOMSG(LINE)="Period : "_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,4,"I")\1,"2Z")
- . . S PSOMSG(LINE)=PSOMSG(LINE)_" thru "_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,5,"I")\1,"2Z"),LINE=LINE+1
- . S PSOMSG(LINE)="Error : "_ERROR,LINE=LINE+1
- . S PSOMSG(LINE)="",LINE=LINE+1
- . S PSOMSG(LINE)="Please, use the option Export Batch Processing [PSO SPMP BATCH PROCESSING] to",LINE=LINE+1
- . S PSOMSG(LINE)="manually transmit this batch to the state.",LINE=LINE+1
- E S PSOMSG(LINE)="Error : "_ERROR,LINE=LINE+1
- S XMTEXT="PSOMSG("
- ;
- ; Loading the VMS Log into the Mailman Message
- I $G(LOGFILE)'="" D
- . N LOCDIR,FILEARR,LOG,XLOG
- . S LOCDIR=$$GET1^DIQ(58.41,+$$GET1^DIQ(58.42,BATCHIEN,1,"I"),$S($$OS^%ZOSV()["VMS":4,1:15)) I LOCDIR="" Q
- . I '$$FEXIST(LOCDIR,LOGFILE) Q
- . S PSOMSG(LINE)="",LINE=LINE+1
- . S PSOMSG(LINE)="sFTP Log:",LINE=LINE+1
- . S PSOMSG(LINE)="========",LINE=LINE+1
- . K ^TMP("PSOFTPLG",$J)
- . S XLOG=$$FTG^%ZISH(LOCDIR,LOGFILE,$NAME(^TMP("PSOFTPLG",$J,1)),3)
- . S LOG=0 F S LOG=$O(^TMP("PSOFTPLG",$J,LOG)) Q:LOG="" D
- . . S PSOMSG(LINE)=$G(^TMP("PSOFTPLG",$J,LOG)),LINE=LINE+1
- ;
- ; If there are no active members in the mailgroup sends message to PSDMGR key holders
- I $$GOTLOCAL^XMXAPIG("PSO SPMP NOTIFICATIONS") D
- . S XMY("G.PSO SPMP NOTIFICATIONS")=""
- E D
- . S USR=0 F S USR=$O(^XUSEC("PSDMGR",USR)) Q:'USR S XMY(USR)=""
- D ^XMD
- Q
- ;
- PREIEN(RECTYPE,RXIEN,FILLNUM) ; Returns the Provider IEN
- ;Input: RECTYPE - Record Type ('S': SEND, 'R': REVIEW, 'V': VOID)
- ; RXIEN - PRESCRIPTION file (#52) IEN
- ; FILLNUM - Fill Number
- Q +$S(RECTYPE="V"&($G(RTSDATA("PRVIEN"))):RTSDATA("PRVIEN"),1:$$RXPRV^PSOBPSUT(RXIEN,FILLNUM))
- ;
- RPHIEN(RECTYPE,RXIEN,FILLNUM) ; Returns the Pharmacist IEN
- ;Input: RECTYPE - Record Type ('S': SEND, 'R': REVIEW, 'V': VOID)
- ; RXIEN - PRESCRIPTION file (#52) IEN
- ; FILLNUM - Fill Number
- Q +$S(RECTYPE="V"&($G(RTSDATA("RPHIEN"))):RTSDATA("RPHIEN"),1:$$RXRPH^PSOBPSUT(RXIEN,FILLNUM))
- ;
- FEXIST(DIR,FILE) ; Check if a File exists
- ; Input: DIR - Name of the directory where the file is located
- ; FILE - Name of the file to be checked
- ;Output: $$FEXIST - 1 - File Exists / 0 - File Not Found
- N RETURN,FILEARR
- S FILEARR(FILE)=""
- Q +$$LIST^%ZISH(DIR,"FILEARR","RETURN")
- ;
- ESC(VALUE) ; Removes Control Characters from the Data Element Value
- N ESCVALUE,I
- S ESCVALUE=""
- F I=1:1:$L(VALUE) I $A(VALUE,I)>31,$A(VALUE,I)<127 S ESCVALUE=ESCVALUE_$E(VALUE,I)
- Q ESCVALUE
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSPMUT 19407 printed Jan 18, 2025@03:36:23 Page 2
- PSOSPMUT ;BIRM/MFR - State Prescription Monitoring Program Utilities ;10/07/12
- +1 ;;7.0;OUTPATIENT PHARMACY;**408,451,549,625,630**;DEC 1997;Build 26
- +2 ;
- EXPORT(BATCHIEN,MODE,BCKGRND,DEBUG,FLUSH) ; Export a SPMP Batch
- +1 ;Input: BATCHIEN - Pointer to #58.41
- +2 ; MODE - "VIEW" or "EXPORT"
- +3 ; BCKGRND - Background? (1:YES / 0:NO)
- +4 ; DEBUG - Debug Mode? (1:YES / 0:NO)
- +5 ; FLUSH - Flush host? (1:YES / 0:NO)
- +6 NEW X,RX,STATEIEN,PSOASVER,TRXTYPE,PSOTTCNT,PSOTPCNT,SITEIEN,RXIEN,FILLNUM,FILLIEN,PATIEN,DFN,VADM
- +7 NEW RTSDATA,DATETIME,VAPA,XX,ASAP,LOCDIR,EXPFILE,EXPFILE2,FTPFILE,INPTFILE,DIE,DR,DA,PSOFTPOK,FILES
- +8 NEW PSODELOK,PSOOS,RTSONLY,PSOSTIP,PSOSTUSR,PSONAME,PSOPORT,PSOAUTO,PSOSTDIR,PSOFLEXT,RENAME,DRUGIEN
- +9 NEW PREIEN,RPHIEN,RTSREC,RXNODE,ZRS,ZRNODE,DEA,PSOVER
- +10 SET BCKGRND=+$GET(BCKGRND)
- SET DEBUG=+$GET(DEBUG)
- SET FLUSH=+$GET(FLUSH)
- KILL ^TMP("PSOSPMEX",$JOB),ZRDEA
- +11 ;
- +12 IF +$$SPOK($$GET1^DIQ(58.42,BATCHIEN,1,"I"))=-1
- Begin DoDot:1
- +13 DO LOGERROR(BATCHIEN,0,$PIECE($$SPOK($$GET1^DIQ(58.42,BATCHIEN,1,"I")),"^",2),BCKGRND)
- End DoDot:1
- QUIT
- +14 ;
- +15 ; The LOCK below prevents two concurrent transmission processes from getting the same filename
- +16 FOR
- SET DATETIME=$PIECE($$FMTHL7^XLFDT($$HTFM^XLFDT($HOROLOG)),"-")
- LOCK +@("PMP"_DATETIME):0
- if $TEST
- QUIT
- HANG 2
- +17 ;
- +18 SET STATEIEN=$$GET1^DIQ(58.42,BATCHIEN,1,"I")
- +19 SET PSOASVER=$$GET1^DIQ(58.41,STATEIEN,1,"I")
- +20 ;Zero Reporting
- IF $$GET1^DIQ(58.42,BATCHIEN,2,"I")="ZR"
- SET PSOASVER=$$GET1^DIQ(58.41,STATEIEN,20)
- +21 SET PSOFLEXT=$$GET1^DIQ(58.41,STATEIEN,6)
- +22 SET RENAME=$$GET1^DIQ(58.41,STATEIEN,17,"I")
- +23 SET PSOSTIP=$$GET1^DIQ(58.41,STATEIEN,7)
- +24 SET PSOPORT=$$GET1^DIQ(58.41,STATEIEN,9)
- +25 ;
- +26 ; The commands below will first 'flush' and then add the IP Address to the known_hosts file
- +27 SET PSOVER=$$UP^XLFSTR($$VERSION^%ZOSV(1))
- +28 ;PSO*7*630
- IF MODE="EXPORT"
- IF $$OS^%ZOSV()="UNIX"
- IF (PSOVER["CACHE")!(PSOVER["IRIS")
- Begin DoDot:1
- +29 IF DEBUG
- IF FLUSH
- XECUTE "S PV=$ZF(-1,""ssh-keygen -R ""_PSOSTIP)"
- +30 XECUTE "S PV=$ZF(-1,""ssh -oBatchMode=yes -oStrictHostKeyChecking=no -oLogLevel=quiet"_$SELECT(PSOPORT:" -oPort="_PSOPORT,1:"")_" "_PSOSTIP_""")"
- End DoDot:1
- +31 ;
- +32 SET PSOSTUSR=$$GET1^DIQ(58.41,STATEIEN,8)
- +33 SET PSOSTDIR=$$GET1^DIQ(58.41,STATEIEN,10)
- +34 SET PSOAUTO=$SELECT($$GET1^DIQ(58.41,STATEIEN,13,"I")="A":1,1:0)
- +35 SET PSOOS=$$OS^%ZOSV()
- +36 ;
- +37 IF MODE="EXPORT"
- IF '$GET(BCKGRND)
- WRITE !!,"Exporting Batch #",BATCHIEN,":",!
- +38 ;
- +39 SET RX=0
- +40 FOR
- SET RX=$ORDER(^PS(58.42,BATCHIEN,"RX",RX))
- if 'RX
- QUIT
- Begin DoDot:1
- +41 SET RXNODE=^PS(58.42,BATCHIEN,"RX",RX,0)
- +42 SET RXIEN=+RXNODE
- SET FILLNUM=$PIECE(RXNODE,"^",2)
- SET PATIEN=$$GET1^DIQ(52,RXIEN,2,"I")
- +43 IF MODE="EXPORT"
- IF $PIECE(RXNODE,"^",3)'="V"
- IF '$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM)
- QUIT
- +44 ; PSO*7*625:PSU-14 - Allow VOID Export of Released Prescriptions in RX Batch Only
- +45 ; PSO*7*625:PSU-14
- IF MODE="EXPORT"
- IF $PIECE(RXNODE,"^",3)="V"
- IF $$RXRLDT^PSOBPSUT(RXIEN,FILLNUM)
- IF ($$GET1^DIQ(58.42,BATCHIEN,2,"I")'="RX")
- QUIT
- +46 ; Always the Pharmacy Division for the Original Fill
- +47 SET SITEIEN=$$RXSITE^PSOBPSUT(RXIEN,0)
- +48 SET ^TMP("PSOSPMEX",$JOB,SITEIEN,PATIEN,RXIEN,FILLNUM)=$PIECE(RXNODE,"^",3)
- End DoDot:1
- +49 ;
- +50 ;Zero report
- IF $$GET1^DIQ(58.41,STATEIEN,20)'=""
- IF $$GET1^DIQ(58.42,BATCHIEN,2,"I")="ZR"
- Begin DoDot:1
- +51 SET ZRS=0
- SET SITEIEN=""
- +52 FOR
- SET ZRS=$ORDER(^PS(58.42,BATCHIEN,"ZRS",ZRS))
- if 'ZRS
- QUIT
- Begin DoDot:2
- +53 SET ZRNODE=^PS(58.42,BATCHIEN,"ZRS",ZRS,0)
- +54 SET SITEIEN=+ZRNODE
- SET DEA=$PIECE(ZRNODE,"^",2)
- +55 SET ZRDEA(DEA)=SITEIEN
- End DoDot:2
- +56 NEW DEA
- SET (DEA,SITEIEN)=""
- +57 FOR
- SET DEA=$ORDER(ZRDEA(DEA))
- if DEA=""
- QUIT
- Begin DoDot:2
- +58 SET SITEIEN=ZRDEA(DEA)
- SET ^TMP("PSOSPMEX",$JOB,SITEIEN)=""
- End DoDot:2
- End DoDot:1
- +59 ;
- +60 IF '$DATA(^TMP("PSOSPMEX",$JOB))
- Begin DoDot:1
- +61 DO LOGERROR(BATCHIEN,0,"There were no eligible prescriptions in the batch #"_BATCHIEN,BCKGRND)
- End DoDot:1
- LOCK -@("PMP"_DATETIME)
- QUIT
- +62 ;
- +63 IF MODE="VIEW"
- IF PSOASVER'="1995"
- SET XX=""
- SET $PIECE(XX,"-",80)=""
- WRITE !,XX,!
- +64 IF MODE="EXPORT"
- Begin DoDot:1
- +65 SET RTSONLY=0
- IF $$GET1^DIQ(58.42,BATCHIEN,2,"I")="VD"
- SET RTSONLY=1
- +66 IF PSOOS["VMS"
- SET LOCDIR=$$GET1^DIQ(58.41,STATEIEN,4)
- +67 IF PSOOS["UNIX"
- Begin DoDot:2
- +68 SET LOCDIR=$$GET1^DIQ(58.41,STATEIEN,15)
- +69 IF '$$DIREXIST^PSOSPMU1(LOCDIR)
- DO MAKEDIR^PSOSPMU1(LOCDIR)
- End DoDot:2
- +70 SET FILES=$$PREPFILE^PSOSPMU1(STATEIEN,DATETIME,RTSONLY,DEBUG)
- +71 IF $PIECE(FILES,"^",1)=-1
- DO LOGERROR(BATCHIEN,0,$PIECE(FILES,"^",2),BCKGRND)
- QUIT
- +72 SET EXPFILE=$PIECE(FILES,"^",2)
- +73 SET FTPFILE=$PIECE(FILES,"^",3)
- +74 SET INPTFILE=$PIECE(FILES,"^",4)
- +75 SET LOGFILE=$PIECE(FILES,"^",5)
- +76 SET EXPFILE2=$PIECE(FILES,"^",6)
- +77 IF 'BCKGRND
- WRITE !,$SELECT('PSOAUTO:"Step 1: ",1:""),"Writing to file ",LOCDIR_EXPFILE,"..."
- +78 DO OPEN^%ZISH("EXPFILE",LOCDIR,EXPFILE,"W")
- +79 IF POP
- DO LOGERROR(BATCHIEN,0,"Export File <"_LOCDIR_EXPFILE_"> could not be created.",BCKGRND)
- SET FILES=-1
- QUIT
- +80 DO USE^%ZISUTL("EXPFILE")
- End DoDot:1
- IF $PIECE(FILES,"^",1)=-1
- LOCK -@("PMP"_DATETIME)
- QUIT
- +81 ;----------------------------- ASAP Data Output (1995) -------------------------------
- +82 IF PSOASVER="1995"
- Begin DoDot:1
- +83 SET (SITEIEN,PATIEN,RXIEN)=0
- +84 FOR
- SET SITEIEN=$ORDER(^TMP("PSOSPMEX",$JOB,SITEIEN))
- if 'SITEIEN
- QUIT
- Begin DoDot:2
- +85 FOR
- SET PATIEN=$ORDER(^TMP("PSOSPMEX",$JOB,SITEIEN,PATIEN))
- if 'PATIEN
- QUIT
- Begin DoDot:3
- +86 KILL VADM,VAPA,PSONAME
- SET DFN=PATIEN
- DO DEM^VADPT
- DO ADD^VADPT
- DO SETNAME(PATIEN)
- +87 FOR
- SET RXIEN=$ORDER(^TMP("PSOSPMEX",$JOB,SITEIEN,PATIEN,RXIEN))
- if 'RXIEN
- QUIT
- Begin DoDot:4
- +88 SET FILLNUM=""
- +89 FOR
- SET FILLNUM=$ORDER(^TMP("PSOSPMEX",$JOB,SITEIEN,PATIEN,RXIEN,FILLNUM))
- if FILLNUM=""
- QUIT
- Begin DoDot:5
- +90 SET RECTYPE=^TMP("PSOSPMEX",$JOB,SITEIEN,PATIEN,RXIEN,FILLNUM)
- +91 KILL RTSDATA
- IF RECTYPE="V"
- DO LOADRTS^PSOSPMU1(RXIEN,FILLNUM,.RTSDATA)
- +92 WRITE $$ASAP95^PSOASAP0(RXIEN,+FILLNUM),!
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +93 ;------------------------- ASAP Data Output (3.0 and above) --------------------------
- +94 IF PSOASVER'="1995"
- Begin DoDot:1
- +95 SET TRXTYPE="S"
- SET PSOTTCNT=0
- +96 DO LOADASAP^PSOSPMU0(PSOASVER,"B",.ASAP)
- +97 SET (SITEIEN,PATIEN,RXIEN)=0
- +98 ;Writing Level 1: Transaction Header, Information Source
- +99 DO WRITELEV(1,"ASAP")
- +100 FOR
- SET SITEIEN=$ORDER(^TMP("PSOSPMEX",$JOB,SITEIEN))
- if 'SITEIEN
- QUIT
- Begin DoDot:2
- +101 SET PSOTPCNT=0
- +102 ;Writing Level 2: Pharmacy Header
- +103 DO WRITELEV(2,"ASAP")
- +104 ;Zero Reporting
- +105 IF $$GET1^DIQ(58.42,BATCHIEN,2,"I")="ZR"
- Begin DoDot:3
- +106 ;Zero Reporting Writing Level 3: Patient Detail
- +107 DO WRITELEV(3,"ASAP")
- +108 ;Zero Reporting Writing Level 4: Prescription Detail
- +109 DO WRITELEV(4,"ASAP")
- End DoDot:3
- +110 FOR
- SET PATIEN=$ORDER(^TMP("PSOSPMEX",$JOB,SITEIEN,PATIEN))
- if 'PATIEN
- QUIT
- Begin DoDot:3
- +111 KILL VADM,VAPA,PSONAME
- SET DFN=PATIEN
- DO DEM^VADPT
- DO ADD^VADPT
- DO SETNAME(PATIEN)
- +112 SET (DRUGIEN,FILLNUM,FILLIEN,PREIEN,RPHIEN,RTSREC)=0
- +113 ;Writing Level 3: Patient Detail
- +114 DO WRITELEV(3,"ASAP")
- +115 FOR
- SET RXIEN=$ORDER(^TMP("PSOSPMEX",$JOB,SITEIEN,PATIEN,RXIEN))
- if 'RXIEN
- QUIT
- Begin DoDot:4
- +116 SET FILLNUM=""
- SET DRUGIEN=$$GET1^DIQ(52,RXIEN,6,"I")
- +117 FOR
- SET FILLNUM=$ORDER(^TMP("PSOSPMEX",$JOB,SITEIEN,PATIEN,RXIEN,FILLNUM))
- if FILLNUM=""
- QUIT
- Begin DoDot:5
- +118 SET FILLIEN=$SELECT(FILLNUM["P":+$PIECE(FILLNUM,"P",2),1:+FILLNUM)
- +119 SET RECTYPE=^TMP("PSOSPMEX",$JOB,SITEIEN,PATIEN,RXIEN,FILLNUM)
- +120 SET PREIEN=$$PREIEN(RECTYPE,RXIEN,FILLNUM)
- +121 SET RPHIEN=$$RPHIEN(RECTYPE,RXIEN,FILLNUM)
- +122 SET RTSREC=0
- KILL RTSDATA
- IF RECTYPE="V"
- SET RTSREC=1
- DO LOADRTS^PSOSPMU1(RXIEN,FILLNUM,.RTSDATA)
- +123 ;Writing Level 4: Prescription Detail
- +124 DO WRITELEV(4,"ASAP")
- End DoDot:5
- End DoDot:4
- End DoDot:3
- +125 ;Writing Level 5: Pharmacy Trailer
- +126 DO WRITELEV(5,"ASAP")
- End DoDot:2
- +127 ;Writing Level 6: Transaction Trailer
- +128 DO WRITELEV(6,"ASAP")
- End DoDot:1
- +129 ; Close the file
- +130 IF MODE="EXPORT"
- DO CLOSE^%ZISH("EXPFILE")
- IF 'BCKGRND
- WRITE "Done."
- +131 ;------------------------- sFTP Transmission to the State -----------------------------
- +132 IF MODE="VIEW"
- IF PSOASVER'="1995"
- SET XX=""
- SET $PIECE(XX,"-",80)=""
- WRITE !,XX
- +133 SET (PSOFTPOK,PSODELOK)=""
- +134 IF MODE="EXPORT"
- Begin DoDot:1
- +135 ; Automated Transmission (RSA keys)
- +136 IF PSOAUTO
- Begin DoDot:2
- +137 IF 'BCKGRND
- WRITE !!,"Transmitting file to the State (",$$GET1^DIQ(58.41,STATEIEN,7),")...",!
- +138 SET PSOFTPOK=$$FTPFILE^PSOSPMU1(PSOSTIP,PSOSTUSR,LOCDIR,FTPFILE,EXPFILE,INPTFILE,LOGFILE,PSOPORT,DEBUG)
- End DoDot:2
- +139 ; Manual Transmission (Password)
- +140 KILL DTOUT,DUOUT
- +141 IF 'PSOAUTO
- Begin DoDot:2
- +142 WRITE !!,"Step 2: Copy the "_$SELECT(PSOSTDIR'="":"four",1:"three")_" lines of text below into the clipboard (highlight the"
- +143 WRITE !?8,"lines then right-click the mouse and select 'Copy').",!
- +144 if $GET(PSOSTDIR)'=""
- WRITE !,"cd "_PSOSTDIR
- +145 WRITE !,"put "_$SELECT(PSOOS["VMS":$$XVMSDIR^PSOSPMU1(LOCDIR),1:LOCDIR)_EXPFILE
- +146 if $GET(RENAME)
- WRITE !,"rename "_EXPFILE_" "_$PIECE(EXPFILE,".up",1)_PSOFLEXT
- +147 WRITE !,"exit",!
- +148 KILL DIR,DTOUT,DUOUT
- SET DIR(0)="E"
- SET DIR("A")="Then press <RETURN> to go to the next step."
- DO ^DIR
- IF $GET(DTOUT)!$GET(DUOUT)
- QUIT
- +149 WRITE !!,"Step 3: Enter the sFTP password and press <RETURN>"
- +150 WRITE !!,"Step 4: Once you get the 'sftp>' prompt, paste the text copied on step 2"
- +151 WRITE !?8,"(right-click the mouse and select 'Paste').",!!
- +152 NEW XPV1,PV
- SET XPV1="S PV=$ZF(-1,""sftp"_$SELECT(PSOPORT:" -oPort="_PSOPORT,1:"")_" -oUser="_$TRANSLATE(PSOSTUSR,"""","")_" "_PSOSTIP_""")"
- +153 XECUTE XPV1
- End DoDot:2
- +154 IF $PIECE(PSOFTPOK,"^",1)=-1
- DO LOGERROR(BATCHIEN,0,$PIECE(PSOFTPOK,"^",2),BCKGRND,$GET(LOGFILE))
- +155 ;Deleting files
- +156 DO DELFILES^PSOSPMU1($GET(LOCDIR),$GET(EXPFILE),$GET(INPTFILE),$GET(FTPFILE),$GET(LOGFILE))
- +157 IF $PIECE(PSOFTPOK,"^",1)=-1
- QUIT
- +158 IF 'PSOAUTO
- IF $GET(DTOUT)!$GET(DUOUT)
- QUIT
- +159 IF 'BCKGRND
- IF PSOAUTO
- HANG 1
- WRITE !!,"File Successfully Transmitted.",!
- +160 IF 'PSOAUTO
- Begin DoDot:2
- +161 KILL DIR
- SET DIR("A")="Was the file transmitted successfully"
- SET DIR(0)="Y"
- SET DIR("B")="N"
- +162 DO ^DIR
- End DoDot:2
- IF $GET(DTOUT)!$GET(DUOUT)!'Y
- QUIT
- +163 SET DIE="^PS(58.42,"
- SET DA=BATCHIEN
- SET DR="6///"_EXPFILE2_";7////"_DUZ_";9///"_$$NOW^XLFDT()
- DO ^DIE
- End DoDot:1
- +164 WRITE !
- LOCK -@("PMP"_DATETIME)
- +165 QUIT
- +166 ;
- WRITELEV(LEVEL,ARRAY) ; Write the ASAP Segments for each Level
- +1 ;Input: LEVEL - ASAP level to print (1:Header, 2:Pharmacy, ...)
- +2 ; ARRAY - Name of the Array containing the ASAP Data Definition (e.g., "ASAP")
- +3 NEW NODE,SEGID,SEG0
- +4 SET NODE=ARRAY
- +5 FOR
- SET NODE=$QUERY(@NODE)
- if NODE=""!($EXTRACT(NODE,$FIND(NODE,"("))'?1N)
- QUIT
- Begin DoDot:1
- +6 SET SEGID=@NODE
- IF SEGID=""
- QUIT
- +7 SET SEG0=$GET(@(ARRAY_"("""_SEGID_""")"))
- +8 ; Segment not in the Level
- +9 IF $PIECE(SEG0,"^",6)'=LEVEL
- QUIT
- +10 ; Segment Marked NOT USED
- +11 IF $PIECE(SEG0,"^",4)="N"
- QUIT
- +12 DO WRITESEG(SEGID,LEVEL,ARRAY)
- End DoDot:1
- +13 QUIT
- +14 ;
- WRITESEG(SEGID,LEVEL,ARRAY) ; Write the ASAP segment to the file
- +1 ;Input: SEGID - ASAP Segment ID (e.g., "TH", "PAT", "DSP", ...)
- +2 ; LEVEL - ASAP level to print (1:Header, 2:Pharmacy, ...)
- +3 ; ARRAY - Name of the Array containing the ASAP Data Definition (e.g., "ASAP")
- +4 NEW ELMPOS,LASTELEM
- +5 IF '$DATA(@ARRAY@(SEGID))
- QUIT
- +6 IF $GET(MODE)="VIEW"
- IF $PIECE(@ARRAY,"^",4)'=""
- WRITE ?$SELECT(LEVEL<5:((LEVEL-1)*3),LEVEL=5:3,1:0)
- +7 SET LASTELEM=+$ORDER(@ARRAY@(SEGID,""),-1)
- +8 WRITE SEGID
- DO SEGCOUNT(LEVEL)
- +9 FOR ELMPOS=1:1:LASTELEM
- Begin DoDot:1
- +10 ;Skipping Last Element if marked NOT USED (to solve issue with TH09 for 4.0 and TH13 for 3.0)
- +11 IF ELMPOS=LASTELEM
- IF $PIECE(@ARRAY@(SEGID,ELMPOS),"^",6)="N"
- QUIT
- +12 ;Data Element Delimiter Char
- +13 WRITE $PIECE(@ARRAY,"^",2)
- +14 ; ASAP Data Element Marked NOT USED
- +15 IF $PIECE(@ARRAY@(SEGID,ELMPOS),"^",6)="N"
- QUIT
- +16 ; Writing Data Element Content to the file
- +17 DO WRITEELM(SEGID,ELMPOS,ARRAY)
- End DoDot:1
- +18 ; Segment Terminator Character
- +19 WRITE $PIECE(@ARRAY,"^",3)
- +20 ; End of Segment Control Char(s) (e.g., Line-Feed ($C(10)), Carriage-Return ($C(13)),etc.)
- +21 if $PIECE(@ARRAY,"^",4)'=""
- WRITE @($PIECE(@ARRAY,"^",4))
- +22 QUIT
- +23 ;
- WRITEELM(SEGID,ELMPOS,ARRAY) ; Write the ASAP Data Element to file
- +1 ;Input: SEGID - ASAP Segment ID (e.g., "TH", "PAT", "DSP", ...)
- +2 ; ELMPOS - ASAP Data Element Position (1, 2, 3, ...)
- +3 ; ARRAY - Name of the Array containing the ASAP Data Definition (e.g., "ASAP")
- +4 NEW MEXPR,GETVALUE,VALUE,MAXLEN
- +5 SET MEXPR=$GET(@ARRAY@(SEGID,ELMPOS,"VAL",1))
- +6 ; Rechecking the M Expression value for Security purposes
- +7 IF '$$VALID^PSOSPMU3($PIECE(@ARRAY,"^"),MEXPR)
- WRITE "?"
- QUIT
- +8 ; Retrieving and executing the M code for retrieving the ASAP Data Element value
- +9 Begin DoDot:1
- +10 NEW $ETRAP,$ESTACK
- SET $ETRAP="D ERROR^PSOSPMUT"
- +11 SET GETVALUE="S VALUE="_MEXPR
- XECUTE GETVALUE
- End DoDot:1
- +12 ; Removing Control Characters from the Data Element Value
- +13 SET VALUE=$$ESC(VALUE)
- +14 ; Triming Value according to the Data Element Maximum Length
- +15 SET MAXLEN=$PIECE($GET(@ARRAY@(SEGID,ELMPOS)),"^",4)
- if MAXLEN>0
- SET VALUE=$EXTRACT(VALUE,1,MAXLEN)
- +16 ; Replacing characters that match Segment Delimiter chars with "?"
- +17 IF MAXLEN>1
- IF VALUE'=$PIECE(@ARRAY,"^",3)
- SET VALUE=$TRANSLATE(VALUE,$PIECE(@ARRAY,"^",3),"?")
- +18 ; Replacing characters that match Data Element Delimiter chars with "?"
- +19 IF MAXLEN>1
- IF VALUE'=$PIECE(@ARRAY,"^",2)
- SET VALUE=$TRANSLATE(VALUE,$PIECE(@ARRAY,"^",2),"?")
- +20 ; Writing the Data Element Value
- +21 WRITE VALUE
- +22 QUIT
- +23 ;
- SEGCOUNT(LEVEL) ; Keeps track of Segment Count for TP and TT info
- +1 ;Input: LEVEL - Level of the Segment where the Data Element is located
- +2 ; TT Segment Count
- +3 SET PSOTTCNT=$GET(PSOTTCNT)+1
- +4 ; TP Segment Count
- +5 IF LEVEL'=1
- IF LEVEL'=6
- SET PSOTPCNT=$GET(PSOTPCNT)+1
- +6 QUIT
- +7 ;
- ERROR ; Error Trap Handling to catch errors on user-entered M SET expressions
- +1 NEW ERROR
- +2 DO CLOSE^%ZISH("EXPFILE")
- +3 SET ERROR="ASAP Data Element: "_$GET(SEGID)_$EXTRACT(100+$GET(ELMPOS),2,3)_" M Expression: "_$GET(MEXPR)_" Error: "_$$EC^%ZOSV
- +4 DO LOGERROR($GET(BATCHIEN),0,ERROR,$GET(BCKGRND))
- +5 DO DELFILES^PSOSPMU1($GET(LOCDIR),$GET(EXPFILE),$GET(INPTFILE),$GET(FTPFILE))
- +6 QUIT
- +7 ;
- SCREEN(RXIEN,FILLNUM) ; Screens Rx's from being sent to the State
- +1 ; Input: RXIEN - PRESCRIPTION file (#52) IEN
- +2 ; FILLNUM - Fill Number
- +3 ;Output: $$SCREEN - 1:YES/0:NO^Error/Warning Message^E:Error/W:Warning
- +4 ;
- +5 ; Not a Controlled Substance
- +6 IF '$$CSRX(RXIEN)
- QUIT "1^"_$$GET1^DIQ(52,RXIEN,6)_" is not a Controlled Substance Drug.^E"
- +7 ;
- +8 ; Fills Administered in Clinic exclusion
- +9 IF $$ADMCLN(RXIEN,FILLNUM)
- QUIT "1^Prescription fill was administered in clinic.^E"
- +10 ;
- +11 ; Released prior to Transmission Authorization Date (02/11/2013)
- +12 IF $$RXRLDT^PSOBPSUT(RXIEN,FILLNUM)
- IF $$RXRLDT^PSOBPSUT(RXIEN,FILLNUM)<3130211
- QUIT "1^Prescription fill released before 02/11/2013.^E"
- +13 ;
- +14 ; Non-Veteran Patient Exclusion (Based on parameter)
- +15 NEW STATE,DFN,VAEL
- +16 SET STATE=$$RXSTATE^PSOBPSUT(RXIEN,0)
- +17 IF '$$GET1^DIQ(58.41,STATE,2,"I")
- Begin DoDot:1
- +18 SET DFN=$$GET1^DIQ(52,RXIEN,2,"I")
- DO ELIG^VADPT
- End DoDot:1
- IF '$GET(VAEL(4))
- QUIT "1^Patient "_$$GET1^DIQ(52,RXIEN,2)_" is not a Veteran.^E"
- +19 ;
- +20 QUIT 0
- +21 ;
- CSRX(RXIEN) ; Controlled Substance Rx?
- +1 ; Input: RXIEN - PRESCRIPTION file (#52) pointer
- +2 ;Output: $$CS - 1:YES / 0:NO
- +3 NEW DRGIEN,DEA
- +4 SET DRGIEN=$$GET1^DIQ(52,RXIEN,6,"I")
- IF 'DRGIEN
- QUIT 0
- +5 SET DEA=$$GET1^DIQ(50,DRGIEN,3)
- +6 IF (DEA'["0")
- IF (DEA'["M")
- IF (DEA["2")!(DEA["3")!(DEA["4")!(DEA["5")
- QUIT 1
- +7 QUIT 0
- +8 ;
- ADMCLN(RXIEN,FILL) ; Returns whether the fill was administered in clinic or not
- +1 ; Input: (r) RXIEN - Rx IEN (#52)
- +2 ; (o) FILL - Refill #
- +3 ; Output: 1 - Yes (Administered in Clinic) / 0 - No
- +4 NEW ADMCLN
- +5 IF '$GET(RXIEN)
- QUIT 0
- +6 IF 'FILL
- SET ADMCLN=+$$GET1^DIQ(52,RXIEN,14,"I")
- +7 IF FILL
- SET ADMCLN=+$$GET1^DIQ(52.1,FILL_","_RXIEN,23,"I")
- +8 QUIT ADMCLN
- +9 ;
- SPOK(STATE) ; State Parameters OK?
- +1 ; Input: STATE - STATE file (#5) pointer
- +2 NEW ZNODE,FNODE,F1NODE,X,STATENAM
- +3 SET STATENAM=$$GET1^DIQ(5,+$GET(STATE),.01)
- +4 IF '$DATA(^PS(58.41,+$GET(STATE),0))
- QUIT "-1^PMP parameters missing for "_STATENAM
- +5 SET ZNODE=$GET(^PS(58.41,STATE,0))
- +6 IF $PIECE(ZNODE,"^",2)=""
- QUIT "-1^ASAP Version missing for "_STATENAM
- +7 IF $PIECE(ZNODE,"^",4)=""
- QUIT "-1^Reporting Frequency missing for "_STATENAM
- +8 SET FNODE=$GET(^PS(58.41,STATE,"FILE"))
- +9 SET F1NODE=$GET(^PS(58.41,STATE,"FILE1"))
- +10 IF $$OS^%ZOSV()["VMS"
- IF $PIECE(FNODE,"^",1)=""
- QUIT "-1^Local VMS Directory missing for "_STATENAM
- +11 IF $$OS^%ZOSV()["UNIX"
- IF $PIECE(F1NODE,"^",1)=""
- QUIT "-1^Local Unix/Linux Directory missing for "_STATENAM
- +12 IF $PIECE(FNODE,"^",4)=""
- QUIT "-1^State FTP Server IP Address missing for "_STATENAM
- +13 IF $PIECE(FNODE,"^",5)=""
- QUIT "-1^State FTP Server username missing for "_STATENAM
- +14 IF $PIECE(ZNODE,"^",6)="A"
- IF '$ORDER(^PS(58.41,STATE,"PRVKEY",0))
- QUIT "-1^SSH Keys missing for "_STATENAM
- +15 QUIT 1
- +16 ;
- SETNAME(DFN) ; Set array variable PSONAME with Patient name
- +1 NEW NCIEN
- KILL PSONAME
- +2 SET NCIEN=$$GET1^DIQ(2,DFN,1.01,"I")
- +3 IF NCIEN
- IF $$GET1^DIQ(20,NCIEN,1)'=""
- IF $$GET1^DIQ(20,NCIEN,2)'=""
- Begin DoDot:1
- +4 SET PSONAME("LAST")=$$GET1^DIQ(20,NCIEN,1)
- +5 SET PSONAME("FIRST")=$$GET1^DIQ(20,NCIEN,2)
- +6 SET PSONAME("MIDDLE")=$$GET1^DIQ(20,NCIEN,3)
- +7 SET PSONAME("PREFIX")=$$GET1^DIQ(20,NCIEN,4)
- +8 SET PSONAME("SUFFIX")=$$GET1^DIQ(20,NCIEN,5)
- End DoDot:1
- QUIT
- +9 ;
- +10 SET PSONAME("LAST")=$PIECE($GET(VADM(1)),",",1)
- +11 SET PSONAME("FIRST")=$PIECE($PIECE($GET(VADM(1)),",",2)," ",1)
- +12 SET PSONAME("MIDDLE")=$PIECE($PIECE($GET(VADM(1)),",",2)," ",2)
- +13 SET PSONAME("SUFFIX")=""
- +14 SET PSONAME("PREFIX")=""
- +15 QUIT
- +16 ;
- LOGERROR(BATCHIEN,STATEIEN,ERROR,BCKGRND,LOGFILE) ; Log/Display an error in the transmission
- +1 ;Input: (r) BATCHIEN - Pointer to the SPMP EXPORT BATCH file (#58.42)
- +2 ; (r) STATEIEN - Pointer ot the STATE file (#5)
- +3 ; (r) ERROR - Error Text
- +4 ; (r) BCKGRND - Background execution (1: Yes / 0: No)
- +5 ; (o) LOGFILE - Filename of the file containing the sFTP Log (VMS only)
- +6 IF '$GET(BCKGRND)
- WRITE !!,ERROR,!,$CHAR(7)
- QUIT
- +7 ;
- +8 ;Builds mail message and sends it to users of PSO SPMP NOTIFICATIONS mail group
- +9 NEW XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,PSOMSG,USR,STANAME,LINE
- +10 ;
- +11 SET STANAME=$SELECT($GET(BATCHIEN):$$GET1^DIQ(58.42,BATCHIEN,1),1:$$GET1^DIQ(5,STATEIEN,.01))
- +12 SET XMSUB=STANAME_" Prescription Monitoring Program Transmission Failed"
- +13 SET XMDUZ="SPMP TRANSMISSION"
- +14 SET PSOMSG(1)="There was a problem with the transmission of information about Controlled"
- +15 SET PSOMSG(2)="Substance prescriptions to the "_STANAME_" State Prescription Monitoring"
- +16 SET PSOMSG(3)="Program (SPMP)."
- +17 SET PSOMSG(4)=""
- SET LINE=5
- +18 IF $GET(BATCHIEN)
- Begin DoDot:1
- +19 SET PSOMSG(LINE)="Batch #: "_BATCHIEN
- SET LINE=LINE+1
- +20 IF $$GET1^DIQ(58.42,BATCHIEN,4,"I")
- Begin DoDot:2
- +21 SET PSOMSG(LINE)="Period : "_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,4,"I")\1,"2Z")
- +22 SET PSOMSG(LINE)=PSOMSG(LINE)_" thru "_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,5,"I")\1,"2Z")
- SET LINE=LINE+1
- End DoDot:2
- +23 SET PSOMSG(LINE)="Error : "_ERROR
- SET LINE=LINE+1
- +24 SET PSOMSG(LINE)=""
- SET LINE=LINE+1
- +25 SET PSOMSG(LINE)="Please, use the option Export Batch Processing [PSO SPMP BATCH PROCESSING] to"
- SET LINE=LINE+1
- +26 SET PSOMSG(LINE)="manually transmit this batch to the state."
- SET LINE=LINE+1
- End DoDot:1
- +27 IF '$TEST
- SET PSOMSG(LINE)="Error : "_ERROR
- SET LINE=LINE+1
- +28 SET XMTEXT="PSOMSG("
- +29 ;
- +30 ; Loading the VMS Log into the Mailman Message
- +31 IF $GET(LOGFILE)'=""
- Begin DoDot:1
- +32 NEW LOCDIR,FILEARR,LOG,XLOG
- +33 SET LOCDIR=$$GET1^DIQ(58.41,+$$GET1^DIQ(58.42,BATCHIEN,1,"I"),$SELECT($$OS^%ZOSV()["VMS":4,1:15))
- IF LOCDIR=""
- QUIT
- +34 IF '$$FEXIST(LOCDIR,LOGFILE)
- QUIT
- +35 SET PSOMSG(LINE)=""
- SET LINE=LINE+1
- +36 SET PSOMSG(LINE)="sFTP Log:"
- SET LINE=LINE+1
- +37 SET PSOMSG(LINE)="========"
- SET LINE=LINE+1
- +38 KILL ^TMP("PSOFTPLG",$JOB)
- +39 SET XLOG=$$FTG^%ZISH(LOCDIR,LOGFILE,$NAME(^TMP("PSOFTPLG",$JOB,1)),3)
- +40 SET LOG=0
- FOR
- SET LOG=$ORDER(^TMP("PSOFTPLG",$JOB,LOG))
- if LOG=""
- QUIT
- Begin DoDot:2
- +41 SET PSOMSG(LINE)=$GET(^TMP("PSOFTPLG",$JOB,LOG))
- SET LINE=LINE+1
- End DoDot:2
- End DoDot:1
- +42 ;
- +43 ; If there are no active members in the mailgroup sends message to PSDMGR key holders
- +44 IF $$GOTLOCAL^XMXAPIG("PSO SPMP NOTIFICATIONS")
- Begin DoDot:1
- +45 SET XMY("G.PSO SPMP NOTIFICATIONS")=""
- End DoDot:1
- +46 IF '$TEST
- Begin DoDot:1
- +47 SET USR=0
- FOR
- SET USR=$ORDER(^XUSEC("PSDMGR",USR))
- if 'USR
- QUIT
- SET XMY(USR)=""
- End DoDot:1
- +48 DO ^XMD
- +49 QUIT
- +50 ;
- PREIEN(RECTYPE,RXIEN,FILLNUM) ; Returns the Provider IEN
- +1 ;Input: RECTYPE - Record Type ('S': SEND, 'R': REVIEW, 'V': VOID)
- +2 ; RXIEN - PRESCRIPTION file (#52) IEN
- +3 ; FILLNUM - Fill Number
- +4 QUIT +$SELECT(RECTYPE="V"&($GET(RTSDATA("PRVIEN"))):RTSDATA("PRVIEN"),1:$$RXPRV^PSOBPSUT(RXIEN,FILLNUM))
- +5 ;
- RPHIEN(RECTYPE,RXIEN,FILLNUM) ; Returns the Pharmacist IEN
- +1 ;Input: RECTYPE - Record Type ('S': SEND, 'R': REVIEW, 'V': VOID)
- +2 ; RXIEN - PRESCRIPTION file (#52) IEN
- +3 ; FILLNUM - Fill Number
- +4 QUIT +$SELECT(RECTYPE="V"&($GET(RTSDATA("RPHIEN"))):RTSDATA("RPHIEN"),1:$$RXRPH^PSOBPSUT(RXIEN,FILLNUM))
- +5 ;
- FEXIST(DIR,FILE) ; Check if a File exists
- +1 ; Input: DIR - Name of the directory where the file is located
- +2 ; FILE - Name of the file to be checked
- +3 ;Output: $$FEXIST - 1 - File Exists / 0 - File Not Found
- +4 NEW RETURN,FILEARR
- +5 SET FILEARR(FILE)=""
- +6 QUIT +$$LIST^%ZISH(DIR,"FILEARR","RETURN")
- +7 ;
- ESC(VALUE) ; Removes Control Characters from the Data Element Value
- +1 NEW ESCVALUE,I
- +2 SET ESCVALUE=""
- +3 FOR I=1:1:$LENGTH(VALUE)
- IF $ASCII(VALUE,I)>31
- IF $ASCII(VALUE,I)<127
- SET ESCVALUE=ESCVALUE_$EXTRACT(VALUE,I)
- +4 QUIT ESCVALUE