- PSSHRIT ;WOIFO/SG,PO - Transmits a "ping" to determine if FDB server is down and record the down time ; 01 Mar 2016 3:34 PM
- ;;1.0;PHARMACY DATA MANAGEMENT;**136,168,164,173,180,184,178**;9/30/97;Build 14
- ;
- ;External reference to IN^PSSHRQ2 supported by DBIA 5369
- ;External reference to File 18.12 supported by DBIA 5891
- ;
- Q
- PINGCHK ; do ping test, if not passed record it and send a message.
- ; Called from PSS INTERFACE SCHEDULER option
- N STATUS
- F L +^PS(59.74,"PINGCHK^PSSHRIT"):1 Q:$T
- S STATUS=$$PINGTST()
- S STATUS=$$PINGFILE(STATUS)
- I STATUS=-1 D SMSGDWN ; if failed for the first time (a new entry created) send a message that interface is down.
- L -^PS(59.74,"PINGCHK^PSSHRIT")
- Q
- ;
- PINGTST() ; test the ping by sending a ping request.
- ;return 0 - ping successful, -1^reason ping failed
- N BASE,STATUS
- S BASE="PINGTST^"_$T(+0)
- K ^TMP($J,BASE)
- S ^TMP($J,BASE,"IN","PING")=""
- D IN^PSSHRQ2(BASE)
- S STATUS=$G(^TMP($J,BASE,"OUT",0))
- K ^TMP($J,BASE)
- Q STATUS
- ;
- PINGFILE(STATUS) ; file the ping results
- ; Input
- ; Status - Ping results
- ; Return
- ; -1 - if creates an entry - means the first it noticed PEPS is unavailable
- ; 0 - if does not create/update a record,
- ; 1 - if updates the last entry
- N LIEN,LASTAVL
- S STATUS=+$G(STATUS)
- S LIEN=+$O(^PS(59.74,":"),-1) ; get last entry
- S LASTAVL=$P($G(^PS(59.74,LIEN,0)),U,2) ; get last available date/time
- I STATUS=0,'LIEN Q 0 ; do nothing
- I STATUS=0,LIEN,LASTAVL Q 0 ; do nothing
- I STATUS=0,LIEN,'LASTAVL D UPDATENT(LIEN) Q 1 ; update file
- I STATUS=-1,LIEN,LASTAVL D NEWENT Q -1 ; create new entry
- I STATUS=-1,'LIEN D NEWENT Q -1 ; create new entry
- Q 0
- NEWENT ; create a new entry in FDB INTERFACE DATA (#59.74) file.
- N DIC,DO
- S X=$$NOW^XLFDT(),DIC="^PS(59.74,",DIC(0)="Z" D FILE^DICN
- K X,Y
- Q
- ;
- UPDATENT(LAST) ; update the last entry in FDB INTERFACE DATA (#59.74) file.
- ;edit flag once it is created.
- N DIE,NEWVAL,DWNTIME,DA,DR,DIFF
- S DA=LAST
- S NEWVAL=$$NOW^XLFDT() ;$$NOW()
- S DWNTIME=+$G(^PS(59.74,DA,0))
- Q:'DWNTIME
- S DIFF=$$FMDIFF^XLFDT(NEWVAL,DWNTIME,2)
- S DIFF=DIFF\60 ;IN MINUTES
- S DIE="^PS(59.74,",DR="1///^S X=NEWVAL;2///^S X=DIFF"
- D ^DIE
- D SMSGRST ; send a message that interface connection is restored
- Q
- ;
- SMSGDWN ; send a bulletin that Interface connection is down.
- N XMB,XMTEXT,XMY,PSFDB,XMV,XMDUN,XMDUZ
- S XMDUZ="PSS INTERFACE SCHEDULER"
- S XMB="PSS FDB INTERFACE"
- S XMTEXT="PSFDB"
- ; check to if dosing check is on.
- I $T(DS^PSSDSAPI)]"",$$DS^PSSDSAPI() D
- .S PSFDB(1)="Connection to Vendor Database is down! No Drug-Drug Interaction, Duplicate"
- .S PSFDB(2)="Therapy or Dosing Order Checks will be performed until the connection is"
- .S PSFDB(3)="reestablished!!!"
- E D
- .S PSFDB(1)="Connection to Vendor Database is down! No Drug-Drug Interaction or Duplicate"
- .S PSFDB(2)="Therapy Order Checks will be performed until the connection is reestablished!!!"
- S XMY("G.PSS ORDER CHECKS")=""
- D ^XMB
- S DIE="^PS(59.74,",DR="3///1" D ^DIE K DIE,DR,DA
- Q
- ;
- SMSGRST ; send a bulletin that Interface connection is restored
- N XMB,XMTEXT,XMY,PSFDB,XMV,XMDUN,XMDUZ
- S XMDUZ="PSS INTERFACE SCHEDULER"
- S XMB="PSS FDB INTERFACE RESTORED"
- S XMTEXT="PSFDB"
- ; check to if dosing check is on.
- I $T(DS^PSSDSAPI)]"",$$DS^PSSDSAPI() D
- .S PSFDB(1)="Connection to Vendor Database has been restored! Drug-Drug Interactions,"
- .S PSFDB(2)="Duplicate Therapy and Dosing Order Checks can now be performed."
- E D
- .S PSFDB(1)="Connection to Vendor Database has been restored! Drug-Drug Interactions or"
- .S PSFDB(2)="Duplicate Therapy Order Checks can now be performed."
- S XMY("G.PSS ORDER CHECKS")=""
- D ^XMB
- Q
- ;
- TASKIT(FREQ,START) ; create/update scheduling option start time and frequency
- ; Input:
- ; FREQ - Optional - rescheduling frequency in minutes (default 15 minutes)
- ; START - Optional - start time (default is current time + 4 minutes)
- ; Note: if START is less than 4 minutes in future, it will be defaulted to
- ; current time + 4 minutes.
- ;
- K PSERROR
- S FREQ=$G(FREQ,15)
- S FREQ=FREQ*60_"S"
- S START=$G(START,$$NOW^XLFDT())
- ;
- ; if start date/time is less than 4 minutes in future make it 4 minutes from now
- S:$$FMDIFF^XLFDT(START,$$NOW^XLFDT(),2)<240 START=$$FMADD^XLFDT($$NOW^XLFDT(),0,0,4)
- ;
- ; create the option schedule if it does not exist. return PSERROR=-1 if fails.
- ; in some situation when it fails, does not create the PSERROR variable
- D RESCH^XUTMOPT("PSS INTERFACE SCHEDULER",START,"",FREQ,"L",.PSERROR)
- Q
- ;
- SCHDOPT ; edit option scheduling
- ; Called from "PSS SCHEDULE PEPS INTERFACE CK" option to create and/or edit the scheduling
- ; parameters for "PSS INTERFACE SCHEDULER" option in OPTION SCHEDULING file.
- ; The "PSS SCHEDULE PEPS INTERFACE CK" option is installed by PAS*1.0*117 package.
- N PSSROOT,DIR,Y,DTOUT,DUOUT
- ; check to see if the option is defined in option scheduler file and it is tasked.
- ; if not create and task the option.
- D OPTSTAT^XUTMOPT("PSS INTERFACE SCHEDULER",.PSSROOT)
- I '+$G(PSSROOT(1)) D TASKIT(15)
- ;
- ;Warn user that:
- ; (1) the recommended interval is 15 minutes
- ; (2) do not schedule for less than 5 minutes since system issues may result
- ; after a downtime due to multiple jobs being scheduled
- ;
- W !!,?5,"The PSS INTERFACE SCHEDULER task is scheduled to run next on "
- S PSSTIME=$P($G(PSSROOT(1)),"^",2)
- W !,?5,$S('PSSTIME:"*** NOT SCHEDULED ***",1:$$FMTE^XLFDT(PSSTIME,"1P")_".")
- W !!,?5,"The recommended ""Rescheduling Frequency"" is 15 minutes (900 seconds)."
- W !!,?5,"It is currently set to ",$S('+$G(PSSROOT(1)):"*** NOT SET ***",1:$P($G(PSSROOT(1)),"^",3)_".")
- W !!,?5,"WARNING: Do not decrease the ""Rescheduling Frequency"" below 5 minutes."
- W !!,?5," System issues could occur after a downtime due to"
- W !,?5," multiple jobs being tasked.",!!
- K DIR S DIR(0)="Y",DIR("B")="NO"
- S DIR("?")="Enter 'Y' to continue to the option which will allow you to change the TaskMan parameters."
- S DIR("A")="Continue to the TaskMan Schedule/Unschedule Option"
- D ^DIR K DIR
- I 'Y!($D(DUOUT))!($D(DTOUT)) Q
- ;
- D EDIT^XUTMOPT("PSS INTERFACE SCHEDULER")
- Q
- ;
- SLASTRUN(LASTRUN) ; set last run time
- N SUB,PURGE,NOW,DESC
- S DESC="This stores the latest data on FDB interface"
- S NOW=$$NOW^XLFDT()\1
- S PURGE=$$FMADD^XLFDT(NOW,30)
- S ^XTMP("PSSRUN",0)=PURGE_U_NOW_U_DESC
- S ^XTMP("PSSRUN","LASTRUN")=LASTRUN
- Q
- ;
- GLASTRUN() ; get last run time
- Q $G(^XTMP("PSSRUN","LASTRUN"))
- ;
- RUNTEST ; run interaction test to PEPS server
- ; called from PSS CHECK PEPS SERVICES SETUP option
- D KILL^XUSCLEAN
- N STATUS,X,PSSFLAG,%ZIS,POP,ZTDESC,ZTQUEUED,ZTREQ,ZTRTN
- S PSSFLAG=ION
- ;
- W !!,"This option performs several checks. You may queue this report if you wish."
- W !!,"Among these checks are:"
- W !,"-----------------------"
- W !,"A connection check to the Vendor Database"
- W !,"Drug-Drug Interaction Check"
- W !,"Duplicate Therapy Order Check"
- W !,"Dosing Order Check"
- W !,"Custom Drug-Drug Interaction Check"
- ;
- W ! S %ZIS="MQ",%ZIS("A")="Select Device: " D ^%ZIS G EXIT:POP
- ;
- IF '$D(IO("Q"))&(PSSFLAG=ION) D TESTS^PSSHRIT Q
- ELSE IF $D(IO("Q"))!(PSSFLAG'=ION) D Q
- .S ZTRTN="QTESTS^PSSHRIT",ZTDESC="Interaction test to PEPS server"
- .D ^%ZTLOAD D HOME^%ZIS,^%ZISC K IO("Q") Q
- ;
- EXIT S:$D(ZTQUEUED) ZTREQ="@" Q
- ;
- TESTS ; interaction tests to PEPS server
- ;
- S STATUS=$$CONCHK()
- D PRSRTN Q:(STATUS=0)!(X="^")
- ;
- S STATUS=$$INTERACT()
- D PRSRTN Q:X="^"
- ;
- S STATUS=$$DUPTHRPY()
- D PRSRTN Q:X="^"
- ;
- S STATUS=$$DOSECHK() ;
- D PRSRTN Q:X="^"
- ;
- S STATUS=$$CUSTOM()
- D PRSRTN Q:X="^"
- ;
- Q
- ;
- QTESTS ; queued interaction tests to PEPS server
- ;
- N %,PSSTIME,PSSCOUNT S PSSTIME="",PSSCOUNT=0
- D NOW^%DTC S PSSTIME=$$FMTE^XLFDT(%,"1P")
- W ! F PSSCOUNT=1:1:79 W "-"
- W !!,?15,"Check PEPS Services Setup",?55,PSSTIME,!!
- F PSSCOUNT=1:1:79 W "-"
- W !!
- ;
- S STATUS=$$CONCHK()
- S STATUS=$$INTERACT()
- S STATUS=$$DUPTHRPY()
- S STATUS=$$DOSECHK()
- S STATUS=$$CUSTOM()
- ;
- Q
- ;
- CONCHK() ; check connection
- ; Return 1 if OK, 0 if not OK.
- ;
- N MESSAGE,Y,STATUS,RESULT
- W !,"Checking Vendor Database Connection"
- S RESULT=$$PINGTST()
- I RESULT=0 D
- .W "...OK"
- E D
- .W "...",!!," Connection could not be made to Vendor database."
- .S Y=$$GLASTRUN()
- .I Y D
- ..D DD^%DT ; convert last reached time in Y to external format
- ..W !," Last reached @"_$E(Y,1,18)
- W !
- Q $S(RESULT=0:1,1:0)
- ;
- INTERACT() ; check drug-drug interaction.
- ; Return 1 if OK, 0 if not OK.
- ;
- N PSORDER,PSDRUG1,PSDRUG2,BASE,INFO,INTRO,PSSPEC
- N PSSLEFT S PSSLEFT=4 ; left margin for results
- S BASE=$T(+0)_" INTERACT"
- K ^TMP($J,BASE)
- S ^TMP($J,BASE,"IN","DRUGDRUG")=""
- S PSORDER="I;1464P;PROSPECTIVE;2",PSDRUG1="WARFARIN NA (GOLDEN STATE) 5MG TAB",PSDRUG2="CIPROFLOXACIN HCL 250MG TAB"
- S ^TMP($J,BASE,"IN","PROSPECTIVE","I;1464P;PROSPECTIVE;2")="006562^4029336^^WARFARIN NA (GOLDEN STATE) 5MG TAB"
- S ^TMP($J,BASE,"IN","PROSPECTIVE","I;91464P;PROSPECTIVE;2")="009509^4008322^^CIPROFLOXACIN HCL 250MG TAB"
- D IN^PSSHRQ2(BASE)
- ;
- S INTRO="Performing Drug-Drug Interaction Order Check for "_PSDRUG2_" and "_PSDRUG1
- S INFO=$G(^TMP($J,BASE,"OUT","DRUGDRUG","C",PSDRUG1,PSORDER,1,"PMON",9,0))
- S INTRO=INTRO_$S($L(INFO):"...OK",1:"...Not OK")
- W !
- I '$L(INFO) D
- .D OUTPUT(INTRO)
- .W ! D OUTPUT("Drug-Drug Interaction Order Check could not be performed.",PSSLEFT)
- E D
- . D OUTPUT(INTRO)
- . W !
- . S PSSPEC("CLINICAL EFFECTS: ")=""
- . S INFO=$$REPLACE^XLFSTR(INFO,.PSSPEC)
- . S INFO="Critical Drug Interaction: "_INFO
- . D OUTPUT(INFO,PSSLEFT)
- ;
- K ^TMP($J,BASE)
- Q $S($L(INFO)=0:0,1:1)
- ;
- DUPTHRPY() ; check duplicate therapy
- ; Return 1 if OK, 0 if not OK.
- ;
- N PSORDER,PSDRUG1,PSDRUG2,BASE,CLAS1,CLAS2,LINE1,LINE2,INTRO
- N PSSLEFT S PSSLEFT=4 ; left margin for results
- S BASE=$T(+0)_" DUPTHRPY"
- K ^TMP($J,BASE)
- S ^TMP($J,BASE,"IN","THERAPY")=""
- S PSORDER="O;403931;PROFILE;3"
- S PSDRUG1="CIMETIDINE 300MG TAB"
- S PSDRUG2="RANITIDINE 150MG TAB"
- S ^TMP($J,BASE,"IN","PROFILE","O;403931;PROFILE;3")="11666^4006826^^CIMETIDINE 300MG TAB^O"
- S ^TMP($J,BASE,"IN","PROSPECTIVE","Z;1;PROSPECTIVE;1")="11673^4007038^^RANITIDINE 150MG TAB"
- D IN^PSSHRQ2(BASE)
- ;
- S CLAS1=$G(^TMP($J,BASE,"OUT","THERAPY",1,1,"CLASS"))
- S CLAS2=$G(^TMP($J,BASE,"OUT","THERAPY",1,2,"CLASS"))
- S INTRO="Performing Duplicate Therapy Order Check for "_PSDRUG1_" and "_PSDRUG2
- S INTRO=INTRO_$S($L(CLAS1):"...OK",1:"...Not OK")
- W !
- D OUTPUT(INTRO)
- I '$L(CLAS1) D
- .W !
- .D OUTPUT("Duplicate Therapy Order Check could not be performed.",PSSLEFT)
- E D
- .S LINE1="Therapeutic Duplication with "_PSDRUG1_" and "_PSDRUG2
- .S LINE2="Duplicate Therapy Class(es): "_CLAS1_","_CLAS2
- .W !
- .D OUTPUT(LINE1,PSSLEFT)
- .D OUTPUT(LINE2,PSSLEFT)
- ;
- Q $S($L(CLAS1)=0:0,1:1)
- ;
- DOSECHK() ; check dosing
- ; Return 1 if OK, 0 if not OK.
- N TOTAL,SINGLE,INTRO,ORDER,PSDRUG1,PSDRUG2,BASE
- N PSSLEFT S PSSLEFT=4 ; left margin for results
- S BASE=$T(+0)_" DOSECHK"
- S ORDER="O;1464P;PROSPECTIVE;2"
- S PSDRUG1="ACETAMINOPHEN 500MG TAB"
- K ^TMP($J,BASE)
- S ^TMP($J,BASE,"IN","DOSE")=""
- SET ^TMP($J,BASE,"IN","DOSE","AGE")=5000
- SET ^TMP($J,BASE,"IN","DOSE","WT")=83.01
- SET ^TMP($J,BASE,"IN","DOSE","BSA")=1.532
- ;VALUES: GCN^VUID^IEN^NAME^DOSE AMOUNT^DOSE UNIT^DOSE RATE^FREQ^DURATION^DURATION RATE^ROUTE^DOSE TYPE^SPECIFIC
- S ^TMP($J,BASE,"IN","DOSE","O;1464P;PROSPECTIVE;2")="4490^4007154^^ACETAMINOPHEN 500MG TAB^3000^MILLIGRAMS^DAY^Q4H^10^DAY^ORAL^MAINTENANCE^1"
- S ^TMP($J,BASE,"IN","PROSPECTIVE","O;1464P;PROSPECTIVE;2")="4490^4007154^^ACETAMINOPHEN 500MG TAB^O"
- D IN^PSSHRQ2(BASE)
- ;
- S TOTAL=$G(^TMP($J,BASE,"OUT","DOSE",ORDER,PSDRUG1,"DAILYMAX","MESSAGE",0))
- S SINGLE=$G(^TMP($J,BASE,"OUT","DOSE",ORDER,PSDRUG1,"SINGLE","MESSAGE",0))
- S INTRO="Performing Dosing Order Check for "_PSDRUG1_" - 3000MG Q4H"_$S($L(TOTAL):"...OK",1:"...Not OK")
- I '$L(TOTAL) D
- .D OUTPUT(INTRO)
- .W !
- .D OUTPUT("Dosing Order Check could not be performed.",PSSLEFT)
- E D
- .W !
- .D OUTPUT(INTRO)
- .W !
- .D OUTPUT(SINGLE,PSSLEFT)
- .W !
- .D OUTPUT(TOTAL,PSSLEFT)
- Q $S($L(TOTAL)=0:0,1:1)
- ;
- CUSTOM() ; check custom drug-drug interaction
- ; Return 1 if OK, 0 if not OK.
- ;
- N INFO,INTRO,ORDER,DRUG1,DRUG2,BASE,STATUS,PSSPEC
- N PSSLEFT S PSSLEFT=4 ; left margin for results
- S BASE=$T(+0)_" CUSTOM"
- S ORDER="Z;1;PROSPECTIVE;1"
- S DRUG1="CLARITHROMYCIN 250MG TAB",DRUG2="DIAZEPAM 5MG TAB"
- K ^TMP($J,BASE)
- S ^TMP($J,BASE,"IN","DRUGDRUG")=""
- S ^TMP($J,BASE,"IN","PROSPECTIVE","Z;1;PROSPECTIVE;1")="16373^4010075F^^CLARITHROMYCIN 250MG TAB"
- S ^TMP($J,BASE,"IN","PROFILE","I;10U;PROFILE;10")="3768^40002216^^DIAZEPAM 5MG TAB"
- D IN^PSSHRQ2(BASE)
- ;
- S STATUS=$G(^TMP($J,BASE,"OUT",0))
- S INTRO="Performing Custom Drug-Drug Interaction Order Check for "_DRUG1_" and "_DRUG2
- D SCUST
- S INTRO=INTRO_$S($L(INFO):"...OK",STATUS=0:"...OK",1:"...Not OK")
- I '$L(INFO) D
- .D OUTPUT(INTRO)
- .I STATUS'=0 W ! D OUTPUT("Custom Drug-Drug Interaction Order Check could not be performed.",PSSLEFT)
- E D
- . W !
- . D OUTPUT(INTRO)
- . W !
- . S PSSPEC("CLINICAL EFFECTS: ")=""
- . S INFO=$$REPLACE^XLFSTR(INFO,.PSSPEC)
- .S INFO="Significant Drug Interaction: "_INFO
- .D OUTPUT(INFO,PSSLEFT)
- W !
- Q $S(STATUS=0:1,$L(INFO)=0:0,1:1)
- ;
- ;
- INTACT ; check vendor data base link
- ; Called from CHECK VENDOR DATABASE LINK option
- N STATUS,PSFIN,BASE,Y,PSSCKWER,PSSCKW1,PSSCKW2,PSSCKW3
- S BASE="PSPRE"
- S PSSCKW1=$$FIND1^DIC(18.12,"","X","PEPS","B",,"PSSCKWER") K PSSCKWER
- I PSSCKW1 S PSSCKW2=$$GET1^DIQ(18.12,PSSCKW1_",",.04,"I",,"PSSCKWER") K PSSCKWER
- S:$G(PSSCKW2)="" PSSCKW2="Unknown Database" S PSSCKW3=$L(PSSCKW2)
- K ^TMP($J,BASE)
- S ^TMP($J,BASE,"IN","PING")=""
- D IN^PSSHRQ2(BASE)
- S STATUS=+$G(^TMP($J,BASE,"OUT",0))
- I STATUS=0 D
- .W !
- .W !," Database Version: ",$G(^TMP($J,BASE,"OUT","difBuildVersion"))
- .W !," Build Version: ",$G(^TMP($J,BASE,"OUT","difDbVersion"))
- .S Y=$G(^TMP($J,BASE,"OUT","difIssueDate"))
- .S:Y?8N Y=$E(Y,5,6)_"/"_$E(Y,7,8)_"/"_$E(Y,1,4)
- .W !," Issue Date: ",Y,!
- .;
- .W !," Custom Database Version: ",$G(^TMP($J,BASE,"OUT","customBuildVersion"))
- .W !," Custom Build Version: ",$G(^TMP($J,BASE,"OUT","customDbVersion"))
- .S Y=$G(^TMP($J,BASE,"OUT","customIssueDate"))
- .S:Y?8N Y=$E(Y,5,6)_"/"_$E(Y,7,8)_"/"_$E(Y,1,4)
- .W !," Custom Issue Date: ",Y,!
- .;
- .S Y=$$NOW^XLFDT()
- .D DD^%DT ; convert current time in Y to external format.
- .W !,"Connected to "_$G(PSSCKW2),!,"successfully @",$E(Y,1,18)
- E D
- .W !,"Connection could not be made to " W:PSSCKW3>46 ! W PSSCKW2_"."
- .S Y=$$GLASTRUN()
- .IF Y D
- ..D DD^%DT ; convert last reached time in Y to external format.
- ..W !," Last reached @"_$E(Y,1,18)
- ;
- D PRSRTN
- Q
- ;
- ;----------------------------------------------------
- ;
- PRSRTN ;
- ;calls std routine to ask user to hit return
- N DIR S DIR(0)="E" D ^DIR
- Q
- ;
- PING(BASE) ;
- K ^TMP($J,BASE)
- S ^TMP($J,BASE,"IN","PING")=""
- D IN^PSSHRQ2(BASE)
- Q
- ;
- HRSMIN(MIN) ;
- ; Called from output transform of VENDOR INTERFACE DATA FILE (#59.54) field TOTAL TIME NOT AVAILABLE (field# 2)
- ;INPUTS: MIN-TIME IN MINUTES
- ;RETURNS HRS AND MINUTES
- N HRS,MINHR,HRSMIN
- S HRSMIN=""
- S MINHR=60 ;TOTAL # OF MIN IN AN HR
- S HRS=MIN\MINHR,MIN=MIN#MINHR
- I HRS S HRSMIN=HRS_" HR"_$S(HRS>1:"S",1:"")
- I MIN S HRSMIN=HRSMIN_$S(HRSMIN:", ",1:"")_MIN_" MINUTE"_$S(MIN>1:"S",1:"")
- Q HRSMIN
- ;
- OUTPUT(INFO,DIWL) ;
- K ^UTILITY($J,"W")
- N DIWR,DIWF,DIW,DIWT,X
- S DIWL=$G(DIWL,1)
- S X=INFO,DIWR=$S($G(IOM):IOM,1:60),DIWF="W" D ^DIWP
- D ^DIWW
- Q
- ;
- ;
- SCUST ;Set Custom info
- I $D(^TMP($J,BASE,"OUT","DRUGDRUG","S",DRUG1,ORDER,1)) S INFO=$G(^TMP($J,BASE,"OUT","DRUGDRUG","S",DRUG1,ORDER,1,"PMON",9,0)) Q
- I $D(^TMP($J,BASE,"OUT","DRUGDRUG","S",DRUG2,"I;10U;PROFILE;10",1)) S INFO=$G(^TMP($J,BASE,"OUT","DRUGDRUG","S",DRUG2,"I;10U;PROFILE;10",1,"PMON",9,0)) Q
- S INFO=""
- Q
- ;
- VENDRPT ;**Prints out the VENDOR INTERFACE DATA FILE (#59.74) sorted by most recent downtime first**
- ;
- ;The report retrieves the output using the Fileman EN1^DIP data retrieval call
- ;
- W !!,"This report will print out all information related to when and for how long the"
- W !,"vendor interface is unavailable (sorted by most recent down time first)."
- W !,"This information comes from the VENDOR INTERFACE DATA FILE."
- W !!,?15,"*** This has the potential to be a long report ***"
- W !!,"You may queue the report to print if you wish. You may also ""^"" to halt the"
- W !,"report at any time.",!!
- ;
- N DIC,BY,L,DIPCRIT,FR,TO,DHD,DIOBEG,DIOEND,FLDS
- S DIC="^PS(59.74,",BY="-.01",L=0,DIPCRIT=1
- S FR="?,",TO="?,",DHD="VENDOR INTERFACE DATA LIST"
- S DIOBEG="W @IOF"
- S FLDS=".01;""DATE/TIME UNAVAILABLE"",1;""DATE/TIME AVAILABLE"""";C26"",2;""TOTAL DOWNTIME"""
- D EN1^DIP
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSHRIT 17179 printed Feb 18, 2025@23:57:54 Page 2
- PSSHRIT ;WOIFO/SG,PO - Transmits a "ping" to determine if FDB server is down and record the down time ; 01 Mar 2016 3:34 PM
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**136,168,164,173,180,184,178**;9/30/97;Build 14
- +2 ;
- +3 ;External reference to IN^PSSHRQ2 supported by DBIA 5369
- +4 ;External reference to File 18.12 supported by DBIA 5891
- +5 ;
- +6 QUIT
- PINGCHK ; do ping test, if not passed record it and send a message.
- +1 ; Called from PSS INTERFACE SCHEDULER option
- +2 NEW STATUS
- +3 FOR
- LOCK +^PS(59.74,"PINGCHK^PSSHRIT"):1
- if $TEST
- QUIT
- +4 SET STATUS=$$PINGTST()
- +5 SET STATUS=$$PINGFILE(STATUS)
- +6 ; if failed for the first time (a new entry created) send a message that interface is down.
- IF STATUS=-1
- DO SMSGDWN
- +7 LOCK -^PS(59.74,"PINGCHK^PSSHRIT")
- +8 QUIT
- +9 ;
- PINGTST() ; test the ping by sending a ping request.
- +1 ;return 0 - ping successful, -1^reason ping failed
- +2 NEW BASE,STATUS
- +3 SET BASE="PINGTST^"_$TEXT(+0)
- +4 KILL ^TMP($JOB,BASE)
- +5 SET ^TMP($JOB,BASE,"IN","PING")=""
- +6 DO IN^PSSHRQ2(BASE)
- +7 SET STATUS=$GET(^TMP($JOB,BASE,"OUT",0))
- +8 KILL ^TMP($JOB,BASE)
- +9 QUIT STATUS
- +10 ;
- PINGFILE(STATUS) ; file the ping results
- +1 ; Input
- +2 ; Status - Ping results
- +3 ; Return
- +4 ; -1 - if creates an entry - means the first it noticed PEPS is unavailable
- +5 ; 0 - if does not create/update a record,
- +6 ; 1 - if updates the last entry
- +7 NEW LIEN,LASTAVL
- +8 SET STATUS=+$GET(STATUS)
- +9 ; get last entry
- SET LIEN=+$ORDER(^PS(59.74,":"),-1)
- +10 ; get last available date/time
- SET LASTAVL=$PIECE($GET(^PS(59.74,LIEN,0)),U,2)
- +11 ; do nothing
- IF STATUS=0
- IF 'LIEN
- QUIT 0
- +12 ; do nothing
- IF STATUS=0
- IF LIEN
- IF LASTAVL
- QUIT 0
- +13 ; update file
- IF STATUS=0
- IF LIEN
- IF 'LASTAVL
- DO UPDATENT(LIEN)
- QUIT 1
- +14 ; create new entry
- IF STATUS=-1
- IF LIEN
- IF LASTAVL
- DO NEWENT
- QUIT -1
- +15 ; create new entry
- IF STATUS=-1
- IF 'LIEN
- DO NEWENT
- QUIT -1
- +16 QUIT 0
- NEWENT ; create a new entry in FDB INTERFACE DATA (#59.74) file.
- +1 NEW DIC,DO
- +2 SET X=$$NOW^XLFDT()
- SET DIC="^PS(59.74,"
- SET DIC(0)="Z"
- DO FILE^DICN
- +3 KILL X,Y
- +4 QUIT
- +5 ;
- UPDATENT(LAST) ; update the last entry in FDB INTERFACE DATA (#59.74) file.
- +1 ;edit flag once it is created.
- +2 NEW DIE,NEWVAL,DWNTIME,DA,DR,DIFF
- +3 SET DA=LAST
- +4 ;$$NOW()
- SET NEWVAL=$$NOW^XLFDT()
- +5 SET DWNTIME=+$GET(^PS(59.74,DA,0))
- +6 if 'DWNTIME
- QUIT
- +7 SET DIFF=$$FMDIFF^XLFDT(NEWVAL,DWNTIME,2)
- +8 ;IN MINUTES
- SET DIFF=DIFF\60
- +9 SET DIE="^PS(59.74,"
- SET DR="1///^S X=NEWVAL;2///^S X=DIFF"
- +10 DO ^DIE
- +11 ; send a message that interface connection is restored
- DO SMSGRST
- +12 QUIT
- +13 ;
- SMSGDWN ; send a bulletin that Interface connection is down.
- +1 NEW XMB,XMTEXT,XMY,PSFDB,XMV,XMDUN,XMDUZ
- +2 SET XMDUZ="PSS INTERFACE SCHEDULER"
- +3 SET XMB="PSS FDB INTERFACE"
- +4 SET XMTEXT="PSFDB"
- +5 ; check to if dosing check is on.
- +6 IF $TEXT(DS^PSSDSAPI)]""
- IF $$DS^PSSDSAPI()
- Begin DoDot:1
- +7 SET PSFDB(1)="Connection to Vendor Database is down! No Drug-Drug Interaction, Duplicate"
- +8 SET PSFDB(2)="Therapy or Dosing Order Checks will be performed until the connection is"
- +9 SET PSFDB(3)="reestablished!!!"
- End DoDot:1
- +10 IF '$TEST
- Begin DoDot:1
- +11 SET PSFDB(1)="Connection to Vendor Database is down! No Drug-Drug Interaction or Duplicate"
- +12 SET PSFDB(2)="Therapy Order Checks will be performed until the connection is reestablished!!!"
- End DoDot:1
- +13 SET XMY("G.PSS ORDER CHECKS")=""
- +14 DO ^XMB
- +15 SET DIE="^PS(59.74,"
- SET DR="3///1"
- DO ^DIE
- KILL DIE,DR,DA
- +16 QUIT
- +17 ;
- SMSGRST ; send a bulletin that Interface connection is restored
- +1 NEW XMB,XMTEXT,XMY,PSFDB,XMV,XMDUN,XMDUZ
- +2 SET XMDUZ="PSS INTERFACE SCHEDULER"
- +3 SET XMB="PSS FDB INTERFACE RESTORED"
- +4 SET XMTEXT="PSFDB"
- +5 ; check to if dosing check is on.
- +6 IF $TEXT(DS^PSSDSAPI)]""
- IF $$DS^PSSDSAPI()
- Begin DoDot:1
- +7 SET PSFDB(1)="Connection to Vendor Database has been restored! Drug-Drug Interactions,"
- +8 SET PSFDB(2)="Duplicate Therapy and Dosing Order Checks can now be performed."
- End DoDot:1
- +9 IF '$TEST
- Begin DoDot:1
- +10 SET PSFDB(1)="Connection to Vendor Database has been restored! Drug-Drug Interactions or"
- +11 SET PSFDB(2)="Duplicate Therapy Order Checks can now be performed."
- End DoDot:1
- +12 SET XMY("G.PSS ORDER CHECKS")=""
- +13 DO ^XMB
- +14 QUIT
- +15 ;
- TASKIT(FREQ,START) ; create/update scheduling option start time and frequency
- +1 ; Input:
- +2 ; FREQ - Optional - rescheduling frequency in minutes (default 15 minutes)
- +3 ; START - Optional - start time (default is current time + 4 minutes)
- +4 ; Note: if START is less than 4 minutes in future, it will be defaulted to
- +5 ; current time + 4 minutes.
- +6 ;
- +7 KILL PSERROR
- +8 SET FREQ=$GET(FREQ,15)
- +9 SET FREQ=FREQ*60_"S"
- +10 SET START=$GET(START,$$NOW^XLFDT())
- +11 ;
- +12 ; if start date/time is less than 4 minutes in future make it 4 minutes from now
- +13 if $$FMDIFF^XLFDT(START,$$NOW^XLFDT(),2)<240
- SET START=$$FMADD^XLFDT($$NOW^XLFDT(),0,0,4)
- +14 ;
- +15 ; create the option schedule if it does not exist. return PSERROR=-1 if fails.
- +16 ; in some situation when it fails, does not create the PSERROR variable
- +17 DO RESCH^XUTMOPT("PSS INTERFACE SCHEDULER",START,"",FREQ,"L",.PSERROR)
- +18 QUIT
- +19 ;
- SCHDOPT ; edit option scheduling
- +1 ; Called from "PSS SCHEDULE PEPS INTERFACE CK" option to create and/or edit the scheduling
- +2 ; parameters for "PSS INTERFACE SCHEDULER" option in OPTION SCHEDULING file.
- +3 ; The "PSS SCHEDULE PEPS INTERFACE CK" option is installed by PAS*1.0*117 package.
- +4 NEW PSSROOT,DIR,Y,DTOUT,DUOUT
- +5 ; check to see if the option is defined in option scheduler file and it is tasked.
- +6 ; if not create and task the option.
- +7 DO OPTSTAT^XUTMOPT("PSS INTERFACE SCHEDULER",.PSSROOT)
- +8 IF '+$GET(PSSROOT(1))
- DO TASKIT(15)
- +9 ;
- +10 ;Warn user that:
- +11 ; (1) the recommended interval is 15 minutes
- +12 ; (2) do not schedule for less than 5 minutes since system issues may result
- +13 ; after a downtime due to multiple jobs being scheduled
- +14 ;
- +15 WRITE !!,?5,"The PSS INTERFACE SCHEDULER task is scheduled to run next on "
- +16 SET PSSTIME=$PIECE($GET(PSSROOT(1)),"^",2)
- +17 WRITE !,?5,$SELECT('PSSTIME:"*** NOT SCHEDULED ***",1:$$FMTE^XLFDT(PSSTIME,"1P")_".")
- +18 WRITE !!,?5,"The recommended ""Rescheduling Frequency"" is 15 minutes (900 seconds)."
- +19 WRITE !!,?5,"It is currently set to ",$SELECT('+$GET(PSSROOT(1)):"*** NOT SET ***",1:$PIECE($GET(PSSROOT(1)),"^",3)_".")
- +20 WRITE !!,?5,"WARNING: Do not decrease the ""Rescheduling Frequency"" below 5 minutes."
- +21 WRITE !!,?5," System issues could occur after a downtime due to"
- +22 WRITE !,?5," multiple jobs being tasked.",!!
- +23 KILL DIR
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- +24 SET DIR("?")="Enter 'Y' to continue to the option which will allow you to change the TaskMan parameters."
- +25 SET DIR("A")="Continue to the TaskMan Schedule/Unschedule Option"
- +26 DO ^DIR
- KILL DIR
- +27 IF 'Y!($DATA(DUOUT))!($DATA(DTOUT))
- QUIT
- +28 ;
- +29 DO EDIT^XUTMOPT("PSS INTERFACE SCHEDULER")
- +30 QUIT
- +31 ;
- SLASTRUN(LASTRUN) ; set last run time
- +1 NEW SUB,PURGE,NOW,DESC
- +2 SET DESC="This stores the latest data on FDB interface"
- +3 SET NOW=$$NOW^XLFDT()\1
- +4 SET PURGE=$$FMADD^XLFDT(NOW,30)
- +5 SET ^XTMP("PSSRUN",0)=PURGE_U_NOW_U_DESC
- +6 SET ^XTMP("PSSRUN","LASTRUN")=LASTRUN
- +7 QUIT
- +8 ;
- GLASTRUN() ; get last run time
- +1 QUIT $GET(^XTMP("PSSRUN","LASTRUN"))
- +2 ;
- RUNTEST ; run interaction test to PEPS server
- +1 ; called from PSS CHECK PEPS SERVICES SETUP option
- +2 DO KILL^XUSCLEAN
- +3 NEW STATUS,X,PSSFLAG,%ZIS,POP,ZTDESC,ZTQUEUED,ZTREQ,ZTRTN
- +4 SET PSSFLAG=ION
- +5 ;
- +6 WRITE !!,"This option performs several checks. You may queue this report if you wish."
- +7 WRITE !!,"Among these checks are:"
- +8 WRITE !,"-----------------------"
- +9 WRITE !,"A connection check to the Vendor Database"
- +10 WRITE !,"Drug-Drug Interaction Check"
- +11 WRITE !,"Duplicate Therapy Order Check"
- +12 WRITE !,"Dosing Order Check"
- +13 WRITE !,"Custom Drug-Drug Interaction Check"
- +14 ;
- +15 WRITE !
- SET %ZIS="MQ"
- SET %ZIS("A")="Select Device: "
- DO ^%ZIS
- if POP
- GOTO EXIT
- +16 ;
- +17 IF '$DATA(IO("Q"))&(PSSFLAG=ION)
- DO TESTS^PSSHRIT
- QUIT
- +18 IF '$TEST
- IF $DATA(IO("Q"))!(PSSFLAG'=ION)
- Begin DoDot:1
- +19 SET ZTRTN="QTESTS^PSSHRIT"
- SET ZTDESC="Interaction test to PEPS server"
- +20 DO ^%ZTLOAD
- DO HOME^%ZIS
- DO ^%ZISC
- KILL IO("Q")
- QUIT
- End DoDot:1
- QUIT
- +21 ;
- EXIT if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +1 ;
- TESTS ; interaction tests to PEPS server
- +1 ;
- +2 SET STATUS=$$CONCHK()
- +3 DO PRSRTN
- if (STATUS=0)!(X="^")
- QUIT
- +4 ;
- +5 SET STATUS=$$INTERACT()
- +6 DO PRSRTN
- if X="^"
- QUIT
- +7 ;
- +8 SET STATUS=$$DUPTHRPY()
- +9 DO PRSRTN
- if X="^"
- QUIT
- +10 ;
- +11 ;
- SET STATUS=$$DOSECHK()
- +12 DO PRSRTN
- if X="^"
- QUIT
- +13 ;
- +14 SET STATUS=$$CUSTOM()
- +15 DO PRSRTN
- if X="^"
- QUIT
- +16 ;
- +17 QUIT
- +18 ;
- QTESTS ; queued interaction tests to PEPS server
- +1 ;
- +2 NEW %,PSSTIME,PSSCOUNT
- SET PSSTIME=""
- SET PSSCOUNT=0
- +3 DO NOW^%DTC
- SET PSSTIME=$$FMTE^XLFDT(%,"1P")
- +4 WRITE !
- FOR PSSCOUNT=1:1:79
- WRITE "-"
- +5 WRITE !!,?15,"Check PEPS Services Setup",?55,PSSTIME,!!
- +6 FOR PSSCOUNT=1:1:79
- WRITE "-"
- +7 WRITE !!
- +8 ;
- +9 SET STATUS=$$CONCHK()
- +10 SET STATUS=$$INTERACT()
- +11 SET STATUS=$$DUPTHRPY()
- +12 SET STATUS=$$DOSECHK()
- +13 SET STATUS=$$CUSTOM()
- +14 ;
- +15 QUIT
- +16 ;
- CONCHK() ; check connection
- +1 ; Return 1 if OK, 0 if not OK.
- +2 ;
- +3 NEW MESSAGE,Y,STATUS,RESULT
- +4 WRITE !,"Checking Vendor Database Connection"
- +5 SET RESULT=$$PINGTST()
- +6 IF RESULT=0
- Begin DoDot:1
- +7 WRITE "...OK"
- End DoDot:1
- +8 IF '$TEST
- Begin DoDot:1
- +9 WRITE "...",!!," Connection could not be made to Vendor database."
- +10 SET Y=$$GLASTRUN()
- +11 IF Y
- Begin DoDot:2
- +12 ; convert last reached time in Y to external format
- DO DD^%DT
- +13 WRITE !," Last reached @"_$EXTRACT(Y,1,18)
- End DoDot:2
- End DoDot:1
- +14 WRITE !
- +15 QUIT $SELECT(RESULT=0:1,1:0)
- +16 ;
- INTERACT() ; check drug-drug interaction.
- +1 ; Return 1 if OK, 0 if not OK.
- +2 ;
- +3 NEW PSORDER,PSDRUG1,PSDRUG2,BASE,INFO,INTRO,PSSPEC
- +4 ; left margin for results
- NEW PSSLEFT
- SET PSSLEFT=4
- +5 SET BASE=$TEXT(+0)_" INTERACT"
- +6 KILL ^TMP($JOB,BASE)
- +7 SET ^TMP($JOB,BASE,"IN","DRUGDRUG")=""
- +8 SET PSORDER="I;1464P;PROSPECTIVE;2"
- SET PSDRUG1="WARFARIN NA (GOLDEN STATE) 5MG TAB"
- SET PSDRUG2="CIPROFLOXACIN HCL 250MG TAB"
- +9 SET ^TMP($JOB,BASE,"IN","PROSPECTIVE","I;1464P;PROSPECTIVE;2")="006562^4029336^^WARFARIN NA (GOLDEN STATE) 5MG TAB"
- +10 SET ^TMP($JOB,BASE,"IN","PROSPECTIVE","I;91464P;PROSPECTIVE;2")="009509^4008322^^CIPROFLOXACIN HCL 250MG TAB"
- +11 DO IN^PSSHRQ2(BASE)
- +12 ;
- +13 SET INTRO="Performing Drug-Drug Interaction Order Check for "_PSDRUG2_" and "_PSDRUG1
- +14 SET INFO=$GET(^TMP($JOB,BASE,"OUT","DRUGDRUG","C",PSDRUG1,PSORDER,1,"PMON",9,0))
- +15 SET INTRO=INTRO_$SELECT($LENGTH(INFO):"...OK",1:"...Not OK")
- +16 WRITE !
- +17 IF '$LENGTH(INFO)
- Begin DoDot:1
- +18 DO OUTPUT(INTRO)
- +19 WRITE !
- DO OUTPUT("Drug-Drug Interaction Order Check could not be performed.",PSSLEFT)
- End DoDot:1
- +20 IF '$TEST
- Begin DoDot:1
- +21 DO OUTPUT(INTRO)
- +22 WRITE !
- +23 SET PSSPEC("CLINICAL EFFECTS: ")=""
- +24 SET INFO=$$REPLACE^XLFSTR(INFO,.PSSPEC)
- +25 SET INFO="Critical Drug Interaction: "_INFO
- +26 DO OUTPUT(INFO,PSSLEFT)
- End DoDot:1
- +27 ;
- +28 KILL ^TMP($JOB,BASE)
- +29 QUIT $SELECT($LENGTH(INFO)=0:0,1:1)
- +30 ;
- DUPTHRPY() ; check duplicate therapy
- +1 ; Return 1 if OK, 0 if not OK.
- +2 ;
- +3 NEW PSORDER,PSDRUG1,PSDRUG2,BASE,CLAS1,CLAS2,LINE1,LINE2,INTRO
- +4 ; left margin for results
- NEW PSSLEFT
- SET PSSLEFT=4
- +5 SET BASE=$TEXT(+0)_" DUPTHRPY"
- +6 KILL ^TMP($JOB,BASE)
- +7 SET ^TMP($JOB,BASE,"IN","THERAPY")=""
- +8 SET PSORDER="O;403931;PROFILE;3"
- +9 SET PSDRUG1="CIMETIDINE 300MG TAB"
- +10 SET PSDRUG2="RANITIDINE 150MG TAB"
- +11 SET ^TMP($JOB,BASE,"IN","PROFILE","O;403931;PROFILE;3")="11666^4006826^^CIMETIDINE 300MG TAB^O"
- +12 SET ^TMP($JOB,BASE,"IN","PROSPECTIVE","Z;1;PROSPECTIVE;1")="11673^4007038^^RANITIDINE 150MG TAB"
- +13 DO IN^PSSHRQ2(BASE)
- +14 ;
- +15 SET CLAS1=$GET(^TMP($JOB,BASE,"OUT","THERAPY",1,1,"CLASS"))
- +16 SET CLAS2=$GET(^TMP($JOB,BASE,"OUT","THERAPY",1,2,"CLASS"))
- +17 SET INTRO="Performing Duplicate Therapy Order Check for "_PSDRUG1_" and "_PSDRUG2
- +18 SET INTRO=INTRO_$SELECT($LENGTH(CLAS1):"...OK",1:"...Not OK")
- +19 WRITE !
- +20 DO OUTPUT(INTRO)
- +21 IF '$LENGTH(CLAS1)
- Begin DoDot:1
- +22 WRITE !
- +23 DO OUTPUT("Duplicate Therapy Order Check could not be performed.",PSSLEFT)
- End DoDot:1
- +24 IF '$TEST
- Begin DoDot:1
- +25 SET LINE1="Therapeutic Duplication with "_PSDRUG1_" and "_PSDRUG2
- +26 SET LINE2="Duplicate Therapy Class(es): "_CLAS1_","_CLAS2
- +27 WRITE !
- +28 DO OUTPUT(LINE1,PSSLEFT)
- +29 DO OUTPUT(LINE2,PSSLEFT)
- End DoDot:1
- +30 ;
- +31 QUIT $SELECT($LENGTH(CLAS1)=0:0,1:1)
- +32 ;
- DOSECHK() ; check dosing
- +1 ; Return 1 if OK, 0 if not OK.
- +2 NEW TOTAL,SINGLE,INTRO,ORDER,PSDRUG1,PSDRUG2,BASE
- +3 ; left margin for results
- NEW PSSLEFT
- SET PSSLEFT=4
- +4 SET BASE=$TEXT(+0)_" DOSECHK"
- +5 SET ORDER="O;1464P;PROSPECTIVE;2"
- +6 SET PSDRUG1="ACETAMINOPHEN 500MG TAB"
- +7 KILL ^TMP($JOB,BASE)
- +8 SET ^TMP($JOB,BASE,"IN","DOSE")=""
- +9 SET ^TMP($JOB,BASE,"IN","DOSE","AGE")=5000
- +10 SET ^TMP($JOB,BASE,"IN","DOSE","WT")=83.01
- +11 SET ^TMP($JOB,BASE,"IN","DOSE","BSA")=1.532
- +12 ;VALUES: GCN^VUID^IEN^NAME^DOSE AMOUNT^DOSE UNIT^DOSE RATE^FREQ^DURATION^DURATION RATE^ROUTE^DOSE TYPE^SPECIFIC
- +13 SET ^TMP($JOB,BASE,"IN","DOSE","O;1464P;PROSPECTIVE;2")="4490^4007154^^ACETAMINOPHEN 500MG TAB^3000^MILLIGRAMS^DAY^Q4H^10^DAY^ORAL^MAINTENANCE^1"
- +14 SET ^TMP($JOB,BASE,"IN","PROSPECTIVE","O;1464P;PROSPECTIVE;2")="4490^4007154^^ACETAMINOPHEN 500MG TAB^O"
- +15 DO IN^PSSHRQ2(BASE)
- +16 ;
- +17 SET TOTAL=$GET(^TMP($JOB,BASE,"OUT","DOSE",ORDER,PSDRUG1,"DAILYMAX","MESSAGE",0))
- +18 SET SINGLE=$GET(^TMP($JOB,BASE,"OUT","DOSE",ORDER,PSDRUG1,"SINGLE","MESSAGE",0))
- +19 SET INTRO="Performing Dosing Order Check for "_PSDRUG1_" - 3000MG Q4H"_$SELECT($LENGTH(TOTAL):"...OK",1:"...Not OK")
- +20 IF '$LENGTH(TOTAL)
- Begin DoDot:1
- +21 DO OUTPUT(INTRO)
- +22 WRITE !
- +23 DO OUTPUT("Dosing Order Check could not be performed.",PSSLEFT)
- End DoDot:1
- +24 IF '$TEST
- Begin DoDot:1
- +25 WRITE !
- +26 DO OUTPUT(INTRO)
- +27 WRITE !
- +28 DO OUTPUT(SINGLE,PSSLEFT)
- +29 WRITE !
- +30 DO OUTPUT(TOTAL,PSSLEFT)
- End DoDot:1
- +31 QUIT $SELECT($LENGTH(TOTAL)=0:0,1:1)
- +32 ;
- CUSTOM() ; check custom drug-drug interaction
- +1 ; Return 1 if OK, 0 if not OK.
- +2 ;
- +3 NEW INFO,INTRO,ORDER,DRUG1,DRUG2,BASE,STATUS,PSSPEC
- +4 ; left margin for results
- NEW PSSLEFT
- SET PSSLEFT=4
- +5 SET BASE=$TEXT(+0)_" CUSTOM"
- +6 SET ORDER="Z;1;PROSPECTIVE;1"
- +7 SET DRUG1="CLARITHROMYCIN 250MG TAB"
- SET DRUG2="DIAZEPAM 5MG TAB"
- +8 KILL ^TMP($JOB,BASE)
- +9 SET ^TMP($JOB,BASE,"IN","DRUGDRUG")=""
- +10 SET ^TMP($JOB,BASE,"IN","PROSPECTIVE","Z;1;PROSPECTIVE;1")="16373^4010075F^^CLARITHROMYCIN 250MG TAB"
- +11 SET ^TMP($JOB,BASE,"IN","PROFILE","I;10U;PROFILE;10")="3768^40002216^^DIAZEPAM 5MG TAB"
- +12 DO IN^PSSHRQ2(BASE)
- +13 ;
- +14 SET STATUS=$GET(^TMP($JOB,BASE,"OUT",0))
- +15 SET INTRO="Performing Custom Drug-Drug Interaction Order Check for "_DRUG1_" and "_DRUG2
- +16 DO SCUST
- +17 SET INTRO=INTRO_$SELECT($LENGTH(INFO):"...OK",STATUS=0:"...OK",1:"...Not OK")
- +18 IF '$LENGTH(INFO)
- Begin DoDot:1
- +19 DO OUTPUT(INTRO)
- +20 IF STATUS'=0
- WRITE !
- DO OUTPUT("Custom Drug-Drug Interaction Order Check could not be performed.",PSSLEFT)
- End DoDot:1
- +21 IF '$TEST
- Begin DoDot:1
- +22 WRITE !
- +23 DO OUTPUT(INTRO)
- +24 WRITE !
- +25 SET PSSPEC("CLINICAL EFFECTS: ")=""
- +26 SET INFO=$$REPLACE^XLFSTR(INFO,.PSSPEC)
- +27 SET INFO="Significant Drug Interaction: "_INFO
- +28 DO OUTPUT(INFO,PSSLEFT)
- End DoDot:1
- +29 WRITE !
- +30 QUIT $SELECT(STATUS=0:1,$LENGTH(INFO)=0:0,1:1)
- +31 ;
- +32 ;
- INTACT ; check vendor data base link
- +1 ; Called from CHECK VENDOR DATABASE LINK option
- +2 NEW STATUS,PSFIN,BASE,Y,PSSCKWER,PSSCKW1,PSSCKW2,PSSCKW3
- +3 SET BASE="PSPRE"
- +4 SET PSSCKW1=$$FIND1^DIC(18.12,"","X","PEPS","B",,"PSSCKWER")
- KILL PSSCKWER
- +5 IF PSSCKW1
- SET PSSCKW2=$$GET1^DIQ(18.12,PSSCKW1_",",.04,"I",,"PSSCKWER")
- KILL PSSCKWER
- +6 if $GET(PSSCKW2)=""
- SET PSSCKW2="Unknown Database"
- SET PSSCKW3=$LENGTH(PSSCKW2)
- +7 KILL ^TMP($JOB,BASE)
- +8 SET ^TMP($JOB,BASE,"IN","PING")=""
- +9 DO IN^PSSHRQ2(BASE)
- +10 SET STATUS=+$GET(^TMP($JOB,BASE,"OUT",0))
- +11 IF STATUS=0
- Begin DoDot:1
- +12 WRITE !
- +13 WRITE !," Database Version: ",$GET(^TMP($JOB,BASE,"OUT","difBuildVersion"))
- +14 WRITE !," Build Version: ",$GET(^TMP($JOB,BASE,"OUT","difDbVersion"))
- +15 SET Y=$GET(^TMP($JOB,BASE,"OUT","difIssueDate"))
- +16 if Y?8N
- SET Y=$EXTRACT(Y,5,6)_"/"_$EXTRACT(Y,7,8)_"/"_$EXTRACT(Y,1,4)
- +17 WRITE !," Issue Date: ",Y,!
- +18 ;
- +19 WRITE !," Custom Database Version: ",$GET(^TMP($JOB,BASE,"OUT","customBuildVersion"))
- +20 WRITE !," Custom Build Version: ",$GET(^TMP($JOB,BASE,"OUT","customDbVersion"))
- +21 SET Y=$GET(^TMP($JOB,BASE,"OUT","customIssueDate"))
- +22 if Y?8N
- SET Y=$EXTRACT(Y,5,6)_"/"_$EXTRACT(Y,7,8)_"/"_$EXTRACT(Y,1,4)
- +23 WRITE !," Custom Issue Date: ",Y,!
- +24 ;
- +25 SET Y=$$NOW^XLFDT()
- +26 ; convert current time in Y to external format.
- DO DD^%DT
- +27 WRITE !,"Connected to "_$GET(PSSCKW2),!,"successfully @",$EXTRACT(Y,1,18)
- End DoDot:1
- +28 IF '$TEST
- Begin DoDot:1
- +29 WRITE !,"Connection could not be made to "
- if PSSCKW3>46
- WRITE !
- WRITE PSSCKW2_"."
- +30 SET Y=$$GLASTRUN()
- +31 IF Y
- Begin DoDot:2
- +32 ; convert last reached time in Y to external format.
- DO DD^%DT
- +33 WRITE !," Last reached @"_$EXTRACT(Y,1,18)
- End DoDot:2
- End DoDot:1
- +34 ;
- +35 DO PRSRTN
- +36 QUIT
- +37 ;
- +38 ;----------------------------------------------------
- +39 ;
- PRSRTN ;
- +1 ;calls std routine to ask user to hit return
- +2 NEW DIR
- SET DIR(0)="E"
- DO ^DIR
- +3 QUIT
- +4 ;
- PING(BASE) ;
- +1 KILL ^TMP($JOB,BASE)
- +2 SET ^TMP($JOB,BASE,"IN","PING")=""
- +3 DO IN^PSSHRQ2(BASE)
- +4 QUIT
- +5 ;
- HRSMIN(MIN) ;
- +1 ; Called from output transform of VENDOR INTERFACE DATA FILE (#59.54) field TOTAL TIME NOT AVAILABLE (field# 2)
- +2 ;INPUTS: MIN-TIME IN MINUTES
- +3 ;RETURNS HRS AND MINUTES
- +4 NEW HRS,MINHR,HRSMIN
- +5 SET HRSMIN=""
- +6 ;TOTAL # OF MIN IN AN HR
- SET MINHR=60
- +7 SET HRS=MIN\MINHR
- SET MIN=MIN#MINHR
- +8 IF HRS
- SET HRSMIN=HRS_" HR"_$SELECT(HRS>1:"S",1:"")
- +9 IF MIN
- SET HRSMIN=HRSMIN_$SELECT(HRSMIN:", ",1:"")_MIN_" MINUTE"_$SELECT(MIN>1:"S",1:"")
- +10 QUIT HRSMIN
- +11 ;
- OUTPUT(INFO,DIWL) ;
- +1 KILL ^UTILITY($JOB,"W")
- +2 NEW DIWR,DIWF,DIW,DIWT,X
- +3 SET DIWL=$GET(DIWL,1)
- +4 SET X=INFO
- SET DIWR=$SELECT($GET(IOM):IOM,1:60)
- SET DIWF="W"
- DO ^DIWP
- +5 DO ^DIWW
- +6 QUIT
- +7 ;
- +8 ;
- SCUST ;Set Custom info
- +1 IF $DATA(^TMP($JOB,BASE,"OUT","DRUGDRUG","S",DRUG1,ORDER,1))
- SET INFO=$GET(^TMP($JOB,BASE,"OUT","DRUGDRUG","S",DRUG1,ORDER,1,"PMON",9,0))
- QUIT
- +2 IF $DATA(^TMP($JOB,BASE,"OUT","DRUGDRUG","S",DRUG2,"I;10U;PROFILE;10",1))
- SET INFO=$GET(^TMP($JOB,BASE,"OUT","DRUGDRUG","S",DRUG2,"I;10U;PROFILE;10",1,"PMON",9,0))
- QUIT
- +3 SET INFO=""
- +4 QUIT
- +5 ;
- VENDRPT ;**Prints out the VENDOR INTERFACE DATA FILE (#59.74) sorted by most recent downtime first**
- +1 ;
- +2 ;The report retrieves the output using the Fileman EN1^DIP data retrieval call
- +3 ;
- +4 WRITE !!,"This report will print out all information related to when and for how long the"
- +5 WRITE !,"vendor interface is unavailable (sorted by most recent down time first)."
- +6 WRITE !,"This information comes from the VENDOR INTERFACE DATA FILE."
- +7 WRITE !!,?15,"*** This has the potential to be a long report ***"
- +8 WRITE !!,"You may queue the report to print if you wish. You may also ""^"" to halt the"
- +9 WRITE !,"report at any time.",!!
- +10 ;
- +11 NEW DIC,BY,L,DIPCRIT,FR,TO,DHD,DIOBEG,DIOEND,FLDS
- +12 SET DIC="^PS(59.74,"
- SET BY="-.01"
- SET L=0
- SET DIPCRIT=1
- +13 SET FR="?,"
- SET TO="?,"
- SET DHD="VENDOR INTERFACE DATA LIST"
- +14 SET DIOBEG="W @IOF"
- +15 SET FLDS=".01;""DATE/TIME UNAVAILABLE"",1;""DATE/TIME AVAILABLE"""";C26"",2;""TOTAL DOWNTIME"""
- +16 DO EN1^DIP
- +17 QUIT