source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPCEB.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

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,142**;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 .I $P(RM600,U,2)="" Q
30 .S RM611=$G(^RMPR(660,RI,1))
31 .S RM610=$G(^RMPR(660,RI,10))
32 .Q:$P(RM600,U,15)
33 .Q:$P(RM600,U,17)
34 .Q:'$P(RM610,U,8)
35 .S RMSTA=$P(RM600,U,10)
36 .;quit if already been processed.
37 .Q:$P(RM610,U,12)
38 .Q:(RMSTA="")!('$D(RSTAFLG(RMSTA)))
39 .Q:'$P(RM611,U,4)!'$P(RM600,U,22)
40 .S RMDATE=$P(RM600,U,1),RMDFN=$P(RM600,U,2)
41 .S RMICD9=$P(RM610,U,8) I RMICD9'="" Q:$P($G(^ICD9(RMICD9,0)),U,9) ;quit if DX code inactive RMPR*120
42 .Q:$D(^TMP($J,RMSTA,RMDATE,RMDFN))
43 .S RMPROCF=0
44 .F J=0:0 S J=$O(^RMPR(660,"C",RMDFN,J)) Q:J'>0 D
45 ..S RMJ60=$G(^RMPR(660,J,0)),RMJDT=$P(RMJ60,U,1),RMJST=$P(RMJ60,U,10)
46 ..Q:(RMJST'=RMSTA)!(RMJDT'=RMDATE)
47 ..S RMJ610=$G(^RMPR(660,J,10)),RMJ12=$P(RMJ610,U,12)
48 ..I $G(RMJ12) S RMPROCF=1
49 .;don't process if PCE data was process for the same day.
50 .Q:$G(RMPROCF)
51 .S ^TMP($J,RMSTA,RMDATE,RMDFN,RI)=""
52 ;
53 D PROC
54 I '$D(^TMP($J,"RMPRERR")) D
55 .S ^TMP($J,"RMPR",5)="***** NO ERROR TO REPORT !!!!!"
56 S RMSUBI=4 D BUILD D:$D(^XMB(3.8,"B","RMPR PCE")) MES1,MES2
57 G EXIT
58 ;
59PCEFLG ;
60 S:$D(^RMPR(669.9,RS,"PCE")) RFLDAT=$P($G(^RMPR(669.9,RS,"PCE")),U,2)
61 S:'$D(^RMPR(669.9,RS,"PCE")) RFLDAT=0
62 S RSTAFLG($P(^RMPR(669.9,RS,0),U,2))=RFLDAT
63 S $P(^RMPR(669.9,RS,"PCE"),U,1)=RMSTDT
64 Q
65 ;
66PROC ;process
67 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
68 .;call PCE Interface
69 .S RMIE60RK=RK
70 .S RMC=$$SENDPCE^RMPRPCEA(RK)
71 . I RMC<1 D
72 ..S RSNAM=" "
73 ..I $G(RS),$D(^DIC(4,RS,0)) S RSNAM=$E($P(^DIC(4,RS,0),U,1),1,8)
74 ..S ^TMP($J,"RMPRERR",RK)="Station: "_RSNAM_", File #660 IEN="_RK_" - Error in PCE interface!!!"
75 ..;Added next line for RMPR*3*82
76 ..I '$G(RMLOC) S ^TMP($J,"RMPRERR",RK)=^TMP($J,"RMPRERR",RK)_$G(RERRMSG)_$G(RERRMSG2)
77 ..I $D(RMPROB($J,1))!$D(RMPROB($J,2)) D
78 ...S (R2,R3,RMMESS)="",R6I=RK,RC=0
79 ...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
80 ....F R4=0:0 S R4=$O(RMPROB($J,R1,"ERROR1",R2,R3,R4)) Q:R4'>0 D
81 .....S RMMESS=RMPROB($J,R1,"ERROR1",R2,R3,R4),RMK=R6I_"."_RC,^TMP($J,"RMPRERR",RMK)=" ???? "_$E(RMMESS,1,999)
82 .....K RMPROB($J,R1,"ERROR1",R2,R3,R4)
83 K RMPROB
84 Q
85 ;
86MES1 ;
87 S XMY("G.RMPR PCE")="",XMDUZ=.5,XMTEXT="^TMP($J,""RMPR"","
88 S XMSUB="PROSTHETICS PCE BACKGROUND MESSAGE"
89 S ^TMP($J,"RMPR",1)="Run Date: "_RMRDAT
90 S ^TMP($J,"RMPR",2)="This is a notification from the Prosthetics Department........"
91 S ^TMP($J,"RMPR",3)=""
92 S ^TMP($J,"RMPR",4)=""
93 Q
94MES2 ;
95 S ^TMP($J,"RMPR",RMSUBI+2)=""
96 I $D(^TMP($J,"RMPRERR")) S ^TMP($J,"RMPR",RMSUBI+3)="*** Please contact your PCE Coordinator or IRM ***"
97 I '$D(^TMP($J,"RMPRERR")) S ^TMP($J,"RMPR",RMSUBI+3)=""
98 S ^TMP($J,"RMPR",RMSUBI+4)=""
99 S ^TMP($J,"RMPR",RMSUBI+5)="Thank You!!!"
100 S ^TMP($J,"RMPR",RMSUBI+6)=""
101 S ^TMP($J,"RMPR",RMSUBI+7)="PROSTHETICS DEPARTMENT"
102 D ^XMD
103 D NOW^%DTC
104 ;if task finish to completion and;
105 ;if no errors, set the PCE end date of the background job in #669.9.
106 F RS=0:0 S RS=$O(^RMPR(669.9,RS)) Q:RS'>0 S $P(^RMPR(669.9,RS,"PCE"),U,2)=%
107 Q
108 ;
109BUILD ;
110 F I=0:0 S I=$O(^TMP($J,"RMPRERR",I)) Q:I'>0 D
111 .S RMMAIL=^TMP($J,"RMPRERR",I)
112 .S RMSUBI=RMSUBI+1
113 .S ^TMP($J,"RMPR",RMSUBI)=RMMAIL
114 Q
115 ;
116EXIT ;MAIN EXIT POINT
117 K ^TMP($J)
118 S DUZ=SVDUZ
119 N RMPRSITE,RMPR D KILL^XUSCLEAN
120 Q
Note: See TracBrowser for help on using the repository browser.