Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOCIDC8

PSOCIDC8.m

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