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