VistA-WorldVistAEHR/r/OUTPATIENT_PHARMACY-PSO-APS.../PSOCIDC8.m

145 lines
6.6 KiB
Mathematica

PSOCIDC8 ;BIR/LE - continuation of activity log corrections ;2/28/05 12:50pm
;;7.0;OUTPATIENT PHARMACY;**239,250**;DEC 1997
;External reference to ^XUSEC supported by DBIA 10076
;External reference to $$PROD^XUPROD(1) supported by DBIA 4440
;External references L and UL^PSSLOCK supported by DBIA 2789
;
CHECK ;
Q:'$D(^PSRX(RXP,"A",0))&('$D(^PSRX(RXP,"COPAY",0)))
N PSOMSG,PSONTIM,PSOCHECK,SEQ,CSEQ,CSEQ2
S (PSOCHECK,SEQ,CSEQ)=0
I $D(^PSRX(RXP,"A",0)) F S SEQ=$O(^PSRX(RXP,"A",SEQ)) Q:SEQ="" I $G(^PSRX(RXP,"A",SEQ,0))["BKGD CIDC" S PSOCHECK=1
I $D(^PSRX(RXP,"COPAY",0)) F S CSEQ=$O(^PSRX(RXP,"COPAY",CSEQ)) Q:CSEQ="" I $G(^PSRX(RXP,"COPAY",CSEQ,0))["BKGD CIDC" S PSOCHECK=1
Q:'PSOCHECK
CHECK1 ;
D PSOL^PSSLOCK(RXP) S PSONTIM=$G(PSONTIM)+1 G CHECK1:'$G(PSOMSG)&($G(PSONTIM)<10)
I '+$G(PSOMSG) S:'$G(FIXONE) ^XTMP(NAMSP,0,"LOCKED RX",RXP)="" S:('+$G(PSOMSG)&($G(FIXONE))) PSOFONE=1 W:$G(FIXONE) !,"Cannot lock Rx for correction.",!! Q
;
I $D(^XTMP(NAMSP,0,"STOP")) S $P(^XTMP(NAMSP,0,"LAST"),"^",3)=$O(^PSRX("AD",PSODT),-1),$P(^XTMP(NAMSP,0,"LAST"),"^",4)=$O(^PSRX(RXP),-1) Q
N AFLG,CFLG,CDAT,CHSEQ,ADATA,CDATA,DATA,ENTRY,EDAT,EFILL,ESEQ,MDATA,NEXT
;
I $D(^PSRX(RXP,"A",0)) D
. S SEQ=0 F S SEQ=$O(^PSRX(RXP,"A",SEQ)) Q:SEQ="" I $G(^PSRX(RXP,"A",SEQ,0))["BKGD CIDC" D Q:AFLG
.. M ^XTMP(NAMSP,"A",PSODFN,RXP,"A")=^PSRX(RXP,"A") S AFLG=1
.. I $D(^PSRX(RXP,"COPAY")) M ^XTMP(NAMSP,"C",PSODFN,RXP,"COPAY")=^PSRX(RXP,"COPAY")
.. E S ^XTMP(NAMSP,"C",PSODFN,RXP)="No previous copay activity log in file 52"
D:$G(AFLG) ACTLOG
;
K CDATA S CFLG=0
I $D(^PSRX(RXP,"COPAY",0)) D
. S CSEQ=0 F S CSEQ=$O(^PSRX(RXP,"COPAY",CSEQ)) Q:CSEQ="" I $G(^PSRX(RXP,"COPAY",CSEQ,0))["BKGD CIDC" D Q:CFLG
.. I '$D(^XTMP(NAMSP,"C",PSODFN,RXP))&(^PSRX(RXP,"COPAY",CSEQ,0)'["CIDC CLEANUP") M ^XTMP(NAMSP,"C",PSODFN,RXP,"COPAY")=^PSRX(RXP,"COPAY")
.. S CFLG=1
D:$G(CFLG)!$G(AFLG) CPLOG
D PSOUL^PSSLOCK(RXP)
Q
;
ACTLOG ;ACTIVITY LOG
S (CHSEQ,SEQ)=0
F S SEQ=$O(^PSRX(RXP,"A",SEQ)) Q:SEQ="" S ENTRY=$G(^PSRX(RXP,"A",SEQ,0)) I ENTRY'="" D
. I ENTRY'["BKGD CIDC" S CHSEQ=CHSEQ+1,CDATA(CHSEQ)=ENTRY Q
. S MDATA($P(ENTRY,"^"),$P(ENTRY,"^",4),SEQ)=""
;
;Q:'$D(CDATA)&('$D(MDATA))
;
;***************************** FOR LIVE RUN
I $D(CDATA)!($D(MDATA)) D
.I $D(^PSRX(RXP,"A")) K ^PSRX(RXP,"A")
.Q:'$D(CDATA)
.S (CHSEQ,SEQ)=0 F S SEQ=$O(CDATA(SEQ)) Q:SEQ="" S ^PSRX(RXP,"A",SEQ,0)=CDATA(SEQ),CHSEQ=SEQ
.S ^PSRX(RXP,"A",0)="^52.3DA^"_CHSEQ_"^"_CHSEQ
.S ^XTMP(NAMSP,"LOG",PSONAM,PSODFN,RXP)=""
;*****************************
;***---------------------------------------->>>>>>>>>> UN-COMMENT NEXT 3 LINES FOR TESTING ONLY AND COMMENT LIVE RUN
;S (CHSEQ,SEQ)=0 F S SEQ=$O(CDATA(SEQ)) Q:SEQ="" S ^XTMP("TST "_NAMSP,RXP,"A",SEQ,0)=CDATA(SEQ),CHSEQ=SEQ
;S ^XTMP("TST "_NAMSP,RXP,"A",0)="^52.3DA^"_CHSEQ_"^"_CHSEQ
;S ^XTMP("TST "_NAMSP,"LOG",PSONAM,PSODFN,RXP)=""
;
Q
;
CPLOG ;COPAY ACTIVITY LOG
S (EDAT,EFILL,ESEQ)="",(CHSEQ,CSEQ2)=0
I '$D(^PSRX(RXP,"COPAY"))&($D(MDATA)) D G SKP2
. F S EDAT=$O(MDATA(EDAT)) Q:EDAT="" F S EFILL=$O(MDATA(EDAT,EFILL)) Q:EFILL="" F S ESEQ=$O(MDATA(EDAT,EFILL,ESEQ)) Q:ESEQ="" D
.. S CHSEQ=CHSEQ+1,CDATA(CHSEQ)=EDAT_"^R^.5^"_EFILL_"^CIDC CLEANUP"
;
F S CSEQ2=$O(^PSRX(RXP,"COPAY",CSEQ2)) Q:CSEQ2="" D
. S DATA=^PSRX(RXP,"COPAY",CSEQ2,0),CDAT=$P(DATA,"^")
. I DATA["-BKGD CIDC" S $P(DATA,"^",5)="CIDC CLEANUP"
SKP .;
. I '$G(EDAT)&($D(MDATA)) S (EDAT,EFILL,ESEQ)="",EDAT=$O(MDATA(EDAT)),EFILL=$O(MDATA(EDAT,EFILL)),ESEQ=$O(MDATA(EDAT,EFILL,ESEQ))
. I EDAT<CDAT&(EDAT'="") S CHSEQ=CHSEQ+1,CDATA(CHSEQ)=EDAT_"^R^.5^"_EFILL_"^CIDC CLEANUP" K MDATA(EDAT,EFILL,ESEQ) S EDAT="" G SKP
. S CHSEQ=CHSEQ+1,CDATA(CHSEQ)=^PSRX(RXP,"COPAY",CSEQ2,0)
. I CDATA(CHSEQ)["BKGD CIDC" S $P(CDATA(CHSEQ),"^",5)="CIDC CLEANUP"
;
I $D(MDATA) S (EDAT,EFILL,ESEQ)="" F S EDAT=$O(MDATA(EDAT)) Q:EDAT="" F S EFILL=$O(MDATA(EDAT,EFILL)) Q:EFILL="" F S ESEQ=$O(MDATA(EDAT,EFILL,ESEQ)) Q:ESEQ="" D
. S CHSEQ=CHSEQ+1,CDATA(CHSEQ)=EDAT_"^R^.5^"_EFILL_"^CIDC CLEANUP"
SKP2 ;
Q:'$D(CDATA)
;
;***************************** FOR LIVE RUN
I $D(^PSRX(RXP,"COPAY")) K ^PSRX(RXP,"COPAY")
S (CSEQ2,CHSEQ)=0 F S CSEQ2=$O(CDATA(CSEQ2)) Q:CSEQ2="" S ^PSRX(RXP,"COPAY",CSEQ2,0)=CDATA(CSEQ2),CHSEQ=CSEQ2
S ^PSRX(RXP,"COPAY",0)="^52.0107DA^"_CHSEQ_"^"_CHSEQ
S ^XTMP(NAMSP,"LOG",PSONAM,PSODFN,RXP)=""
;*****************************
;***---------------------------------------->>>>>>>>>>> UN-COMMENT NEXT 3 LINES FOR TESTING ONLY AND COMMENT LIVE RUN
;S (CSEQ2,CHSEQ)=0 F S CSEQ2=$O(CDATA(CSEQ2)) Q:CSEQ2="" S ^XTMP("TST "_NAMSP,RXP,"COPAY",CSEQ2,0)=CDATA(CSEQ2),CHSEQ=CSEQ2
;S ^XTMP("TST "_NAMSP,RXP,"COPAY",0)="^52.0107DA^"_CHSEQ_"^"_CHSEQ
;S ^XTMP("TST "_NAMSP,"LOG",PSONAM,PSODFN,RXP)=""
Q
;
SITE ; SET UP VARIABLES NEEDED BY BILLING
S PSOSITE=$S(YY=0:$P(^PSRX(RXP,2),"^",9),1:$P($G(^PSRX(RXP,1,YY,0)),"^",9))
Q:PSOSITE=""
S PSOPAR=$G(^PS(59,PSOSITE,1))
S PSOPAR7=$G(^PS(59,PSOSITE,"IB"))
S PSOSITE7=$P($G(^PS(59,PSOSITE,"IB")),"^")
Q
;
MAIL3(MSG) ;management mail message
S PSOINST=$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),"^",17),99)),"^")
D NOW^%DTC S Y=% D DD^%DT S PSOEND=Y
K PSOTEXT
S:$G(DUZ) XMY(DUZ)=""
;S XMY("ELLZEY.LINDA@FORUM.VA.GOV")=""
S:$$PROD^XUPROD(1) XMY("ELLZEY.LINDA@FORUM.VA.GOV")=""
S XMDUZ="PSO*7*239 "_JOBN
S XMSUB="STATION "_$G(PSOINST)
S XMSUB=XMSUB_$S($$PROD^XUPROD(1):" (Prod)",1:" (Test)")
S XMSUB=XMSUB_" Activity log and Copay Activity log correction "
S PSOTEXT(1)=""
S PSOTEXT(2)="Started "_PSOSTART
S PSOTEXT(3)=""
S PSOTEXT(4)=" "_MSG
S PSOTEXT(5)=""
S PSOTEXT(6)="NO FURTHER ACTION REQUIRED."
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB,PSOEND
Q
;
MAIL ;
D NOW^%DTC S Y=% D DD^%DT N PSOCXPDA,PSOTEXT,XMY,XMTEXT,PSORXP,PSONCNT,PSOEND2,PSOEND
S PSOEND=Y,PSOEND2=$$FMTE^XLFDT(%,"1PS")
I $G(DUZ) S XMY(DUZ)=""
S XMDUZ="PSO*7*239 "_JOBN
S XMSUB="Outpatient Pharmacy PSO*7*239 "_JOBN
;S XMY("ELLZEY.LINDA@FORUM.VA.GOV")=""
F PSOCXPDA=0:0 S PSOCXPDA=$O(^XUSEC("PSO COPAY",PSOCXPDA)) Q:'PSOCXPDA S XMY(PSOCXPDA)=""
I $O(XMY(""))="" Q ; no recipients for mail message
S PSOTEXT(1)="The "_JOBN_" job for the Outpatient Pharmacy"
S PSOTEXT(2)="patch (PSO*7*239) started "_PSOSTART
S PSOTEXT(3)="and completed "_PSOEND_"."
S PSOTEXT(4)=" ",(PSORXP,PSONCNT)=""
S PSOTEXT(5)=" "
S PSOTEXT(6)=" "
I $D(^XTMP("PSOCIDC7",0,"LOCKED RX")) D
. F S PSORXP=$O(^XTMP("PSOCIDC7",0,"LOCKED RX",PSORXP)) Q:PSORXP="" S PSONCNT=PSONCNT+1
. Q:'$G(PSONCNT)>0
. S PSOTEXT(5)="There were "_PSONCNT_" locked Rx(s) that could not be processed."
. S PSOTEXT(6)="From programmer's mode, type D LOCKED^PSOCIDC9 for a report."
S PSOTEXT(7)=" "
;
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
Q
;