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

PSSHRIT.m

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