PSOTEXP1 ;BIR/LE-Tally Missing Expiration Dates ;06/14/06
;;7.0;OUTPATIENT PHARMACY;**250,268**;DEC 1997;Build 9
;External references ^DPT supported by DBIA 10035
N NAMSP,PATCH,JOBN,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,Y,ZTQUEUED,ZTREQ,ZTSAVE
S NAMSP=$$NAMSP
S JOBN="TALLY MISSING EXPIRATION DATES"
S PATCH="PSO*7*250"
;
L +^XTMP(NAMSP):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T D Q
. D BMES^XPDUTL(JOBN_" job is already running. Halting...")
. D MES^XPDUTL("")
. D QUIT
;
I '$D(^XTMP(NAMSP)) D INITXTMP(NAMSP,JOBN_", "_PATCH,90) ;90 day life
S QUIT=0
;
I $G(^XTMP(NAMSP,0,"LAST"))["COMPLETED" D Q
. W !!,*7,"This job has been run before to completion on "
. W $$FMTE^XLFDT($P($G(^XTMP(NAMSP,0,"LAST")),"^",2)),!!
. W "If you want to run it again, the global subscript ^XTMP('PSOTEXP1') must be",!
. W "deleted prior to doing so.",!!
. D QUIT
;
;ques 2, if running from mumps prompt
I '$D(XPDQUES("POS2")) D I 'ZTDTH D QUIT Q
. K DIR
. S DIR("A")=" Enter when to Queue the "_JOBN_" job to run in date@time format "
. S DIR("B")="NOW"
. S DIR(0)="D^::%DT"
. 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"
. D ^DIR I $D(DUOUT) W !,"Halting..." S ZTDTH="" Q
. S:$D(DTOUT) Y=$$NOW^XLFDT S ZTDTH=$$FMTH^XLFDT(Y)
;
;ques 2, if running from kids install
I $D(XPDQUES("POS2")) S ZTDTH=$$FMTH^XLFDT(XPDQUES("POS2"))
;
D BMES^XPDUTL("=============================================================")
D MES^XPDUTL("Queuing background job for "_JOBN_"...")
D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
D MES^XPDUTL("==============================================================")
I ZTDTH="" D BMES^XPDUTL(JOBN_" NOT QUEUED") D QUIT Q
;
S:$D(^XTMP(NAMSP,0,"LAST")) ^XTMP(NAMSP,0,"ZAUDIT",$H)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
;
I $P($G(^XTMP(NAMSP,0,"LAST")),"^")="STOP" D
. S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
E D
. S ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
;
S ZTRTN="EN^PSOTEXP1",ZTIO=""
S ZTDESC="Background job for "_JOBN_" on prescriptions updated via "_PATCH
S ZTSAVE("JOBN")=""
L -^XTMP(NAMSP)
D ^%ZTLOAD
D:$D(ZTSK)
. D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
. D BMES^XPDUTL("")
D BMES^XPDUTL("")
K XPDQUES
Q
QUIT ;
L -^XTMP(NAMSP)
Q
EN ;
N PATCH,NAMSP S NAMSP=$$NAMSP,PATCH="PSO*7*250",JOBN="TALLY MISSING EXPIRATION DATES"
;if can't get Lock, then already running.
L +^XTMP(NAMSP):3 I '$T D Q
. S:$D(ZTQUEUED) ZTREQ="@"
. S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="LOCKED^"_$$NOW^XLFDT
;
N PSOSTART,Y,PSOS1,RXP,PSOV7,PSOARR,PSOISS,PSOEXP,PSOSTA,PSOACT,PSOINST,CC,RXE,DFN,PSODRUG,PSOINACT
;
D NOW^%DTC S (Y,PSOS1)=% D DD^%DT S PSOSTART=Y
I '$G(DT) S DT=$$DT^XLFDT
S RXP=+$P($G(^XTMP(NAMSP,0,"LAST")),"^",4)
;get date that PSO v7 was installed
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))
S:PSOV7["." PSOV7=$P(PSOV7,".",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
;
S PSOINST=$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),"^",17),99)),"^")
S:'$G(PSOINST) PSOINST="9999999999"
S PSOACT=",0,1,2,3,4,5,10,16,",PSOINACT=",11,12,13,14,15,"
N STOP K ^XTMP(NAMSP,0,"STOP") S STOP=0 S:RXP="" RXP=0
F CC=1:1 S RXP=$O(^PSRX(RXP)) Q:'RXP!(RXP'?1N.NN) D Q:STOP
. I $D(^XTMP(NAMSP,0,"STOP")) D Q
. . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="STOP^"_$$NOW^XLFDT,STOP=1
. K PSOARR D GETS^DIQ(52,RXP_",",".01;2;6;1;20;26;100","I","PSOARR")
. S DFN=$G(PSOARR(52,RXP_",",2,"I")),PSODRUG=$G(PSOARR(52,RXP_",",6,"I")),PSOSTA=$G(PSOARR(52,RXP_",",100,"I"))
. S PSOISS=$G(PSOARR(52,RXP_",",1,"I"))
. ;--- eliminate bad Rx's
. Q:DFN=""!(PSODRUG="")
. Q:'$D(^DPT(DFN))!('$D(^PSDRUG(PSODRUG)))
. Q:$G(PSOISS)=""
. ;---
. S RXE=$G(PSOARR(52,RXP_",",".01","I")),PSOEXP=$G(PSOARR(52,RXP_",",26,"I"))
. ;save last date & fill info
. S $P(^XTMP(NAMSP,0,"LAST"),"^",3,5)=$G(PSOISS)_"^"_RXP
. D SET
G STP:STOP
S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
D MAIL
STP ;
L -^XTMP(NAMSP)
I $D(^XTMP(NAMSP,0,"STOP")) S ^XTMP(NAMSP,0,"ZAUDIT",$H)="STOPPED ON"_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
S:$D(ZTQUEUED) ZTREQ="@"
K JOBN
;I '$D(^XTMP(NAMSP,0,"STOP")) K ^XTMP(NAMSP)
Q
;
SET ;Data collected and stored:
; Piece 1 - Pre-install v7 active Rx's with null expiration date
; Piece 2 - Pre-install v7 inactive Rx's with null expiration date
; Piece 3 - Post-install v7 active Rx's with null expiration
; Piece 4 - Post-install v7 inactive Rx's with null expiration
; Piece 5 - total Rx's with null expiration date
; Piece 6 - total active Rx's with expire date of t-1 day
;
I PSOEXP="" D Q
. I PSOISS'>PSOV7 D
. . S:PSOACT[(","_PSOSTA_",") $P(^XTMP(NAMSP,PSOINST),"^",1)=$P($G(^XTMP(NAMSP,PSOINST)),"^",1)+1
. . S:PSOINACT[(","_PSOSTA_",") $P(^XTMP(NAMSP,PSOINST),"^",2)=$P($G(^XTMP(NAMSP,PSOINST)),"^",2)+1
. I PSOISS>PSOV7 D
. . S:PSOACT[(","_PSOSTA_",") $P(^XTMP(NAMSP,PSOINST),"^",3)=$P($G(^XTMP(NAMSP,PSOINST)),"^",3)+1
. . S:PSOINACT[(","_PSOSTA_",") $P(^XTMP(NAMSP,PSOINST),"^",4)=$P($G(^XTMP(NAMSP,PSOINST)),"^",4)+1
. S $P(^XTMP(NAMSP,PSOINST),"^",5)=$P($G(^XTMP(NAMSP,PSOINST)),"^",5)+1
.;S ^XTMP("PSOTEXP1","MISS",RXP)=PSOINST_"^"_PSOISS_"^"_PSOV7_"^"_PSOEXP_"^"_$S($G(PSOSTA)'="":PSOSTA,1:"*")_"^"_$P($G(^PSRX(RXP,0)),"^")
; normal daily job expires all rx's with yesterday's date, so looking for anything before yesterday.
I (PSOEXP<(DT-1))&(PSOACT[(","_PSOSTA_",")) S $P(^XTMP(NAMSP,PSOINST),"^",6)=$P($G(^XTMP(NAMSP,PSOINST)),"^",6)+1
;.S ^XTMP("PSOTEXP1","PAST",$S($G(PSOSTA)'="":PSOSTA,1:"*"),PSOEXP,RXP)=PSOINST_"^"_PSOISS_"^"_PSOV7_"^"_PSOEXP_"^"_PSOSTA_"^"_$P($G(^PSRX(RXP,0)),"^")
Q
;
STATUS ;show status of job running
I $$ST D
. W !,"Currently processing:"
. I $G(^XTMP($$NAMSP,0,"LAST"))["COMPLETED" D
. . W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
. W !?5,"Date being processed > ",$$FMTE^XLFDT($P(^XTMP($$NAMSP,0,"LAST"),"^",3))
. W !?5," RX # > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",4)
. ;W !?5," TOTAL RX's > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",5),!
E D
.I $G(^XTMP($$NAMSP,0,"LAST"))["COMPLETED" D
.. W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
Q
;
STOP ;stop job command
I $$ST S ^XTMP($$NAMSP,0,"STOP")="" D
. W !,"TALLY MISSING EXPIRATION DATES Job - set to STOP Soon"
. W !!,"Check Status to be sure it has stopped and is not running..."
. W !," (D STATUS^PSOTEXP1)"
Q
ST() ;status
L +^XTMP($$NAMSP):3 I $T D Q 0
. L -^XTMP($$NAMSP)
. W !,"*** NOT CURRENTLY RUNNING! ***",!
Q 1
INITXTMP(NAMSP,TITLE,LIFE) ;create ^Xtmp according to SAC std
N BEGDT,PURGDT
S BEGDT=$$NOW^XLFDT()
S PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
S ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
Q
NAMSP() ;
Q $T(+0)
;
MAIL ;
N PSOEND,PSOEND2,PSOTEXT,XMY,LIN,DATA,J,L,PSOINST,M,LEN
S LIN="",$P(LIN," ",80)="",LEN=80
D NOW^%DTC S Y=% D DD^%DT S PSOEND=Y
S PSOEND2=$$FMTE^XLFDT(%,"1PS")
I $G(DUZ) S XMY(DUZ)=""
S XMDUZ=PATCH_" "_JOBN
S XMSUB="Outpatient Pharmacy "_PATCH_" "_JOBN
S XMY("ELLZEY.LINDA@FORUM.VA.GOV")=""
S XMY("WHITE.ELAINE@FORUM.VA.GOV")=""
S XMY("WILLIAMSON.ERIC@FORUM.VA.GOV")=""
I $O(XMY(""))="" Q ; no recipients for mail message
S PSOTEXT(1)="The "_JOBN_" job for the Outpatient Pharmacy"
S PSOTEXT(2)="patch ("_PATCH_") started "_PSOSTART
S PSOTEXT(3)="and completed "_PSOEND_"."
S PSOTEXT(4)=" "
S PSOTEXT(5)="Excel comma delimited data below, five headings, one data line"
S PSOTEXT(6)="Note that an institution of 999999999 denotes one was not found during run."
S PSOTEXT(7)=",,,,,,Total Active Rx's"
S PSOTEXT(8)=",Before v7 Install,Before v7 Install,After v7 Install,After v7 Install,,With"
S PSOTEXT(9)=",Tot Active Rx's,Tot Inactive,Tot Active,Tot Inactive,Total Rx's,Expiration"
S PSOTEXT(10)=",Missing Expired,Rx's Missing,Rx's Missing,Rx's Missing,Missing,Date of T-1"
S PSOTEXT(11)="Institution,Date,Expired Date,Expired Date,Expired Date,Expired Date,Day"
S PSOINST=0,L=12
F S PSOINST=$O(^XTMP(NAMSP,PSOINST)) Q:PSOINST=""!(PSOINST'?1N.NN) D
. S DATA=^XTMP(NAMSP,PSOINST),DATA=$TR(DATA,"^",",")
. S PSOTEXT(L)=$E((PSOINST_","_DATA_LIN),1,LEN),L=L+1
S L=L+1,PSOTEXT(L)=" "
;
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
Q
PSOTEXP1 ;BIR/LE-Tally Missing Expiration Dates ;06/14/06
+1 ;;7.0;OUTPATIENT PHARMACY;**250,268**;DEC 1997;Build 9
+2 ;External references ^DPT supported by DBIA 10035
+3 NEW NAMSP,PATCH,JOBN,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,Y,ZTQUEUED,ZTREQ,ZTSAVE
+4 SET NAMSP=$$NAMSP
+5 SET JOBN="TALLY MISSING EXPIRATION DATES"
+6 SET PATCH="PSO*7*250"
+7 ;
+8 LOCK +^XTMP(NAMSP):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF '$TEST
Begin DoDot:1
+9 DO BMES^XPDUTL(JOBN_" job is already running. Halting...")
+10 DO MES^XPDUTL("")
+11 DO QUIT
End DoDot:1
QUIT
+12 ;
+13 ;90 day life
IF '$DATA(^XTMP(NAMSP))
DO INITXTMP(NAMSP,JOBN_", "_PATCH,90)
+14 SET QUIT=0
+15 ;
+16 IF $GET(^XTMP(NAMSP,0,"LAST"))["COMPLETED"
Begin DoDot:1
+17 WRITE !!,*7,"This job has been run before to completion on "
+18 WRITE $$FMTE^XLFDT($PIECE($GET(^XTMP(NAMSP,0,"LAST")),"^",2)),!!
+19 WRITE "If you want to run it again, the global subscript ^XTMP('PSOTEXP1') must be",!
+20 WRITE "deleted prior to doing so.",!!
+21 DO QUIT
End DoDot:1
QUIT
+22 ;
+23 ;ques 2, if running from mumps prompt
+24 IF '$DATA(XPDQUES("POS2"))
Begin DoDot:1
+25 KILL DIR
+26 SET DIR("A")=" Enter when to Queue the "_JOBN_" job to run in date@time format "
+27 SET DIR("B")="NOW"
+28 SET DIR(0)="D^::%DT"
+29 SET 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"
+30 DO ^DIR
IF $DATA(DUOUT)
WRITE !,"Halting..."
SET ZTDTH=""
QUIT
+31 IF $DATA(DTOUT)
SET Y=$$NOW^XLFDT
SET ZTDTH=$$FMTH^XLFDT(Y)
End DoDot:1
IF 'ZTDTH
DO QUIT
QUIT
+32 ;
+33 ;ques 2, if running from kids install
+34 IF $DATA(XPDQUES("POS2"))
SET ZTDTH=$$FMTH^XLFDT(XPDQUES("POS2"))
+35 ;
+36 DO BMES^XPDUTL("=============================================================")
+37 DO MES^XPDUTL("Queuing background job for "_JOBN_"...")
+38 DO MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
+39 DO MES^XPDUTL("==============================================================")
+40 IF ZTDTH=""
DO BMES^XPDUTL(JOBN_" NOT QUEUED")
DO QUIT
QUIT
+41 ;
+42 IF $DATA(^XTMP(NAMSP,0,"LAST"))
SET ^XTMP(NAMSP,0,"ZAUDIT",$HOROLOG)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
+43 ;
+44 IF $PIECE($GET(^XTMP(NAMSP,0,"LAST")),"^")="STOP"
Begin DoDot:1
+45 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
End DoDot:1
+46 IF '$TEST
Begin DoDot:1
+47 SET ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
End DoDot:1
+48 ;
+49 SET ZTRTN="EN^PSOTEXP1"
SET ZTIO=""
+50 SET ZTDESC="Background job for "_JOBN_" on prescriptions updated via "_PATCH
+51 SET ZTSAVE("JOBN")=""
+52 LOCK -^XTMP(NAMSP)
+53 DO ^%ZTLOAD
+54 IF $DATA(ZTSK)
Begin DoDot:1
+55 DO MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
+56 DO BMES^XPDUTL("")
End DoDot:1
+57 DO BMES^XPDUTL("")
+58 KILL XPDQUES
+59 QUIT
QUIT ;
+1 LOCK -^XTMP(NAMSP)
+2 QUIT
EN ;
+1 NEW PATCH,NAMSP
SET NAMSP=$$NAMSP
SET PATCH="PSO*7*250"
SET JOBN="TALLY MISSING EXPIRATION DATES"
+2 ;if can't get Lock, then already running.
+3 LOCK +^XTMP(NAMSP):3
IF '$TEST
Begin DoDot:1
+4 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",1,2)="LOCKED^"_$$NOW^XLFDT
End DoDot:1
QUIT
+6 ;
+7 NEW PSOSTART,Y,PSOS1,RXP,PSOV7,PSOARR,PSOISS,PSOEXP,PSOSTA,PSOACT,PSOINST,CC,RXE,DFN,PSODRUG,PSOINACT
+8 ;
+9 DO NOW^%DTC
SET (Y,PSOS1)=%
DO DD^%DT
SET PSOSTART=Y
+10 IF '$GET(DT)
SET DT=$$DT^XLFDT
+11 SET RXP=+$PIECE($GET(^XTMP(NAMSP,0,"LAST")),"^",4)
+12 ;get date that PSO v7 was installed
+13 SET PSOV7=$SELECT($PIECE($GET(^PS(59.7,1,49.99)),"^",7):$PIECE(^PS(59.7,1,49.99),"^",7),1:$PIECE($GET(^PS(59.7,1,49.99)),"^",4))
+14 IF PSOV7["."
SET PSOV7=$PIECE(PSOV7,".",1)
+15 ;
+16 ;^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
+17 ;
+18 SET PSOINST=$PIECE($GET(^DIC(4,+$PIECE($GET(^XMB(1,1,"XUS")),"^",17),99)),"^")
+19 IF '$GET(PSOINST)
SET PSOINST="9999999999"
+20 SET PSOACT=",0,1,2,3,4,5,10,16,"
SET PSOINACT=",11,12,13,14,15,"
+21 NEW STOP
KILL ^XTMP(NAMSP,0,"STOP")
SET STOP=0
IF RXP=""
SET RXP=0
+22 FOR CC=1:1
SET RXP=$ORDER(^PSRX(RXP))
IF 'RXP!(RXP'?1N.NN)
QUIT
Begin DoDot:1
+23 IF $DATA(^XTMP(NAMSP,0,"STOP"))
Begin DoDot:2
+24 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",1,2)="STOP^"_$$NOW^XLFDT
SET STOP=1
End DoDot:2
QUIT
+25 KILL PSOARR
DO GETS^DIQ(52,RXP_",",".01;2;6;1;20;26;100","I","PSOARR")
+26 SET DFN=$GET(PSOARR(52,RXP_",",2,"I"))
SET PSODRUG=$GET(PSOARR(52,RXP_",",6,"I"))
SET PSOSTA=$GET(PSOARR(52,RXP_",",100,"I"))
+27 SET PSOISS=$GET(PSOARR(52,RXP_",",1,"I"))
+28 ;--- eliminate bad Rx's
+29 IF DFN=""!(PSODRUG="")
QUIT
+30 IF '$DATA(^DPT(DFN))!('$DATA(^PSDRUG(PSODRUG)))
QUIT
+31 IF $GET(PSOISS)=""
QUIT
+32 ;---
+33 SET RXE=$GET(PSOARR(52,RXP_",",".01","I"))
SET PSOEXP=$GET(PSOARR(52,RXP_",",26,"I"))
+34 ;save last date & fill info
+35 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",3,5)=$GET(PSOISS)_"^"_RXP
+36 DO SET
End DoDot:1
IF STOP
QUIT
+37 IF STOP
GOTO STP
+38 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
+39 DO MAIL
STP ;
+1 LOCK -^XTMP(NAMSP)
+2 IF $DATA(^XTMP(NAMSP,0,"STOP"))
SET ^XTMP(NAMSP,0,"ZAUDIT",$HOROLOG)="STOPPED ON"_"^"_$PIECE(^XTMP(NAMSP,0,"LAST"),"^",2,5)
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 KILL JOBN
+5 ;I '$D(^XTMP(NAMSP,0,"STOP")) K ^XTMP(NAMSP)
+6 QUIT
+7 ;
SET ;Data collected and stored:
+1 ; Piece 1 - Pre-install v7 active Rx's with null expiration date
+2 ; Piece 2 - Pre-install v7 inactive Rx's with null expiration date
+3 ; Piece 3 - Post-install v7 active Rx's with null expiration
+4 ; Piece 4 - Post-install v7 inactive Rx's with null expiration
+5 ; Piece 5 - total Rx's with null expiration date
+6 ; Piece 6 - total active Rx's with expire date of t-1 day
+7 ;
+8 IF PSOEXP=""
Begin DoDot:1
+9 IF PSOISS'>PSOV7
Begin DoDot:2
+10 IF PSOACT[(","_PSOSTA_",")
SET $PIECE(^XTMP(NAMSP,PSOINST),"^",1)=$PIECE($GET(^XTMP(NAMSP,PSOINST)),"^",1)+1
+11 IF PSOINACT[(","_PSOSTA_",")
SET $PIECE(^XTMP(NAMSP,PSOINST),"^",2)=$PIECE($GET(^XTMP(NAMSP,PSOINST)),"^",2)+1
End DoDot:2
+12 IF PSOISS>PSOV7
Begin DoDot:2
+13 IF PSOACT[(","_PSOSTA_",")
SET $PIECE(^XTMP(NAMSP,PSOINST),"^",3)=$PIECE($GET(^XTMP(NAMSP,PSOINST)),"^",3)+1
+14 IF PSOINACT[(","_PSOSTA_",")
SET $PIECE(^XTMP(NAMSP,PSOINST),"^",4)=$PIECE($GET(^XTMP(NAMSP,PSOINST)),"^",4)+1
End DoDot:2
+15 SET $PIECE(^XTMP(NAMSP,PSOINST),"^",5)=$PIECE($GET(^XTMP(NAMSP,PSOINST)),"^",5)+1
+16 ;S ^XTMP("PSOTEXP1","MISS",RXP)=PSOINST_"^"_PSOISS_"^"_PSOV7_"^"_PSOEXP_"^"_$S($G(PSOSTA)'="":PSOSTA,1:"*")_"^"_$P($G(^PSRX(RXP,0)),"^")
End DoDot:1
QUIT
+17 ; normal daily job expires all rx's with yesterday's date, so looking for anything before yesterday.
+18 IF (PSOEXP<(DT-1))&(PSOACT[(","_PSOSTA_","))
SET $PIECE(^XTMP(NAMSP,PSOINST),"^",6)=$PIECE($GET(^XTMP(NAMSP,PSOINST)),"^",6)+1
+19 ;.S ^XTMP("PSOTEXP1","PAST",$S($G(PSOSTA)'="":PSOSTA,1:"*"),PSOEXP,RXP)=PSOINST_"^"_PSOISS_"^"_PSOV7_"^"_PSOEXP_"^"_PSOSTA_"^"_$P($G(^PSRX(RXP,0)),"^")
+20 QUIT
+21 ;
STATUS ;show status of job running
+1 IF $$ST
Begin DoDot:1
+2 WRITE !,"Currently processing:"
+3 IF $GET(^XTMP($$NAMSP,0,"LAST"))["COMPLETED"
Begin DoDot:2
+4 WRITE !,"COMPLETED ON ",$$FMTE^XLFDT($PIECE($GET(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
End DoDot:2
+5 WRITE !?5,"Date being processed > ",$$FMTE^XLFDT($PIECE(^XTMP($$NAMSP,0,"LAST"),"^",3))
+6 WRITE !?5," RX # > ",$PIECE(^XTMP($$NAMSP,0,"LAST"),"^",4)
+7 ;W !?5," TOTAL RX's > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",5),!
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 IF $GET(^XTMP($$NAMSP,0,"LAST"))["COMPLETED"
Begin DoDot:2
+10 WRITE !,"COMPLETED ON ",$$FMTE^XLFDT($PIECE($GET(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
STOP ;stop job command
+1 IF $$ST
SET ^XTMP($$NAMSP,0,"STOP")=""
Begin DoDot:1
+2 WRITE !,"TALLY MISSING EXPIRATION DATES Job - set to STOP Soon"
+3 WRITE !!,"Check Status to be sure it has stopped and is not running..."
+4 WRITE !," (D STATUS^PSOTEXP1)"
End DoDot:1
+5 QUIT
ST() ;status
+1 LOCK +^XTMP($$NAMSP):3
IF $TEST
Begin DoDot:1
+2 LOCK -^XTMP($$NAMSP)
+3 WRITE !,"*** NOT CURRENTLY RUNNING! ***",!
End DoDot:1
QUIT 0
+4 QUIT 1
INITXTMP(NAMSP,TITLE,LIFE) ;create ^Xtmp according to SAC std
+1 NEW BEGDT,PURGDT
+2 SET BEGDT=$$NOW^XLFDT()
+3 SET PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
+4 SET ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
+5 QUIT
NAMSP() ;
+1 QUIT $TEXT(+0)
+2 ;
MAIL ;
+1 NEW PSOEND,PSOEND2,PSOTEXT,XMY,LIN,DATA,J,L,PSOINST,M,LEN
+2 SET LIN=""
SET $PIECE(LIN," ",80)=""
SET LEN=80
+3 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSOEND=Y
+4 SET PSOEND2=$$FMTE^XLFDT(%,"1PS")
+5 IF $GET(DUZ)
SET XMY(DUZ)=""
+6 SET XMDUZ=PATCH_" "_JOBN
+7 SET XMSUB="Outpatient Pharmacy "_PATCH_" "_JOBN
+8 SET XMY("ELLZEY.LINDA@FORUM.VA.GOV")=""
+9 SET XMY("WHITE.ELAINE@FORUM.VA.GOV")=""
+10 SET XMY("WILLIAMSON.ERIC@FORUM.VA.GOV")=""
+11 ; no recipients for mail message
IF $ORDER(XMY(""))=""
QUIT
+12 SET PSOTEXT(1)="The "_JOBN_" job for the Outpatient Pharmacy"
+13 SET PSOTEXT(2)="patch ("_PATCH_") started "_PSOSTART
+14 SET PSOTEXT(3)="and completed "_PSOEND_"."
+15 SET PSOTEXT(4)=" "
+16 SET PSOTEXT(5)="Excel comma delimited data below, five headings, one data line"
+17 SET PSOTEXT(6)="Note that an institution of 999999999 denotes one was not found during run."
+18 SET PSOTEXT(7)=",,,,,,Total Active Rx's"
+19 SET PSOTEXT(8)=",Before v7 Install,Before v7 Install,After v7 Install,After v7 Install,,With"
+20 SET PSOTEXT(9)=",Tot Active Rx's,Tot Inactive,Tot Active,Tot Inactive,Total Rx's,Expiration"
+21 SET PSOTEXT(10)=",Missing Expired,Rx's Missing,Rx's Missing,Rx's Missing,Missing,Date of T-1"
+22 SET PSOTEXT(11)="Institution,Date,Expired Date,Expired Date,Expired Date,Expired Date,Day"
+23 SET PSOINST=0
SET L=12
+24 FOR
SET PSOINST=$ORDER(^XTMP(NAMSP,PSOINST))
IF PSOINST=""!(PSOINST'?1N.NN)
QUIT
Begin DoDot:1
+25 SET DATA=^XTMP(NAMSP,PSOINST)
SET DATA=$TRANSLATE(DATA,"^",",")
+26 SET PSOTEXT(L)=$EXTRACT((PSOINST_","_DATA_LIN),1,LEN)
SET L=L+1
End DoDot:1
+27 SET L=L+1
SET PSOTEXT(L)=" "
+28 ;
+29 SET XMTEXT="PSOTEXT("
NEW DIFROM
DO ^XMD
KILL XMDUZ,XMTEXT,XMSUB
+30 QUIT
