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>>>>>>>>>> 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 ;