- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPCEB.m
r613 r623 1 RMPRPCEB ;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 16 TASK ;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 ; 59 PCEFLG ; 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 ; 66 PROC ;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 ; 86 MES1 ; 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 94 MES2 ; 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 ; 109 BUILD ; 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 ; 116 EXIT ;MAIN EXIT POINT 117 K ^TMP($J) 118 S DUZ=SVDUZ 119 N RMPRSITE,RMPR D KILL^XUSCLEAN 120 Q 1 RMPRPCEB ;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 16 TASK ;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 ; 58 PCEFLG ; 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 ; 65 PROC ;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 ; 85 MES1 ; 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 93 MES2 ; 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 ; 108 BUILD ; 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 ; 115 EXIT ;MAIN EXIT POINT 116 K ^TMP($J) 117 S DUZ=SVDUZ 118 N RMPRSITE,RMPR D KILL^XUSCLEAN 119 Q
Note:
See TracChangeset
for help on using the changeset viewer.
