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