142 lines
5.7 KiB
Mathematica
142 lines
5.7 KiB
Mathematica
|
PSO283P1 ;BIR/MFR-EXPIRATION DATE PROBLEM TALLY (Cont.) ;05/03/07
|
||
|
;;7.0;OUTPATIENT PHARMACY;**283**;DEC 1997;Build 28
|
||
|
;External reference to ^PS(59.7 is supported by DBIA 694
|
||
|
;
|
||
|
MAIL ;
|
||
|
N PSOTX,XMY,XMDUZ,XMSUB,XMTEXT,DIFROM
|
||
|
S XMY($S($G(PSODUZ):PSODUZ,1:+$G(DUZ)))=""
|
||
|
S XMDUZ=.5
|
||
|
S XMSUB="Patch PSO*7*283 - Rx EXPIRATION DATE PROBLEM TALLY"
|
||
|
S XMY("RUZBACKI.RON@FORUM.VA.GOV")=""
|
||
|
S XMY("ANWER.MOHAMED@FORUM.VA.GOV")=""
|
||
|
S XMY("WILLIAMSON.ERIC@FORUM.VA.GOV")=""
|
||
|
S XMY("WILLETTE.CANDY@FORUM.VA.GOV")=""
|
||
|
S XMY("ROCHA.MARCELO@FORUM.VA.GOV")=""
|
||
|
S XMY("BARRON.LUANNE@FORUM.VA.GOV")=""
|
||
|
S XMY("JONES.TRES@FORUM.VA.GOV")=""
|
||
|
D SETTXT
|
||
|
;
|
||
|
S XMTEXT="PSOTX(" D ^XMD
|
||
|
Q
|
||
|
;
|
||
|
DISPLAY ; Displays the current results
|
||
|
N PSOINST,J,DIR,PSOTX,DIR
|
||
|
S PSOINST=$P($$SITE^VASITE(),"^",2)_" ("_+$$SITE^VASITE()_")"
|
||
|
D SETTXT W !
|
||
|
F J=1:1 Q:'$D(PSOTX(J)) D
|
||
|
. W !,PSOTX(J)
|
||
|
. I '(J#19) K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR
|
||
|
Q
|
||
|
;
|
||
|
SETTXT ; Set the PSOTXT array with the Mailman message or screen display
|
||
|
N EXCEL,J,Z,LINE,JOBSTS,STS,LOGLN,NMSP
|
||
|
S LINE=0,NMSP="PSO283PI"
|
||
|
D SETLN("Expiration Date problem tally patch for Outpatient Pharmacy prescriptions")
|
||
|
D SETLN("=========================================================================")
|
||
|
S JOBSTS=$$JOBSTS()
|
||
|
S:JOBSTS="N" STS="NEVER RUN"
|
||
|
S:JOBSTS="S" STS="STOPPED ON "_$$FMTE^XLFDT($G(^XTMP(NMSP,"STOPPED")))
|
||
|
S:JOBSTS="R" STS="RUNNING"
|
||
|
S:JOBSTS="C" STS="COMPLETED ON "_$$FMTE^XLFDT($G(^XTMP(NMSP,"COMPLETED")))
|
||
|
S:$G(^XTMP(NMSP,"LASTRX")) STS=STS_" (Last Rx IEN: "_$G(^XTMP(NMSP,"LASTRX"))_")"
|
||
|
D SETLN("Current status: "_STS)
|
||
|
D SETLN(" ")
|
||
|
D SETLN("1. Institution : "_PSOINST)
|
||
|
D SETLN(" PATIENTS")
|
||
|
D SETLN("Group 1: RX'S WITH NO EXPIRATION DATE WITH ICN# W/NO ICN#")
|
||
|
D SETLN("------------------------------------- ---------- ----------")
|
||
|
D SETLN("2. Calc exp date > CUTOFF (update HDR) "_$$TOT(2)_" "_$$TOT(102))
|
||
|
D SETLN("3. Calc exp date < CUTOFF,CPRS active (update HDR/CPRS) "_$$TOT(3)_" "_$$TOT(103))
|
||
|
D SETLN("4. Calc exp date < CUTOFF,CPRS non-active (update HDR) "_$$TOT(4)_" "_$$TOT(104))
|
||
|
D SETLN("5. No CPRS order# (Update HDR) "_$$TOT(5)_" "_$$TOT(105))
|
||
|
D SETLN(" ")
|
||
|
D SETLN("Group 2: RX'S IN EXPIRED STATUS")
|
||
|
D SETLN("-------------------------------")
|
||
|
D SETLN("6. CPRS active (update CPRS/HDR) "_$$TOT(6)_" "_$$TOT(106))
|
||
|
D SETLN("7. Exp>366 days,reset date,CPRS order# (update CPRS/HDR)"_$$TOT(7)_" "_$$TOT(107))
|
||
|
D SETLN("8. Exp>366 days,reset date,no CPRS order# (update HDR) "_$$TOT(8)_" "_$$TOT(108))
|
||
|
D SETLN(" ")
|
||
|
D SETLN("Group 3: RX'S PAST EXPIRATION DATE BUT STILL ACTIVE")
|
||
|
D SETLN("---------------------------------------------------")
|
||
|
D SETLN("9. CPRS active (update CPRS/HDR) "_$$TOT(9)_" "_$$TOT(109))
|
||
|
D SETLN("10. CPRS DC'd or expired (update HDR) "_$$TOT(10)_" "_$$TOT(110))
|
||
|
D SETLN("11. No CPRS order# (HDR will run own update) "_$$TOT(11)_" "_$$TOT(111))
|
||
|
D SETLN(" ")
|
||
|
D SETLN("Group 4: RX's IN DELETED STATUS")
|
||
|
D SETLN("-------------------------------")
|
||
|
D SETLN("12. No CPRS order# (update HDR) "_$$TOT(12)_" "_$$TOT(112))
|
||
|
D SETLN(" ")
|
||
|
D SETLN("OTHER")
|
||
|
D SETLN("-----")
|
||
|
D SETLN("13. BAD RX's: NO PATIENT,DRUG or ISSUE DT (NO UPDATES): "_$$TOT(13))
|
||
|
D SETLN(" ")
|
||
|
D SETLN("14. TOTAL NUMBER OF PRESCRIPTIONS ANALYZED: "_$$TOT(14))
|
||
|
D SETLN(" ")
|
||
|
D SETLN("Up-arrow ('^') separated values (patients WITH ICN#):")
|
||
|
S EXCEL=PSOINST F J=2:1:14 S EXCEL=EXCEL_"^"_+$G(^XTMP(NMSP,J))
|
||
|
D SETLN(EXCEL)
|
||
|
D SETLN(" ")
|
||
|
D SETLN("Up-arrow ('^') separated values (patients WITHOUT ICN#):")
|
||
|
S EXCEL=PSOINST F J=102:1:112 S EXCEL=EXCEL_"^"_+$G(^XTMP(NMSP,J))
|
||
|
D SETLN(EXCEL_"^"_+$G(^XTMP(NMSP,13))_"^"_+$G(^XTMP(NMSP,14)))
|
||
|
D SETLN(" ")
|
||
|
D SETLN("Run Log:")
|
||
|
D SETLN("------------------------------------------------------------------------------")
|
||
|
D SETLN("SEQ DATE/TIME INITIATOR ACTION")
|
||
|
D SETLN("------------------------------------------------------------------------------")
|
||
|
I '$D(^XTMP(NMSP,"LOG")) D SETLN("No entries.")
|
||
|
F J=1:1 Q:'$D(^XTMP(NMSP,"LOG",J)) D
|
||
|
. S Z=^XTMP(NMSP,"LOG",J)
|
||
|
. S LOGLN=$J(J,3),$E(LOGLN,5)=$$FMTE^XLFDT(+Z,2)
|
||
|
. S $E(LOGLN,23)=$E($$GET1^DIQ(200,$P(Z,"^",2),.01),1,25),$E(LOGLN,50)=$P(Z,"^",3)
|
||
|
. D SETLN(LOGLN)
|
||
|
D SETLN("<END>")
|
||
|
Q
|
||
|
;
|
||
|
SETLN(TEXT) ; Add a new line to the mailman message text
|
||
|
S LINE=$G(LINE)+1,PSOTX(LINE)=TEXT
|
||
|
Q
|
||
|
;
|
||
|
TOT(FLD) ; returns the field to be displayed
|
||
|
Q $J($FNUMBER(+$G(^XTMP(NMSP,FLD)),","),10)
|
||
|
;
|
||
|
JOB(ZTDTH) ; Queue the job to run
|
||
|
N ZTRTN,ZTIO,ZTDESC,ZTSK,PSODUZ,ZTSAVE
|
||
|
S ZTRTN="EN^PSO283PI",ZTIO=""
|
||
|
S ZTDESC="Patch PSO*7*283 - Rx Expiration Date problem tally job (run >D ^PSO283PI)"
|
||
|
L -^XTMP(NMSP)
|
||
|
S PSODUZ=DUZ,ZTSAVE("PSODUZ")=""
|
||
|
D ^%ZTLOAD
|
||
|
I $D(ZTSK) D
|
||
|
. D LOG("QUEUED")
|
||
|
. H 2 D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
|
||
|
. D BMES^XPDUTL("")
|
||
|
. H 1
|
||
|
K XPDQUES
|
||
|
Q
|
||
|
;
|
||
|
JOBSTS() ; Returns the current job status
|
||
|
L +^XTMP(NMSP):0 E Q "R"
|
||
|
L -^XTMP(NMSP)
|
||
|
I '$D(^XTMP(NMSP,"STARTED")) Q "N"
|
||
|
I $G(^XTMP(NMSP,"COMPLETED")) Q "C"
|
||
|
Q "S"
|
||
|
;
|
||
|
CALCEXP ; CALCULATE THE EXPIRATION DATE
|
||
|
N X,%DT,X1,X2,PSOARR,PSDEA,PSOCS,DA,QQ
|
||
|
K PSOARR D GETS^DIQ(50,DRUG_",","3","I","PSOARR")
|
||
|
S PSDEA=$G(PSOARR(50,DRUG_",",3,"I"))
|
||
|
S X1=ISSUEDT,X2=DAYSSUP*(NUMREFS+1)\1
|
||
|
S PSOCS=0
|
||
|
F QQ=1:1 Q:$E(PSDEA,QQ)="" I $E(+PSDEA,QQ)>1,$E(+PSDEA,QQ)<6 D I PSOCS Q
|
||
|
. S PSOCS=1
|
||
|
S X2=$S(DAYSSUP=X2:X2,+$G(PSOCS):184,1:366)
|
||
|
D C^%DTC S EXPIRDT=$P(X,".")
|
||
|
Q
|
||
|
;
|
||
|
LOG(COMMENT) ; Running Log
|
||
|
N LOGCNT
|
||
|
S LOGCNT=+$O(^XTMP(NMSP,"LOG",""),-1)+1
|
||
|
S ^XTMP(NMSP,"LOG",LOGCNT)=$$NOW^XLFDT()_"^"_$S($G(PSODUZ):PSODUZ,1:+$G(DUZ))_"^"_COMMENT
|
||
|
Q
|