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

PSJSFRQ.m

Go to the documentation of this file. 
  1. PSJSFRQ ; SMT - SEARCH FOR ERRONEOUS FREQS ; 4/23/09 3:28pm
  1.  ;;5.0; INPATIENT MEDICATIONS ;**221**; FEB 09;Build 11
  1.  ; Enter EN^PSJSFRQ for Programmer
  1.  ; QUE^PSJSFRQ to QUEUE for the past 6 months
  1.  ; Mail sends to DUZ and anyone holding "PSJ RPHARM" key
  1.  Q  ; No entry from ^PSJSFRQ
  1.  ;
  1. QUE ;
  1.  N NAMSP,PATCH,JOBN,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,Y,ZTQUEUED,ZTREQ,ZTSAVE,PSJQUE,PSRUN
  1.  S NAMSP=$$NAMSP
  1.  S JOBN="Frequency Report"
  1.  S PATCH="PSJ*5*221"
  1.  S PSRUN="U" ;This is the type of run UD or IV for the report.
  1.  ;
  1.  L +^XTMP(NAMSP):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T D  Q
  1.  . D BMES^XPDUTL(JOBN_" job is already running.  Halting...")
  1.  . D MES^XPDUTL("")
  1.  . D QUIT
  1.  ;
  1.  I '$D(^XTMP(NAMSP)) D INITXTMP(NAMSP,JOBN_", "_PATCH,90)        ;90 day life
  1.  S QUIT=0
  1.  ;
  1.  I $G(^XTMP(NAMSP,0,"LAST"))["COMPLETED" D  Q
  1.  . W !!,*7,"This job has been run before to completion on "
  1.  . W $$FMTE^XLFDT($P($G(^XTMP(NAMSP,0,"LAST")),"^",2)),!!
  1.  . W "If you want to run it again, the global subscript ^XTMP('"_NAMSP_"') must be",!
  1.  . W "deleted prior to doing so.",!!
  1.  . D QUIT
  1.  ;
  1.  ;ques 2, if running from mumps prompt
  1.  I '$D(XPDQUES("POS2")) D  I 'ZTDTH D QUIT Q
  1.  . K DIR
  1.  . S DIR("A",1)=" Enter when to Queue the "_JOBN_" job to run"
  1.  . S DIR("A")=" in date@time format"
  1.  . S DIR("B")="NOW"
  1.  . S DIR(0)="D^::%DT"
  1.  . S DIR("?")=" Enter when to start the job. The default is Now. You can enter a date and time in the format like this: 021506@3:30p"
  1.  . D ^DIR I $D(DUOUT) W !,"Halting..." S ZTDTH="" Q
  1.  . S:$D(DTOUT) Y=$$NOW^XLFDT S ZTDTH=$$FMTH^XLFDT(Y)
  1.  ;
  1.  ;ques 2, if running from kids install
  1.  I $D(XPDQUES("POS2")) S ZTDTH=$$FMTH^XLFDT(XPDQUES("POS2"))
  1.  ;
  1.  D BMES^XPDUTL("=============================================================")
  1.  D MES^XPDUTL("Queuing background job for "_JOBN_"...")
  1.  D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
  1.  D MES^XPDUTL("==============================================================")
  1.  I ZTDTH="" D BMES^XPDUTL(JOBN_" NOT QUEUED") D QUIT Q
  1.  ;
  1.  S:$D(^XTMP(NAMSP,0,"LAST")) ^XTMP(NAMSP,0,"ZAUDIT",$H)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
  1.  ;
  1.  I $P($G(^XTMP(NAMSP,0,"LAST")),"^")="STOP" D
  1.  . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
  1.  E  D
  1.  . S ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
  1.  ;
  1.  S ZTRTN="EN^"_NAMSP,ZTIO="",PSJQUE=1
  1.  S ZTDESC="Background job for "_JOBN_" on prescriptions updated via "_PATCH
  1.  S ZTSAVE("JOBN")="",ZTSAVE("PSJQUE")="",ZTSAVE("PSRUN")=""
  1.  L -^XTMP(NAMSP)
  1.  D ^%ZTLOAD
  1.  D:$D(ZTSK)
  1.  . D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
  1.  . D BMES^XPDUTL("")
  1.  D BMES^XPDUTL("")
  1.  K XPDQUES
  1.  Q
  1.  ;
  1. EN ;
  1.  N MSG,MCNT,START,STOP,I,DFN,IEN,ORD,SCH,OINFO,CNT,I,SUBJ,STARTH,STOPH,VADM,INF,Y,X,% K ERORD
  1.  I '$G(PSJQUE) W !,"This report will generate a mailman of problem Orders with incorrect frequency"
  1.  I '$G(PSJQUE),'$G(PSRUN) S PSRUN="" F  D  Q:(PSRUN="U")!(PSRUN="I")!(PSRUN="UI")!(PSRUN="")!(PSRUN["^")
  1.  . W !,"Please Select, type of order to run this report on",!,"U - Unit Dose",!,"I - IV",!,"UI - Both",!,"Selection:"
  1.  . R PSRUN:$S($G(DTIME):DTIME,1:9999) E  S PSRUN="^" Q
  1.  . I (PSRUN'="U")&(PSRUN'="I")&(PSRUN'="UI")&(PSRUN'["^")&(PSRUN'="") W "  <??>",$C(7)
  1.  Q:(PSRUN["^")!(PSRUN="")
  1.  D RANGE Q:START=-1
  1.  ;UD Orders
  1.  I PSRUN["U" D
  1.  . S I=START F  S I=$O(^PS(55,"AUDS",I)) Q:'I!(I>STOP)  D
  1.  . . S DFN=0 F  S DFN=$O(^PS(55,"AUDS",I,DFN)) Q:'DFN  D
  1.  . . . S IEN=0 F  S IEN=$O(^PS(55,"AUDS",I,DFN,IEN)) Q:'IEN  D 
  1.  . . . . S ORD=DFN_";"_IEN_"U"
  1.  . . . . K OINFO,SCH S OINFO=$$INFO(ORD) S SCH=$$GETSCH($P(OINFO,"^")) Q:SCH=0
  1.  . . . . I $$CHKSDT(ORD) S ERORD(ORD)=""
  1.  . . . . I ("AH"[$P(OINFO,"^",4)),+$P(OINFO,"^",3)'=+$P(SCH,"^",3) Q:'$P(OINFO,"^",3)!($P(OINFO,"^",6)'="C")  S ERORD(ORD)=""
  1.  ;IV orders
  1.  I PSRUN["I" D
  1.  . S I=START F  S I=$O(^PS(55,"AIVS",I)) Q:'I!(I>STOP)  D
  1.  . . S DFN=0 F  S DFN=$O(^PS(55,"AIVS",I,DFN)) Q:'DFN  D
  1.  . . . S IEN=0 F  S IEN=$O(^PS(55,"AIVS",I,DFN,IEN)) Q:'IEN  D
  1.  . . . . S ORD=DFN_";"_IEN_"I"
  1.  . . . . K OINFO,SCH S OINFO=$$INFO(ORD) S SCH=$$GETSCH($P(OINFO,"^")) Q:SCH=0
  1.  . . . . I ("AH"[$P(OINFO,"^",4)),+$P(OINFO,"^",3)'=+$P(SCH,"^",3) Q:'$P(OINFO,"^",3)!($P(OINFO,"^",6)'="P")  S ERORD(ORD)=""
  1.  ;Pending Orders
  1.  ;TBD
  1.  ;
  1.  ;CREATE Message to send based on ERORD
  1.  S CNT=1
  1.  S Y=START D DD^%DT S STARTH=Y
  1.  S Y=STOP D DD^%DT S STOPH=Y
  1.  S SUBJ="FREQUENCY MISMATCH :"_RUNTM
  1.  S MSG(CNT)="This is a list of orders with mismatching frequencies and possible",CNT=CNT+1
  1.  S MSG(CNT)="start date problems. This excludes orders with no frequency and invalid",CNT=CNT+1
  1.  S MSG(CNT)="schedules, the orders on this list need to be reviewed!",CNT=CNT+1
  1.  S MSG(CNT)="This report range is from:"_STARTH_" to "_STOPH,CNT=CNT+1
  1.  I '$D(ERORD) S MSG(CNT)="There are no problems.",CNT=CNT+1
  1.  S I=0 F  S I=$O(ERORD(I)) Q:'I  D
  1.  . S INF=$$INFO(I),DFN=$P(I,";") K VA,VADM D
  1.  . . N I D ^VADPT
  1.  . S MSG(CNT)="",CNT=CNT+1
  1.  . S MSG(CNT)="PATIENT:"_VADM(1)_"  SSN:"_VA("BID"),CNT=CNT+1 I I'["I" S MSG(CNT-1)=MSG(CNT-1)_"  DRUG:"_$P(^PSDRUG($P(INF,"^",5),0),"^")
  1.  . S MSG(CNT)="DFN:"_$P(I,";")_"   ORDER#:"_+$P(I,";",2)_"   SCHED:"_$P(INF,"^")_"   STATUS:"_$P(INF,"^",4),CNT=CNT+1
  1.  . S MSG(CNT)="  TYPE:"_$S(I["I":"IV",I["U":"UNIT DOSE",1:"PENDING")_"   FREQ:"_$P(INF,"^",3),CNT=CNT+1
  1.  ;
  1.  ;Send message
  1.  D MAIL(.MSG,SUBJ)
  1.  Q
  1. RANGE ;
  1.  N NOW,%DT,Y,X,X1,X2,% K START,STOP,RUNTM
  1.  D NOW^%DTC S NOW=% S Y=$P(%,".") D DD^%DT S RUNTM=Y
  1.  ;If this is qued, don't ask, just set to 6 months.
  1.  I $G(PSJQUE) S STOP=NOW,X1=NOW,X2=-183 D C^%DTC S START=X Q
  1.  S %DT="AEPT",%DT("A")="Start Date:",%DT(0)="-NOW" D ^%DT
  1.  S START=Y I Y=-1 Q
  1.  S %DT="AEPT",%DT("A")="Stop Date:",%DT(0)=START D ^%DT
  1.  S STOP=Y I Y=-1 Q
  1.  Q
  1.  ;
  1. GETSCH(SCHED) ;
  1.  ; 
  1.  ; Returns "SCHED^AT^FREQ^PKG"
  1.  ;
  1.  N I,FRQ,PKG,AT K FREQ
  1.  Q:SCHED']"" 0
  1.  I '$O(^PS(51.1,"APPSJ",SCHED,0)) Q 0
  1.  S I=0 F  S I=$O(^PS(51.1,"APPSJ",SCHED,I)) Q:'I  D
  1.  . ;Get Data
  1.  . S FRQ=$P(^PS(51.1,I,0),"^",3),PKG=$P(^(0),"^",4),AT=$P(^(0),"^",2)
  1.  ;
  1.  Q $G(SCHED)_"^"_$G(AT)_"^"_$G(FRQ)_"^"_$G(PKG)
  1.  ;
  1. INFO(ORD) ;
  1.  ;
  1.  ; IEN=DFN;IEN(TYPE) 
  1.  ; ex 2222;102U or 2222;32I or ;23P
  1.  ;
  1.  ; Return "SCHED^AT^FRQ^STATUS^DRUG^SCHTP" (SCHTP is Schedule Type for UD and TYPE for IV
  1.  ;
  1.  N F,SCHED,AT,FRQ,DFN,STAT,DRUG,X,SCHTP,DSPDG,ND0 K DTA55
  1.  S DFN=$P(ORD,";")
  1.  I ORD["P" S F="^PS(53.1,"_+$P(ORD,";",2)_","
  1.  E  S F="^PS(55,"_DFN_","_$S(ORD["U":"5",1:"""IV""")_","_+$P(ORD,";",2)_","
  1.  ;Unit Dose
  1.  I (ORD["U")!(ORD["P") D
  1.  . S ND0=F_"0)"
  1.  . S DSPDG=F_"1," S X=DSPDG_"0)" S X=$O(@X),DSPDG=$G(@(DSPDG_$S(+X:X,1:1)_",0)"))
  1.  . S F=F_"2)"
  1.  . S SCHED=$P(@F,"^"),AT=$P(@F,"^",5),FRQ=$P(@F,"^",6),STAT=$P(@ND0,"^",9),DRUG=$P(DSPDG,"^"),SCHTP=$P(@ND0,"^",7)
  1.  ;IV
  1.  I ORD["I" D
  1.  . S DRUG=""
  1.  . S F=F_"0)"
  1.  . S SCHED=$P(@F,"^",9),AT=$P(@F,"^",11),FRQ=$P(@F,"^",15),STAT=$P(@F,"^",17),SCHTP=$P(@F,"^",4)
  1.  ;
  1.  Q $G(SCHED)_"^"_$G(AT)_"^"_$G(FRQ)_"^"_$G(STAT)_"^"_$G(DRUG)_"^"_$G(SCHTP)
  1.  ;
  1. CHKSDT(ORD) ;
  1.  ;
  1.  ; If this function returns 1 there is a start date problem.
  1.  ;
  1.  N DFN,ERR,ND2,ND0,I,LIDT,STDT,F,ND
  1.  Q:ORD["I" 0
  1.  S DFN=$P(ORD,";")
  1.  I ORD["P" S F="^PS(53.1,"_+$P(ORD,";",2)_","
  1.  E  S F="^PS(55,"_DFN_","_$S(ORD["U":"5",1:"""IV""")_","_+$P(ORD,";",2)_","
  1.  S ND2=F_"2)",ND2=@ND2,ND0=F_"0)",ND0=@ND0,ERR=0
  1.  I ORD["U" D
  1.  . S STDT=$P(ND2,"^",2),LIDT=$P(ND0,"^",14),I=""
  1.  . F  S I=$O(^PS(55,DFN,5,+$P(ORD,";",2),9,I),-1) Q:'I  S ND=^(I,0) I $P(ND,"^",3)["Start Date" D  Q
  1.  . . Q:STDT=LIDT
  1.  . . I STDT'=$P(ND,"^",5) S ERR=1
  1.  Q ERR
  1.  ;
  1. MAIL(MSG,SBJ) ; Send out some mail!
  1.  N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,I
  1.  S XMDUZ="INPT PHARMACY",XMSUB=SBJ,XMTEXT="MSG("
  1.  S XMY(DUZ)="",I=0 F  S I=$O(^XUSEC("PSJ RPHARM",I)) Q:'I  S XMY(I)=""
  1.  D ^XMD
  1.  Q ""
  1.  ;
  1. NAMSP() ;
  1.  Q $T(+0)
  1.  ;
  1. STOP ;stop job command
  1.  I $$ST S ^XTMP($$NAMSP,0,"STOP")="" D
  1.  . W !,"TALLY MISSING EXPIRATION DATES Job - set to STOP Soon"
  1.  . W !!,"Check Status to be sure it has stopped and is not running..."
  1.  . W !,"     (D STATUS^PSOTEXP1)"
  1.  Q
  1.  ;
  1. ST() ;status
  1.  L +^XTMP($$NAMSP):3 I $T D  Q 0
  1.  . L -^XTMP($$NAMSP)
  1.  . W !,"*** NOT CURRENTLY RUNNING! ***",!
  1.  Q 1
  1.  ;
  1. INITXTMP(NAMSP,TITLE,LIFE) ;create ^Xtmp according to SAC std
  1.  N BEGDT,PURGDT
  1.  S BEGDT=$$NOW^XLFDT()
  1.  S PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
  1.  S ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
  1.  Q
  1.  ;
  1. QUIT ;
  1.  L -^XTMP(NAMSP)
  1.  Q
  1.  ;