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

PSOTEXP1.m

Go to the documentation of this file. 
  1. PSOTEXP1 ;BIR/LE-Tally Missing Expiration Dates ;06/14/06
  1.  ;;7.0;OUTPATIENT PHARMACY;**250,268**;DEC 1997;Build 9
  1.  ;External references ^DPT supported by DBIA 10035
  1.  N NAMSP,PATCH,JOBN,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,Y,ZTQUEUED,ZTREQ,ZTSAVE
  1.  S NAMSP=$$NAMSP
  1.  S JOBN="TALLY MISSING EXPIRATION DATES"
  1.  S PATCH="PSO*7*250"
  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('PSOTEXP1') 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")="  Enter when to Queue the "_JOBN_" job to run 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^PSOTEXP1",ZTIO=""
  1.  S ZTDESC="Background job for "_JOBN_" on prescriptions updated via "_PATCH
  1.  S ZTSAVE("JOBN")=""
  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. QUIT ;
  1.  L -^XTMP(NAMSP)
  1.  Q
  1. EN ;
  1.  N PATCH,NAMSP S NAMSP=$$NAMSP,PATCH="PSO*7*250",JOBN="TALLY MISSING EXPIRATION DATES"
  1.  ;if can't get Lock, then already running.
  1.  L +^XTMP(NAMSP):3 I '$T D  Q
  1.  . S:$D(ZTQUEUED) ZTREQ="@"
  1.  . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="LOCKED^"_$$NOW^XLFDT
  1.  ;
  1.  N PSOSTART,Y,PSOS1,RXP,PSOV7,PSOARR,PSOISS,PSOEXP,PSOSTA,PSOACT,PSOINST,CC,RXE,DFN,PSODRUG,PSOINACT
  1.  ;
  1.  D NOW^%DTC S (Y,PSOS1)=% D DD^%DT S PSOSTART=Y
  1.  I '$G(DT) S DT=$$DT^XLFDT
  1.  S RXP=+$P($G(^XTMP(NAMSP,0,"LAST")),"^",4)
  1.  ;get date that PSO v7 was installed
  1.  S PSOV7=$S($P($G(^PS(59.7,1,49.99)),"^",7):$P(^PS(59.7,1,49.99),"^",7),1:$P($G(^PS(59.7,1,49.99)),"^",4))
  1.  S:PSOV7["." PSOV7=$P(PSOV7,".",1)
  1.  ;
  1.  ;^XTMP(NAMSP,INSTITUTION)=tot missing expiration dates on or before v7 install^tot missing expiration dates after v7 install^total missing expiration dates^tot past expiration date minus 1 day
  1.  ;
  1.  S PSOINST=$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),"^",17),99)),"^")
  1.  S:'$G(PSOINST) PSOINST="9999999999"
  1.  S PSOACT=",0,1,2,3,4,5,10,16,",PSOINACT=",11,12,13,14,15,"
  1.  N STOP K ^XTMP(NAMSP,0,"STOP") S STOP=0 S:RXP="" RXP=0
  1.  F CC=1:1 S RXP=$O(^PSRX(RXP)) Q:'RXP!(RXP'?1N.NN)  D  Q:STOP
  1.  . I $D(^XTMP(NAMSP,0,"STOP")) D  Q
  1.  . . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="STOP^"_$$NOW^XLFDT,STOP=1
  1.  . K PSOARR D GETS^DIQ(52,RXP_",",".01;2;6;1;20;26;100","I","PSOARR")
  1.  . S DFN=$G(PSOARR(52,RXP_",",2,"I")),PSODRUG=$G(PSOARR(52,RXP_",",6,"I")),PSOSTA=$G(PSOARR(52,RXP_",",100,"I"))
  1.  . S PSOISS=$G(PSOARR(52,RXP_",",1,"I"))
  1.  . ;--- eliminate bad Rx's
  1.  . Q:DFN=""!(PSODRUG="")
  1.  . Q:'$D(^DPT(DFN))!('$D(^PSDRUG(PSODRUG)))
  1.  . Q:$G(PSOISS)=""
  1.  . ;--- 
  1.  . S RXE=$G(PSOARR(52,RXP_",",".01","I")),PSOEXP=$G(PSOARR(52,RXP_",",26,"I"))
  1.  . ;save last date & fill info
  1.  . S $P(^XTMP(NAMSP,0,"LAST"),"^",3,5)=$G(PSOISS)_"^"_RXP
  1.  . D SET
  1.  G STP:STOP
  1.  S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
  1.  D MAIL
  1. STP ;
  1.  L -^XTMP(NAMSP)
  1.  I $D(^XTMP(NAMSP,0,"STOP")) S ^XTMP(NAMSP,0,"ZAUDIT",$H)="STOPPED ON"_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  K JOBN
  1.  ;I '$D(^XTMP(NAMSP,0,"STOP")) K ^XTMP(NAMSP)
  1.  Q
  1.  ;
  1. SET ;Data collected and stored:
  1.  ; Piece 1 - Pre-install v7 active Rx's with null expiration date
  1.  ; Piece 2 - Pre-install v7 inactive Rx's with null expiration date
  1.  ; Piece 3 - Post-install v7 active Rx's with null expiration
  1.  ; Piece 4 - Post-install v7 inactive Rx's with null expiration
  1.  ; Piece 5 - total Rx's with null expiration date
  1.  ; Piece 6 - total active Rx's with expire date of t-1 day
  1.  ;
  1.  I PSOEXP="" D  Q
  1.  . I PSOISS'>PSOV7 D
  1.  . . S:PSOACT[(","_PSOSTA_",") $P(^XTMP(NAMSP,PSOINST),"^",1)=$P($G(^XTMP(NAMSP,PSOINST)),"^",1)+1
  1.  . . S:PSOINACT[(","_PSOSTA_",") $P(^XTMP(NAMSP,PSOINST),"^",2)=$P($G(^XTMP(NAMSP,PSOINST)),"^",2)+1
  1.  . I PSOISS>PSOV7 D 
  1.  . . S:PSOACT[(","_PSOSTA_",") $P(^XTMP(NAMSP,PSOINST),"^",3)=$P($G(^XTMP(NAMSP,PSOINST)),"^",3)+1
  1.  . . S:PSOINACT[(","_PSOSTA_",") $P(^XTMP(NAMSP,PSOINST),"^",4)=$P($G(^XTMP(NAMSP,PSOINST)),"^",4)+1
  1.  . S $P(^XTMP(NAMSP,PSOINST),"^",5)=$P($G(^XTMP(NAMSP,PSOINST)),"^",5)+1
  1.  .;S ^XTMP("PSOTEXP1","MISS",RXP)=PSOINST_"^"_PSOISS_"^"_PSOV7_"^"_PSOEXP_"^"_$S($G(PSOSTA)'="":PSOSTA,1:"*")_"^"_$P($G(^PSRX(RXP,0)),"^")
  1.  ; normal daily job expires all rx's with yesterday's date, so looking for anything before yesterday.
  1.  I (PSOEXP<(DT-1))&(PSOACT[(","_PSOSTA_",")) S $P(^XTMP(NAMSP,PSOINST),"^",6)=$P($G(^XTMP(NAMSP,PSOINST)),"^",6)+1
  1.  ;.S ^XTMP("PSOTEXP1","PAST",$S($G(PSOSTA)'="":PSOSTA,1:"*"),PSOEXP,RXP)=PSOINST_"^"_PSOISS_"^"_PSOV7_"^"_PSOEXP_"^"_PSOSTA_"^"_$P($G(^PSRX(RXP,0)),"^")
  1.  Q
  1.  ;
  1. STATUS ;show status of job running
  1.  I $$ST D
  1.  . W !,"Currently processing:"
  1.  . I $G(^XTMP($$NAMSP,0,"LAST"))["COMPLETED" D
  1.  . . W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
  1.  . W !?5,"Date being processed > ",$$FMTE^XLFDT($P(^XTMP($$NAMSP,0,"LAST"),"^",3))
  1.  . W !?5,"                RX # > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",4)
  1.  . ;W !?5,"          TOTAL RX's > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",5),!
  1.  E  D
  1.  .I $G(^XTMP($$NAMSP,0,"LAST"))["COMPLETED" D
  1.  .. W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
  1.  Q
  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. 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. 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. NAMSP() ;
  1.  Q $T(+0)
  1.  ;
  1. MAIL ;
  1.  N PSOEND,PSOEND2,PSOTEXT,XMY,LIN,DATA,J,L,PSOINST,M,LEN
  1.  S LIN="",$P(LIN," ",80)="",LEN=80
  1.  D NOW^%DTC S Y=% D DD^%DT S PSOEND=Y
  1.  S PSOEND2=$$FMTE^XLFDT(%,"1PS")
  1.  I $G(DUZ) S XMY(DUZ)=""
  1.  S XMDUZ=PATCH_" "_JOBN
  1.  S XMSUB="Outpatient Pharmacy "_PATCH_" "_JOBN
  1.  S XMY("ELLZEY.LINDA@DOMAIN.EXT")=""
  1.  S XMY("WHITE.ELAINE@DOMAIN.EXT")=""
  1.  S XMY("WILLIAMSON.ERIC@DOMAIN.EXT")=""
  1.  I $O(XMY(""))="" Q  ; no recipients for mail message
  1.  S PSOTEXT(1)="The "_JOBN_" job for the Outpatient Pharmacy"
  1.  S PSOTEXT(2)="patch ("_PATCH_") started "_PSOSTART
  1.  S PSOTEXT(3)="and completed "_PSOEND_"."
  1.  S PSOTEXT(4)=" "
  1.  S PSOTEXT(5)="Excel comma delimited data below, five headings, one data line"
  1.  S PSOTEXT(6)="Note that an institution of 999999999 denotes one was not found during run."
  1.  S PSOTEXT(7)=",,,,,,Total Active Rx's"
  1.  S PSOTEXT(8)=",Before v7 Install,Before v7 Install,After v7 Install,After v7 Install,,With"
  1.  S PSOTEXT(9)=",Tot Active Rx's,Tot Inactive,Tot Active,Tot Inactive,Total Rx's,Expiration"
  1.  S PSOTEXT(10)=",Missing Expired,Rx's Missing,Rx's Missing,Rx's Missing,Missing,Date of T-1"
  1.  S PSOTEXT(11)="Institution,Date,Expired Date,Expired Date,Expired Date,Expired Date,Day"
  1.  S PSOINST=0,L=12
  1.  F  S PSOINST=$O(^XTMP(NAMSP,PSOINST)) Q:PSOINST=""!(PSOINST'?1N.NN)  D
  1.  . S DATA=^XTMP(NAMSP,PSOINST),DATA=$TR(DATA,"^",",")
  1.  . S PSOTEXT(L)=$E((PSOINST_","_DATA_LIN),1,LEN),L=L+1
  1.  S L=L+1,PSOTEXT(L)=" "
  1.  ;
  1.  S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
  1.  Q