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

PSOSPMUT.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. EXPORT(BATCHIEN,MODE,BCKGRND,DEBUG,FLUSH) ; Export a SPMP Batch
  1. ;Input: BATCHIEN - Pointer to #58.41
  1. ; MODE - "VIEW" or "EXPORT"
  1. ; BCKGRND - Background? (1:YES / 0:NO)
  1. ; DEBUG - Debug Mode? (1:YES / 0:NO)
  1. ; FLUSH - Flush host? (1:YES / 0:NO)
  1. N X,RX,STATEIEN,PSOASVER,TRXTYPE,PSOTTCNT,PSOTPCNT,SITEIEN,RXIEN,FILLNUM,FILLIEN,PATIEN,DFN,VADM
  1. N RTSDATA,DATETIME,VAPA,XX,ASAP,LOCDIR,EXPFILE,EXPFILE2,FTPFILE,INPTFILE,DIE,DR,DA,PSOFTPOK,FILES
  1. N PSODELOK,PSOOS,RTSONLY,PSOSTIP,PSOSTUSR,PSONAME,PSOPORT,PSOAUTO,PSOSTDIR,PSOFLEXT,RENAME,DRUGIEN
  1. N PREIEN,RPHIEN,RTSREC,RXNODE,ZRS,ZRNODE,DEA,PSOVER
  1. S BCKGRND=+$G(BCKGRND),DEBUG=+$G(DEBUG),FLUSH=+$G(FLUSH) K ^TMP("PSOSPMEX",$J),ZRDEA
  1. ;
  1. I +$$SPOK($$GET1^DIQ(58.42,BATCHIEN,1,"I"))=-1 D Q
  1. . D LOGERROR(BATCHIEN,0,$P($$SPOK($$GET1^DIQ(58.42,BATCHIEN,1,"I")),"^",2),BCKGRND)
  1. ;
  1. ; The LOCK below prevents two concurrent transmission processes from getting the same filename
  1. F S DATETIME=$P($$FMTHL7^XLFDT($$HTFM^XLFDT($H)),"-") L +@("PMP"_DATETIME):0 Q:$T H 2
  1. ;
  1. S STATEIEN=$$GET1^DIQ(58.42,BATCHIEN,1,"I")
  1. S PSOASVER=$$GET1^DIQ(58.41,STATEIEN,1,"I")
  1. I $$GET1^DIQ(58.42,BATCHIEN,2,"I")="ZR" S PSOASVER=$$GET1^DIQ(58.41,STATEIEN,20) ;Zero Reporting
  1. S PSOFLEXT=$$GET1^DIQ(58.41,STATEIEN,6)
  1. S RENAME=$$GET1^DIQ(58.41,STATEIEN,17,"I")
  1. S PSOSTIP=$$GET1^DIQ(58.41,STATEIEN,7)
  1. S PSOPORT=$$GET1^DIQ(58.41,STATEIEN,9)
  1. ;
  1. ; The commands below will first 'flush' and then add the IP Address to the known_hosts file
  1. S PSOVER=$$UP^XLFSTR($$VERSION^%ZOSV(1))
  1. I MODE="EXPORT",$$OS^%ZOSV()="UNIX",(PSOVER["CACHE")!(PSOVER["IRIS") D ;PSO*7*630
  1. . I DEBUG,FLUSH X "S PV=$ZF(-1,""ssh-keygen -R ""_PSOSTIP)"
  1. . X "S PV=$ZF(-1,""ssh -oBatchMode=yes -oStrictHostKeyChecking=no -oLogLevel=quiet"_$S(PSOPORT:" -oPort="_PSOPORT,1:"")_" "_PSOSTIP_""")"
  1. ;
  1. S PSOSTUSR=$$GET1^DIQ(58.41,STATEIEN,8)
  1. S PSOSTDIR=$$GET1^DIQ(58.41,STATEIEN,10)
  1. S PSOAUTO=$S($$GET1^DIQ(58.41,STATEIEN,13,"I")="A":1,1:0)
  1. S PSOOS=$$OS^%ZOSV()
  1. ;
  1. I MODE="EXPORT",'$G(BCKGRND) W !!,"Exporting Batch #",BATCHIEN,":",!
  1. ;
  1. S RX=0
  1. F S RX=$O(^PS(58.42,BATCHIEN,"RX",RX)) Q:'RX D
  1. . S RXNODE=^PS(58.42,BATCHIEN,"RX",RX,0)
  1. . S RXIEN=+RXNODE,FILLNUM=$P(RXNODE,"^",2),PATIEN=$$GET1^DIQ(52,RXIEN,2,"I")
  1. . I MODE="EXPORT",$P(RXNODE,"^",3)'="V",'$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM) Q
  1. . ; PSO*7*625:PSU-14 - Allow VOID Export of Released Prescriptions in RX Batch Only
  1. . 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
  1. . ; Always the Pharmacy Division for the Original Fill
  1. . S SITEIEN=$$RXSITE^PSOBPSUT(RXIEN,0)
  1. . S ^TMP("PSOSPMEX",$J,SITEIEN,PATIEN,RXIEN,FILLNUM)=$P(RXNODE,"^",3)
  1. ;
  1. I $$GET1^DIQ(58.41,STATEIEN,20)'="",$$GET1^DIQ(58.42,BATCHIEN,2,"I")="ZR" D ;Zero report
  1. . S ZRS=0 S SITEIEN=""
  1. . F S ZRS=$O(^PS(58.42,BATCHIEN,"ZRS",ZRS)) Q:'ZRS D
  1. . . S ZRNODE=^PS(58.42,BATCHIEN,"ZRS",ZRS,0)
  1. . . S SITEIEN=+ZRNODE,DEA=$P(ZRNODE,"^",2)
  1. . . S ZRDEA(DEA)=SITEIEN
  1. . N DEA S (DEA,SITEIEN)=""
  1. . F S DEA=$O(ZRDEA(DEA)) Q:DEA="" D
  1. . . S SITEIEN=ZRDEA(DEA),^TMP("PSOSPMEX",$J,SITEIEN)=""
  1. ;
  1. I '$D(^TMP("PSOSPMEX",$J)) D L -@("PMP"_DATETIME) Q
  1. . D LOGERROR(BATCHIEN,0,"There were no eligible prescriptions in the batch #"_BATCHIEN,BCKGRND)
  1. ;
  1. I MODE="VIEW",PSOASVER'="1995" S XX="",$P(XX,"-",80)="" W !,XX,!
  1. I MODE="EXPORT" D I $P(FILES,"^",1)=-1 L -@("PMP"_DATETIME) Q
  1. . S RTSONLY=0 I $$GET1^DIQ(58.42,BATCHIEN,2,"I")="VD" S RTSONLY=1
  1. . I PSOOS["VMS" S LOCDIR=$$GET1^DIQ(58.41,STATEIEN,4)
  1. . I PSOOS["UNIX" D
  1. . . S LOCDIR=$$GET1^DIQ(58.41,STATEIEN,15)
  1. . . I '$$DIREXIST^PSOSPMU1(LOCDIR) D MAKEDIR^PSOSPMU1(LOCDIR)
  1. . S FILES=$$PREPFILE^PSOSPMU1(STATEIEN,DATETIME,RTSONLY,DEBUG)
  1. . I $P(FILES,"^",1)=-1 D LOGERROR(BATCHIEN,0,$P(FILES,"^",2),BCKGRND) Q
  1. . S EXPFILE=$P(FILES,"^",2)
  1. . S FTPFILE=$P(FILES,"^",3)
  1. . S INPTFILE=$P(FILES,"^",4)
  1. . S LOGFILE=$P(FILES,"^",5)
  1. . S EXPFILE2=$P(FILES,"^",6)
  1. . I 'BCKGRND W !,$S('PSOAUTO:"Step 1: ",1:""),"Writing to file ",LOCDIR_EXPFILE,"..."
  1. . D OPEN^%ZISH("EXPFILE",LOCDIR,EXPFILE,"W")
  1. . I POP D LOGERROR(BATCHIEN,0,"Export File <"_LOCDIR_EXPFILE_"> could not be created.",BCKGRND) S FILES=-1 Q
  1. . D USE^%ZISUTL("EXPFILE")
  1. ;----------------------------- ASAP Data Output (1995) -------------------------------
  1. I PSOASVER="1995" D
  1. . S (SITEIEN,PATIEN,RXIEN)=0
  1. . F S SITEIEN=$O(^TMP("PSOSPMEX",$J,SITEIEN)) Q:'SITEIEN D
  1. . . F S PATIEN=$O(^TMP("PSOSPMEX",$J,SITEIEN,PATIEN)) Q:'PATIEN D
  1. . . . K VADM,VAPA,PSONAME S DFN=PATIEN D DEM^VADPT,ADD^VADPT,SETNAME(PATIEN)
  1. . . . F S RXIEN=$O(^TMP("PSOSPMEX",$J,SITEIEN,PATIEN,RXIEN)) Q:'RXIEN D
  1. . . . . S FILLNUM=""
  1. . . . . F S FILLNUM=$O(^TMP("PSOSPMEX",$J,SITEIEN,PATIEN,RXIEN,FILLNUM)) Q:FILLNUM="" D
  1. . . . . . S RECTYPE=^TMP("PSOSPMEX",$J,SITEIEN,PATIEN,RXIEN,FILLNUM)
  1. . . . . . K RTSDATA I RECTYPE="V" D LOADRTS^PSOSPMU1(RXIEN,FILLNUM,.RTSDATA)
  1. . . . . . W $$ASAP95^PSOASAP0(RXIEN,+FILLNUM),!
  1. ;------------------------- ASAP Data Output (3.0 and above) --------------------------
  1. I PSOASVER'="1995" D
  1. . S TRXTYPE="S",PSOTTCNT=0
  1. . D LOADASAP^PSOSPMU0(PSOASVER,"B",.ASAP)
  1. . S (SITEIEN,PATIEN,RXIEN)=0
  1. . ;Writing Level 1: Transaction Header, Information Source
  1. . D WRITELEV(1,"ASAP")
  1. . F S SITEIEN=$O(^TMP("PSOSPMEX",$J,SITEIEN)) Q:'SITEIEN D
  1. . . S PSOTPCNT=0
  1. . . ;Writing Level 2: Pharmacy Header
  1. . . D WRITELEV(2,"ASAP")
  1. . . ;Zero Reporting
  1. . . I $$GET1^DIQ(58.42,BATCHIEN,2,"I")="ZR" D
  1. . . . ;Zero Reporting Writing Level 3: Patient Detail
  1. . . . D WRITELEV(3,"ASAP")
  1. . . . ;Zero Reporting Writing Level 4: Prescription Detail
  1. . . . D WRITELEV(4,"ASAP")
  1. . . F S PATIEN=$O(^TMP("PSOSPMEX",$J,SITEIEN,PATIEN)) Q:'PATIEN D
  1. . . . K VADM,VAPA,PSONAME S DFN=PATIEN D DEM^VADPT,ADD^VADPT,SETNAME(PATIEN)
  1. . . . S (DRUGIEN,FILLNUM,FILLIEN,PREIEN,RPHIEN,RTSREC)=0
  1. . . . ;Writing Level 3: Patient Detail
  1. . . . D WRITELEV(3,"ASAP")
  1. . . . F S RXIEN=$O(^TMP("PSOSPMEX",$J,SITEIEN,PATIEN,RXIEN)) Q:'RXIEN D
  1. . . . . S FILLNUM="",DRUGIEN=$$GET1^DIQ(52,RXIEN,6,"I")
  1. . . . . F S FILLNUM=$O(^TMP("PSOSPMEX",$J,SITEIEN,PATIEN,RXIEN,FILLNUM)) Q:FILLNUM="" D
  1. . . . . . S FILLIEN=$S(FILLNUM["P":+$P(FILLNUM,"P",2),1:+FILLNUM)
  1. . . . . . S RECTYPE=^TMP("PSOSPMEX",$J,SITEIEN,PATIEN,RXIEN,FILLNUM)
  1. . . . . . S PREIEN=$$PREIEN(RECTYPE,RXIEN,FILLNUM)
  1. . . . . . S RPHIEN=$$RPHIEN(RECTYPE,RXIEN,FILLNUM)
  1. . . . . . S RTSREC=0 K RTSDATA I RECTYPE="V" S RTSREC=1 D LOADRTS^PSOSPMU1(RXIEN,FILLNUM,.RTSDATA)
  1. . . . . . ;Writing Level 4: Prescription Detail
  1. . . . . . D WRITELEV(4,"ASAP")
  1. . . ;Writing Level 5: Pharmacy Trailer
  1. . . D WRITELEV(5,"ASAP")
  1. . ;Writing Level 6: Transaction Trailer
  1. . D WRITELEV(6,"ASAP")
  1. ; Close the file
  1. I MODE="EXPORT" D CLOSE^%ZISH("EXPFILE") I 'BCKGRND W "Done."
  1. ;------------------------- sFTP Transmission to the State -----------------------------
  1. I MODE="VIEW",PSOASVER'="1995" S XX="",$P(XX,"-",80)="" W !,XX
  1. S (PSOFTPOK,PSODELOK)=""
  1. I MODE="EXPORT" D
  1. . ; Automated Transmission (RSA keys)
  1. . I PSOAUTO D
  1. . . I 'BCKGRND W !!,"Transmitting file to the State (",$$GET1^DIQ(58.41,STATEIEN,7),")...",!
  1. . . S PSOFTPOK=$$FTPFILE^PSOSPMU1(PSOSTIP,PSOSTUSR,LOCDIR,FTPFILE,EXPFILE,INPTFILE,LOGFILE,PSOPORT,DEBUG)
  1. . ; Manual Transmission (Password)
  1. . K DTOUT,DUOUT
  1. . I 'PSOAUTO D
  1. . . W !!,"Step 2: Copy the "_$S(PSOSTDIR'="":"four",1:"three")_" lines of text below into the clipboard (highlight the"
  1. . . W !?8,"lines then right-click the mouse and select 'Copy').",!
  1. . . W:$G(PSOSTDIR)'="" !,"cd "_PSOSTDIR
  1. . . W !,"put "_$S(PSOOS["VMS":$$XVMSDIR^PSOSPMU1(LOCDIR),1:LOCDIR)_EXPFILE
  1. . . W:$G(RENAME) !,"rename "_EXPFILE_" "_$P(EXPFILE,".up",1)_PSOFLEXT
  1. . . W !,"exit",!
  1. . . 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
  1. . . W !!,"Step 3: Enter the sFTP password and press <RETURN>"
  1. . . W !!,"Step 4: Once you get the 'sftp>' prompt, paste the text copied on step 2"
  1. . . W !?8,"(right-click the mouse and select 'Paste').",!!
  1. . . N XPV1,PV S XPV1="S PV=$ZF(-1,""sftp"_$S(PSOPORT:" -oPort="_PSOPORT,1:"")_" -oUser="_$TR(PSOSTUSR,"""","")_" "_PSOSTIP_""")"
  1. . . X XPV1
  1. . I $P(PSOFTPOK,"^",1)=-1 D LOGERROR(BATCHIEN,0,$P(PSOFTPOK,"^",2),BCKGRND,$G(LOGFILE))
  1. . ;Deleting files
  1. . D DELFILES^PSOSPMU1($G(LOCDIR),$G(EXPFILE),$G(INPTFILE),$G(FTPFILE),$G(LOGFILE))
  1. . I $P(PSOFTPOK,"^",1)=-1 Q
  1. . I 'PSOAUTO,$G(DTOUT)!$G(DUOUT) Q
  1. . I 'BCKGRND,PSOAUTO H 1 W !!,"File Successfully Transmitted.",!
  1. . I 'PSOAUTO D I $G(DTOUT)!$G(DUOUT)!'Y Q
  1. . . K DIR S DIR("A")="Was the file transmitted successfully",DIR(0)="Y",DIR("B")="N"
  1. . . D ^DIR
  1. . S DIE="^PS(58.42,",DA=BATCHIEN,DR="6///"_EXPFILE2_";7////"_DUZ_";9///"_$$NOW^XLFDT() D ^DIE
  1. W ! L -@("PMP"_DATETIME)
  1. Q
  1. ;
  1. WRITELEV(LEVEL,ARRAY) ; Write the ASAP Segments for each Level
  1. ;Input: LEVEL - ASAP level to print (1:Header, 2:Pharmacy, ...)
  1. ; ARRAY - Name of the Array containing the ASAP Data Definition (e.g., "ASAP")
  1. N NODE,SEGID,SEG0
  1. S NODE=ARRAY
  1. F S NODE=$Q(@NODE) Q:NODE=""!($E(NODE,$F(NODE,"("))'?1N) D
  1. . S SEGID=@NODE I SEGID="" Q
  1. . S SEG0=$G(@(ARRAY_"("""_SEGID_""")"))
  1. . ; Segment not in the Level
  1. . I $P(SEG0,"^",6)'=LEVEL Q
  1. . ; Segment Marked NOT USED
  1. . I $P(SEG0,"^",4)="N" Q
  1. . D WRITESEG(SEGID,LEVEL,ARRAY)
  1. Q
  1. ;
  1. WRITESEG(SEGID,LEVEL,ARRAY) ; Write the ASAP segment to the file
  1. ;Input: SEGID - ASAP Segment ID (e.g., "TH", "PAT", "DSP", ...)
  1. ; LEVEL - ASAP level to print (1:Header, 2:Pharmacy, ...)
  1. ; ARRAY - Name of the Array containing the ASAP Data Definition (e.g., "ASAP")
  1. N ELMPOS,LASTELEM
  1. I '$D(@ARRAY@(SEGID)) Q
  1. I $G(MODE)="VIEW",$P(@ARRAY,"^",4)'="" W ?$S(LEVEL<5:((LEVEL-1)*3),LEVEL=5:3,1:0)
  1. S LASTELEM=+$O(@ARRAY@(SEGID,""),-1)
  1. W SEGID D SEGCOUNT(LEVEL)
  1. F ELMPOS=1:1:LASTELEM D
  1. . ;Skipping Last Element if marked NOT USED (to solve issue with TH09 for 4.0 and TH13 for 3.0)
  1. . I ELMPOS=LASTELEM,$P(@ARRAY@(SEGID,ELMPOS),"^",6)="N" Q
  1. . ;Data Element Delimiter Char
  1. . W $P(@ARRAY,"^",2)
  1. . ; ASAP Data Element Marked NOT USED
  1. . I $P(@ARRAY@(SEGID,ELMPOS),"^",6)="N" Q
  1. . ; Writing Data Element Content to the file
  1. . D WRITEELM(SEGID,ELMPOS,ARRAY)
  1. ; Segment Terminator Character
  1. W $P(@ARRAY,"^",3)
  1. ; End of Segment Control Char(s) (e.g., Line-Feed ($C(10)), Carriage-Return ($C(13)),etc.)
  1. W:$P(@ARRAY,"^",4)'="" @($P(@ARRAY,"^",4))
  1. Q
  1. ;
  1. WRITEELM(SEGID,ELMPOS,ARRAY) ; Write the ASAP Data Element to file
  1. ;Input: SEGID - ASAP Segment ID (e.g., "TH", "PAT", "DSP", ...)
  1. ; ELMPOS - ASAP Data Element Position (1, 2, 3, ...)
  1. ; ARRAY - Name of the Array containing the ASAP Data Definition (e.g., "ASAP")
  1. N MEXPR,GETVALUE,VALUE,MAXLEN
  1. S MEXPR=$G(@ARRAY@(SEGID,ELMPOS,"VAL",1))
  1. ; Rechecking the M Expression value for Security purposes
  1. I '$$VALID^PSOSPMU3($P(@ARRAY,"^"),MEXPR) W "?" Q
  1. ; Retrieving and executing the M code for retrieving the ASAP Data Element value
  1. D
  1. . N $ETRAP,$ESTACK S $ETRAP="D ERROR^PSOSPMUT"
  1. . S GETVALUE="S VALUE="_MEXPR X GETVALUE
  1. ; Removing Control Characters from the Data Element Value
  1. S VALUE=$$ESC(VALUE)
  1. ; Triming Value according to the Data Element Maximum Length
  1. S MAXLEN=$P($G(@ARRAY@(SEGID,ELMPOS)),"^",4) S:MAXLEN>0 VALUE=$E(VALUE,1,MAXLEN)
  1. ; Replacing characters that match Segment Delimiter chars with "?"
  1. I MAXLEN>1,VALUE'=$P(@ARRAY,"^",3) S VALUE=$TR(VALUE,$P(@ARRAY,"^",3),"?")
  1. ; Replacing characters that match Data Element Delimiter chars with "?"
  1. I MAXLEN>1,VALUE'=$P(@ARRAY,"^",2) S VALUE=$TR(VALUE,$P(@ARRAY,"^",2),"?")
  1. ; Writing the Data Element Value
  1. W VALUE
  1. Q
  1. ;
  1. 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
  1. ; TT Segment Count
  1. S PSOTTCNT=$G(PSOTTCNT)+1
  1. ; TP Segment Count
  1. I LEVEL'=1,LEVEL'=6 S PSOTPCNT=$G(PSOTPCNT)+1
  1. Q
  1. ;
  1. ERROR ; Error Trap Handling to catch errors on user-entered M SET expressions
  1. N ERROR
  1. D CLOSE^%ZISH("EXPFILE")
  1. S ERROR="ASAP Data Element: "_$G(SEGID)_$E(100+$G(ELMPOS),2,3)_" M Expression: "_$G(MEXPR)_" Error: "_$$EC^%ZOSV
  1. D LOGERROR($G(BATCHIEN),0,ERROR,$G(BCKGRND))
  1. D DELFILES^PSOSPMU1($G(LOCDIR),$G(EXPFILE),$G(INPTFILE),$G(FTPFILE))
  1. Q
  1. ;
  1. SCREEN(RXIEN,FILLNUM) ; Screens Rx's from being sent to the State
  1. ; Input: RXIEN - PRESCRIPTION file (#52) IEN
  1. ; FILLNUM - Fill Number
  1. ;Output: $$SCREEN - 1:YES/0:NO^Error/Warning Message^E:Error/W:Warning
  1. ;
  1. ; Not a Controlled Substance
  1. I '$$CSRX(RXIEN) Q "1^"_$$GET1^DIQ(52,RXIEN,6)_" is not a Controlled Substance Drug.^E"
  1. ;
  1. ; Fills Administered in Clinic exclusion
  1. I $$ADMCLN(RXIEN,FILLNUM) Q "1^Prescription fill was administered in clinic.^E"
  1. ;
  1. ; Released prior to Transmission Authorization Date (02/11/2013)
  1. I $$RXRLDT^PSOBPSUT(RXIEN,FILLNUM),$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM)<3130211 Q "1^Prescription fill released before 02/11/2013.^E"
  1. ;
  1. ; Non-Veteran Patient Exclusion (Based on parameter)
  1. N STATE,DFN,VAEL
  1. S STATE=$$RXSTATE^PSOBPSUT(RXIEN,0)
  1. 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"
  1. . S DFN=$$GET1^DIQ(52,RXIEN,2,"I") D ELIG^VADPT
  1. ;
  1. Q 0
  1. ;
  1. CSRX(RXIEN) ; Controlled Substance Rx?
  1. ; Input: RXIEN - PRESCRIPTION file (#52) pointer
  1. ;Output: $$CS - 1:YES / 0:NO
  1. N DRGIEN,DEA
  1. S DRGIEN=$$GET1^DIQ(52,RXIEN,6,"I") I 'DRGIEN Q 0
  1. S DEA=$$GET1^DIQ(50,DRGIEN,3)
  1. I (DEA'["0"),(DEA'["M"),(DEA["2")!(DEA["3")!(DEA["4")!(DEA["5") Q 1
  1. Q 0
  1. ;
  1. ADMCLN(RXIEN,FILL) ; Returns whether the fill was administered in clinic or not
  1. ; Input: (r) RXIEN - Rx IEN (#52)
  1. ; (o) FILL - Refill #
  1. ; Output: 1 - Yes (Administered in Clinic) / 0 - No
  1. N ADMCLN
  1. I '$G(RXIEN) Q 0
  1. I 'FILL S ADMCLN=+$$GET1^DIQ(52,RXIEN,14,"I")
  1. I FILL S ADMCLN=+$$GET1^DIQ(52.1,FILL_","_RXIEN,23,"I")
  1. Q ADMCLN
  1. ;
  1. SPOK(STATE) ; State Parameters OK?
  1. ; Input: STATE - STATE file (#5) pointer
  1. N ZNODE,FNODE,F1NODE,X,STATENAM
  1. S STATENAM=$$GET1^DIQ(5,+$G(STATE),.01)
  1. I '$D(^PS(58.41,+$G(STATE),0)) Q "-1^PMP parameters missing for "_STATENAM
  1. S ZNODE=$G(^PS(58.41,STATE,0))
  1. I $P(ZNODE,"^",2)="" Q "-1^ASAP Version missing for "_STATENAM
  1. I $P(ZNODE,"^",4)="" Q "-1^Reporting Frequency missing for "_STATENAM
  1. S FNODE=$G(^PS(58.41,STATE,"FILE"))
  1. S F1NODE=$G(^PS(58.41,STATE,"FILE1"))
  1. I $$OS^%ZOSV()["VMS",$P(FNODE,"^",1)="" Q "-1^Local VMS Directory missing for "_STATENAM
  1. I $$OS^%ZOSV()["UNIX",$P(F1NODE,"^",1)="" Q "-1^Local Unix/Linux Directory missing for "_STATENAM
  1. I $P(FNODE,"^",4)="" Q "-1^State FTP Server IP Address missing for "_STATENAM
  1. I $P(FNODE,"^",5)="" Q "-1^State FTP Server username missing for "_STATENAM
  1. I $P(ZNODE,"^",6)="A",'$O(^PS(58.41,STATE,"PRVKEY",0)) Q "-1^SSH Keys missing for "_STATENAM
  1. Q 1
  1. ;
  1. SETNAME(DFN) ; Set array variable PSONAME with Patient name
  1. N NCIEN K PSONAME
  1. S NCIEN=$$GET1^DIQ(2,DFN,1.01,"I")
  1. I NCIEN,$$GET1^DIQ(20,NCIEN,1)'="",$$GET1^DIQ(20,NCIEN,2)'="" D Q
  1. . S PSONAME("LAST")=$$GET1^DIQ(20,NCIEN,1)
  1. . S PSONAME("FIRST")=$$GET1^DIQ(20,NCIEN,2)
  1. . S PSONAME("MIDDLE")=$$GET1^DIQ(20,NCIEN,3)
  1. . S PSONAME("PREFIX")=$$GET1^DIQ(20,NCIEN,4)
  1. . S PSONAME("SUFFIX")=$$GET1^DIQ(20,NCIEN,5)
  1. ;
  1. S PSONAME("LAST")=$P($G(VADM(1)),",",1)
  1. S PSONAME("FIRST")=$P($P($G(VADM(1)),",",2)," ",1)
  1. S PSONAME("MIDDLE")=$P($P($G(VADM(1)),",",2)," ",2)
  1. S PSONAME("SUFFIX")=""
  1. S PSONAME("PREFIX")=""
  1. Q
  1. ;
  1. 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)
  1. ; (r) STATEIEN - Pointer ot the STATE file (#5)
  1. ; (r) ERROR - Error Text
  1. ; (r) BCKGRND - Background execution (1: Yes / 0: No)
  1. ; (o) LOGFILE - Filename of the file containing the sFTP Log (VMS only)
  1. I '$G(BCKGRND) W !!,ERROR,!,$C(7) Q
  1. ;
  1. ;Builds mail message and sends it to users of PSO SPMP NOTIFICATIONS mail group
  1. N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,PSOMSG,USR,STANAME,LINE
  1. ;
  1. S STANAME=$S($G(BATCHIEN):$$GET1^DIQ(58.42,BATCHIEN,1),1:$$GET1^DIQ(5,STATEIEN,.01))
  1. S XMSUB=STANAME_" Prescription Monitoring Program Transmission Failed"
  1. S XMDUZ="SPMP TRANSMISSION"
  1. S PSOMSG(1)="There was a problem with the transmission of information about Controlled"
  1. S PSOMSG(2)="Substance prescriptions to the "_STANAME_" State Prescription Monitoring"
  1. s PSOMSG(3)="Program (SPMP)."
  1. S PSOMSG(4)="",LINE=5
  1. I $G(BATCHIEN) D
  1. . S PSOMSG(LINE)="Batch #: "_BATCHIEN,LINE=LINE+1
  1. . I $$GET1^DIQ(58.42,BATCHIEN,4,"I") D
  1. . . S PSOMSG(LINE)="Period : "_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,4,"I")\1,"2Z")
  1. . . S PSOMSG(LINE)=PSOMSG(LINE)_" thru "_$$FMTE^XLFDT($$GET1^DIQ(58.42,BATCHIEN,5,"I")\1,"2Z"),LINE=LINE+1
  1. . S PSOMSG(LINE)="Error : "_ERROR,LINE=LINE+1
  1. . S PSOMSG(LINE)="",LINE=LINE+1
  1. . S PSOMSG(LINE)="Please, use the option Export Batch Processing [PSO SPMP BATCH PROCESSING] to",LINE=LINE+1
  1. . S PSOMSG(LINE)="manually transmit this batch to the state.",LINE=LINE+1
  1. E S PSOMSG(LINE)="Error : "_ERROR,LINE=LINE+1
  1. S XMTEXT="PSOMSG("
  1. ;
  1. ; Loading the VMS Log into the Mailman Message
  1. I $G(LOGFILE)'="" D
  1. . N LOCDIR,FILEARR,LOG,XLOG
  1. . S LOCDIR=$$GET1^DIQ(58.41,+$$GET1^DIQ(58.42,BATCHIEN,1,"I"),$S($$OS^%ZOSV()["VMS":4,1:15)) I LOCDIR="" Q
  1. . I '$$FEXIST(LOCDIR,LOGFILE) Q
  1. . S PSOMSG(LINE)="",LINE=LINE+1
  1. . S PSOMSG(LINE)="sFTP Log:",LINE=LINE+1
  1. . S PSOMSG(LINE)="========",LINE=LINE+1
  1. . K ^TMP("PSOFTPLG",$J)
  1. . S XLOG=$$FTG^%ZISH(LOCDIR,LOGFILE,$NAME(^TMP("PSOFTPLG",$J,1)),3)
  1. . S LOG=0 F S LOG=$O(^TMP("PSOFTPLG",$J,LOG)) Q:LOG="" D
  1. . . S PSOMSG(LINE)=$G(^TMP("PSOFTPLG",$J,LOG)),LINE=LINE+1
  1. ;
  1. ; If there are no active members in the mailgroup sends message to PSDMGR key holders
  1. I $$GOTLOCAL^XMXAPIG("PSO SPMP NOTIFICATIONS") D
  1. . S XMY("G.PSO SPMP NOTIFICATIONS")=""
  1. E D
  1. . S USR=0 F S USR=$O(^XUSEC("PSDMGR",USR)) Q:'USR S XMY(USR)=""
  1. D ^XMD
  1. Q
  1. ;
  1. PREIEN(RECTYPE,RXIEN,FILLNUM) ; Returns the Provider IEN
  1. ;Input: RECTYPE - Record Type ('S': SEND, 'R': REVIEW, 'V': VOID)
  1. ; RXIEN - PRESCRIPTION file (#52) IEN
  1. ; FILLNUM - Fill Number
  1. Q +$S(RECTYPE="V"&($G(RTSDATA("PRVIEN"))):RTSDATA("PRVIEN"),1:$$RXPRV^PSOBPSUT(RXIEN,FILLNUM))
  1. ;
  1. RPHIEN(RECTYPE,RXIEN,FILLNUM) ; Returns the Pharmacist IEN
  1. ;Input: RECTYPE - Record Type ('S': SEND, 'R': REVIEW, 'V': VOID)
  1. ; RXIEN - PRESCRIPTION file (#52) IEN
  1. ; FILLNUM - Fill Number
  1. Q +$S(RECTYPE="V"&($G(RTSDATA("RPHIEN"))):RTSDATA("RPHIEN"),1:$$RXRPH^PSOBPSUT(RXIEN,FILLNUM))
  1. ;
  1. FEXIST(DIR,FILE) ; Check if a File exists
  1. ; Input: DIR - Name of the directory where the file is located
  1. ; FILE - Name of the file to be checked
  1. ;Output: $$FEXIST - 1 - File Exists / 0 - File Not Found
  1. N RETURN,FILEARR
  1. S FILEARR(FILE)=""
  1. Q +$$LIST^%ZISH(DIR,"FILEARR","RETURN")
  1. ;
  1. ESC(VALUE) ; Removes Control Characters from the Data Element Value
  1. N ESCVALUE,I
  1. S ESCVALUE=""
  1. F I=1:1:$L(VALUE) I $A(VALUE,I)>31,$A(VALUE,I)<127 S ESCVALUE=ESCVALUE_$E(VALUE,I)
  1. Q ESCVALUE