source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPCEB.m@ 719

RMPRPCEB ;HIN/RVD-PROS PCE BACKGROUND UTILITY ; 1/23/04 8:09am
 ;;3.0;PROSTHETICS;**62,69,77,82,78,114,120,133**;Feb 09, 1996;Build 2
 ;
 ;RVD patch #69 - add STATION in the error message.
 ;                QUIT if no data in specified date range.
 ;RVD patch #77 - only create 1 PCE entry for the same pt & same day.
 ;
 ;KAM Patch #82 06/21/2004 - Add more robust text to 'Missing
 ;                           Prosthetics Clinic PCE error message
 ;
 ;WLC Patch #78 02/03/3005 - added NEW statement for error message
 ;                           variables defined for Patch 82.
 ;
 W !,"Invalid Entry Point.....",!
 Q
TASK ;entry point for task job to send pros encounters to PCE.
 N RERRMSG,RERRMSG2  ; correction for patch 82  02/03/05 WLC
 S IO=0,RMAIL=1,SVDUZ=DUZ,DUZ=.5
 S Y=DT D DD^%DT S RMRDAT=Y K RMX,RMXMT,^TMP($J)
 D NOW^%DTC S RMSTDT=%
 S X="T-90" D ^%DT S RM90DAY=Y
 S RMBIEN=$O(^RMPR(660,"B",RM90DAY))
 Q:RMBIEN=""
 S (RMENDT,RFLDAT)=0
 F RS=0:0 S RS=$O(^RMPR(669.9,RS)) Q:RS'>0  D PCEFLG
 S RI=$O(^RMPR(660,"B",RMBIEN,0))-1     ;starts at proper ien RMPR*120
 F  S RI=$O(^RMPR(660,RI)) Q:RI'>0  D
 .S RM600=$G(^RMPR(660,RI,0))
 .S RM611=$G(^RMPR(660,RI,1))
 .S RM610=$G(^RMPR(660,RI,10))
 .Q:$P(RM600,U,15)
 .Q:$P(RM600,U,17)
 .Q:'$P(RM610,U,8)
 .S RMSTA=$P(RM600,U,10)
 .;quit if already been processed.
 .Q:$P(RM610,U,12)
 .Q:(RMSTA="")!('$D(RSTAFLG(RMSTA)))
 .Q:'$P(RM611,U,4)!'$P(RM600,U,22)
 .S RMDATE=$P(RM600,U,1),RMDFN=$P(RM600,U,2)
 .S RMICD9=$P(RM610,U,8) I RMICD9'="" Q:$P($G(^ICD9(RMICD9,0)),U,9)  ;quit if DX code inactive RMPR*120
 .Q:$D(^TMP($J,RMSTA,RMDATE,RMDFN))
 .S RMPROCF=0
 .F J=0:0 S J=$O(^RMPR(660,"C",RMDFN,J)) Q:J'>0  D
 ..S RMJ60=$G(^RMPR(660,J,0)),RMJDT=$P(RMJ60,U,1),RMJST=$P(RMJ60,U,10)
 ..Q:(RMJST'=RMSTA)!(RMJDT'=RMDATE)
 ..S RMJ610=$G(^RMPR(660,J,10)),RMJ12=$P(RMJ610,U,12)
 ..I $G(RMJ12) S RMPROCF=1
 .;don't process if PCE data was process for the same day.
 .Q:$G(RMPROCF)
 .S ^TMP($J,RMSTA,RMDATE,RMDFN,RI)=""
 ;
 D PROC
 I '$D(^TMP($J,"RMPRERR")) D
 .S ^TMP($J,"RMPR",5)="***** NO ERROR TO REPORT !!!!!"
 S RMSUBI=4 D BUILD D:$D(^XMB(3.8,"B","RMPR PCE")) MES1,MES2
 G EXIT
 ;
PCEFLG ;
 S:$D(^RMPR(669.9,RS,"PCE")) RFLDAT=$P($G(^RMPR(669.9,RS,"PCE")),U,2)
 S:'$D(^RMPR(669.9,RS,"PCE")) RFLDAT=0
 S RSTAFLG($P(^RMPR(669.9,RS,0),U,2))=RFLDAT
 S $P(^RMPR(669.9,RS,"PCE"),U,1)=RMSTDT
 Q
 ;
PROC ;process
 F RS=0:0 S RS=$O(^TMP($J,RS)) Q:RS'>0  F RII=0:0 S RII=$O(^TMP($J,RS,RII)) Q:RII'>0  F RJ=0:0 S RJ=$O(^TMP($J,RS,RII,RJ)) Q:RJ'>0  S RK=$O(^TMP($J,RS,RII,RJ,0)) D
 .;call PCE Interface
 .S RMIE60RK=RK
 .S RMC=$$SENDPCE^RMPRPCEA(RK)
 . I RMC<1 D
 ..S RSNAM="        "
 ..I $G(RS),$D(^DIC(4,RS,0)) S RSNAM=$E($P(^DIC(4,RS,0),U,1),1,8)
 ..S ^TMP($J,"RMPRERR",RK)="Station: "_RSNAM_", File #660 IEN="_RK_" - Error in PCE interface!!!"
 ..;Added next line for RMPR*3*82
 ..I '$G(RMLOC) S ^TMP($J,"RMPRERR",RK)=^TMP($J,"RMPRERR",RK)_$G(RERRMSG)_$G(RERRMSG2)
 ..I $D(RMPROB($J,1))!$D(RMPROB($J,2)) D
 ...S (R2,R3,RMMESS)="",R6I=RK,RC=0
 ...F R1=0:0 S R1=$O(RMPROB($J,R1)) Q:R1'>0  S RC=RC+1 F  S R2=$O(RMPROB($J,R1,"ERROR1",R2)) Q:R2=""  F  S R3=$O(RMPROB($J,R1,"ERROR1",R2,R3)) Q:R3=""  D
 ....F R4=0:0 S R4=$O(RMPROB($J,R1,"ERROR1",R2,R3,R4)) Q:R4'>0  D
 .....S RMMESS=RMPROB($J,R1,"ERROR1",R2,R3,R4),RMK=R6I_"."_RC,^TMP($J,"RMPRERR",RMK)="    ???? "_$E(RMMESS,1,999)
 .....K RMPROB($J,R1,"ERROR1",R2,R3,R4)
 K RMPROB
 Q
 ;
MES1 ;
 S XMY("G.RMPR PCE")="",XMDUZ=.5,XMTEXT="^TMP($J,""RMPR"","
 S XMSUB="PROSTHETICS PCE BACKGROUND MESSAGE"
 S ^TMP($J,"RMPR",1)="Run Date: "_RMRDAT
 S ^TMP($J,"RMPR",2)="This is a notification from the Prosthetics Department........"
 S ^TMP($J,"RMPR",3)=""
 S ^TMP($J,"RMPR",4)=""
 Q
MES2 ;
 S ^TMP($J,"RMPR",RMSUBI+2)=""
 I $D(^TMP($J,"RMPRERR")) S ^TMP($J,"RMPR",RMSUBI+3)="*** Please contact your PCE Coordinator or IRM ***"
 I '$D(^TMP($J,"RMPRERR")) S ^TMP($J,"RMPR",RMSUBI+3)=""
 S ^TMP($J,"RMPR",RMSUBI+4)=""
 S ^TMP($J,"RMPR",RMSUBI+5)="Thank You!!!"
 S ^TMP($J,"RMPR",RMSUBI+6)=""
 S ^TMP($J,"RMPR",RMSUBI+7)="PROSTHETICS DEPARTMENT"
 D ^XMD
 D NOW^%DTC
 ;if task finish to completion and;
 ;if no errors, set the PCE end date of the background job in #669.9.
 F RS=0:0 S RS=$O(^RMPR(669.9,RS)) Q:RS'>0  S $P(^RMPR(669.9,RS,"PCE"),U,2)=%
 Q
 ;
BUILD ;
 F I=0:0 S I=$O(^TMP($J,"RMPRERR",I)) Q:I'>0  D
 .S RMMAIL=^TMP($J,"RMPRERR",I)
 .S RMSUBI=RMSUBI+1
 .S ^TMP($J,"RMPR",RMSUBI)=RMMAIL
 Q
 ;
EXIT ;MAIN EXIT POINT
 K ^TMP($J)
 S DUZ=SVDUZ
 N RMPRSITE,RMPR D KILL^XUSCLEAN
 Q