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

Last change on this file since 719 was 636, checked in by George Lilly, 15 years ago

WorldVistAEHR overlayed on FOIAVistA

File size: 4.4 KB
Line 
1RMPRPCEB ;HIN/RVD-PROS PCE BACKGROUND UTILITY ; 1/23/04 8:09am
2 ;;3.0;PROSTHETICS;**62,69,77,82,78,114,120,133**;Feb 09, 1996;Build 2
3 ;
4 ;RVD patch #69 - add STATION in the error message.
5 ; QUIT if no data in specified date range.
6 ;RVD patch #77 - only create 1 PCE entry for the same pt & same day.
7 ;
8 ;KAM Patch #82 06/21/2004 - Add more robust text to 'Missing
9 ; Prosthetics Clinic PCE error message
10 ;
11 ;WLC Patch #78 02/03/3005 - added NEW statement for error message
12 ; variables defined for Patch 82.
13 ;
14 W !,"Invalid Entry Point.....",!
15 Q
16TASK ;entry point for task job to send pros encounters to PCE.
17 N RERRMSG,RERRMSG2 ; correction for patch 82 02/03/05 WLC
18 S IO=0,RMAIL=1,SVDUZ=DUZ,DUZ=.5
19 S Y=DT D DD^%DT S RMRDAT=Y K RMX,RMXMT,^TMP($J)
20 D NOW^%DTC S RMSTDT=%
21 S X="T-90" D ^%DT S RM90DAY=Y
22 S RMBIEN=$O(^RMPR(660,"B",RM90DAY))
23 Q:RMBIEN=""
24 S (RMENDT,RFLDAT)=0
25 F RS=0:0 S RS=$O(^RMPR(669.9,RS)) Q:RS'>0 D PCEFLG
26 S RI=$O(^RMPR(660,"B",RMBIEN,0))-1 ;starts at proper ien RMPR*120
27 F S RI=$O(^RMPR(660,RI)) Q:RI'>0 D
28 .S RM600=$G(^RMPR(660,RI,0))
29 .S RM611=$G(^RMPR(660,RI,1))
30 .S RM610=$G(^RMPR(660,RI,10))
31 .Q:$P(RM600,U,15)
32 .Q:$P(RM600,U,17)
33 .Q:'$P(RM610,U,8)
34 .S RMSTA=$P(RM600,U,10)
35 .;quit if already been processed.
36 .Q:$P(RM610,U,12)
37 .Q:(RMSTA="")!('$D(RSTAFLG(RMSTA)))
38 .Q:'$P(RM611,U,4)!'$P(RM600,U,22)
39 .S RMDATE=$P(RM600,U,1),RMDFN=$P(RM600,U,2)
40 .S RMICD9=$P(RM610,U,8) I RMICD9'="" Q:$P($G(^ICD9(RMICD9,0)),U,9) ;quit if DX code inactive RMPR*120
41 .Q:$D(^TMP($J,RMSTA,RMDATE,RMDFN))
42 .S RMPROCF=0
43 .F J=0:0 S J=$O(^RMPR(660,"C",RMDFN,J)) Q:J'>0 D
44 ..S RMJ60=$G(^RMPR(660,J,0)),RMJDT=$P(RMJ60,U,1),RMJST=$P(RMJ60,U,10)
45 ..Q:(RMJST'=RMSTA)!(RMJDT'=RMDATE)
46 ..S RMJ610=$G(^RMPR(660,J,10)),RMJ12=$P(RMJ610,U,12)
47 ..I $G(RMJ12) S RMPROCF=1
48 .;don't process if PCE data was process for the same day.
49 .Q:$G(RMPROCF)
50 .S ^TMP($J,RMSTA,RMDATE,RMDFN,RI)=""
51 ;
52 D PROC
53 I '$D(^TMP($J,"RMPRERR")) D
54 .S ^TMP($J,"RMPR",5)="***** NO ERROR TO REPORT !!!!!"
55 S RMSUBI=4 D BUILD D:$D(^XMB(3.8,"B","RMPR PCE")) MES1,MES2
56 G EXIT
57 ;
58PCEFLG ;
59 S:$D(^RMPR(669.9,RS,"PCE")) RFLDAT=$P($G(^RMPR(669.9,RS,"PCE")),U,2)
60 S:'$D(^RMPR(669.9,RS,"PCE")) RFLDAT=0
61 S RSTAFLG($P(^RMPR(669.9,RS,0),U,2))=RFLDAT
62 S $P(^RMPR(669.9,RS,"PCE"),U,1)=RMSTDT
63 Q
64 ;
65PROC ;process
66 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
67 .;call PCE Interface
68 .S RMIE60RK=RK
69 .S RMC=$$SENDPCE^RMPRPCEA(RK)
70 . I RMC<1 D
71 ..S RSNAM=" "
72 ..I $G(RS),$D(^DIC(4,RS,0)) S RSNAM=$E($P(^DIC(4,RS,0),U,1),1,8)
73 ..S ^TMP($J,"RMPRERR",RK)="Station: "_RSNAM_", File #660 IEN="_RK_" - Error in PCE interface!!!"
74 ..;Added next line for RMPR*3*82
75 ..I '$G(RMLOC) S ^TMP($J,"RMPRERR",RK)=^TMP($J,"RMPRERR",RK)_$G(RERRMSG)_$G(RERRMSG2)
76 ..I $D(RMPROB($J,1))!$D(RMPROB($J,2)) D
77 ...S (R2,R3,RMMESS)="",R6I=RK,RC=0
78 ...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
79 ....F R4=0:0 S R4=$O(RMPROB($J,R1,"ERROR1",R2,R3,R4)) Q:R4'>0 D
80 .....S RMMESS=RMPROB($J,R1,"ERROR1",R2,R3,R4),RMK=R6I_"."_RC,^TMP($J,"RMPRERR",RMK)=" ???? "_$E(RMMESS,1,999)
81 .....K RMPROB($J,R1,"ERROR1",R2,R3,R4)
82 K RMPROB
83 Q
84 ;
85MES1 ;
86 S XMY("G.RMPR PCE")="",XMDUZ=.5,XMTEXT="^TMP($J,""RMPR"","
87 S XMSUB="PROSTHETICS PCE BACKGROUND MESSAGE"
88 S ^TMP($J,"RMPR",1)="Run Date: "_RMRDAT
89 S ^TMP($J,"RMPR",2)="This is a notification from the Prosthetics Department........"
90 S ^TMP($J,"RMPR",3)=""
91 S ^TMP($J,"RMPR",4)=""
92 Q
93MES2 ;
94 S ^TMP($J,"RMPR",RMSUBI+2)=""
95 I $D(^TMP($J,"RMPRERR")) S ^TMP($J,"RMPR",RMSUBI+3)="*** Please contact your PCE Coordinator or IRM ***"
96 I '$D(^TMP($J,"RMPRERR")) S ^TMP($J,"RMPR",RMSUBI+3)=""
97 S ^TMP($J,"RMPR",RMSUBI+4)=""
98 S ^TMP($J,"RMPR",RMSUBI+5)="Thank You!!!"
99 S ^TMP($J,"RMPR",RMSUBI+6)=""
100 S ^TMP($J,"RMPR",RMSUBI+7)="PROSTHETICS DEPARTMENT"
101 D ^XMD
102 D NOW^%DTC
103 ;if task finish to completion and;
104 ;if no errors, set the PCE end date of the background job in #669.9.
105 F RS=0:0 S RS=$O(^RMPR(669.9,RS)) Q:RS'>0 S $P(^RMPR(669.9,RS,"PCE"),U,2)=%
106 Q
107 ;
108BUILD ;
109 F I=0:0 S I=$O(^TMP($J,"RMPRERR",I)) Q:I'>0 D
110 .S RMMAIL=^TMP($J,"RMPRERR",I)
111 .S RMSUBI=RMSUBI+1
112 .S ^TMP($J,"RMPR",RMSUBI)=RMMAIL
113 Q
114 ;
115EXIT ;MAIN EXIT POINT
116 K ^TMP($J)
117 S DUZ=SVDUZ
118 N RMPRSITE,RMPR D KILL^XUSCLEAN
119 Q
Note: See TracBrowser for help on using the repository browser.