source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOCIDC8.m@ 1476

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
 ;