source: FOIAVistA/tag/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORELR5.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1ORELR5 ; slc/dcm - Check 69 against 100 ;
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**42**;Dec 17, 1997
3EN ;Check file 69 against 100 for inconsistencies
4 N %,UPD,ZTSAVE
5 W !!,"This routine will go through the LAB ORDER ENTRY file (69)"
6 W !,"and check for inconsistencies between Lab files and CPRS files."
7 W !,"This process could take several hours to complete."
8 W !,"Are you sure you want to continue"
9 S %=2 D YN^DICN
10 I %=0 W !!,"Answer YES to continue" G EN
11 Q:%'=1
12UPD W !!,"You have the option of just checking the database, or updating the database."
13 W !,"Do you want to update the database now"
14 S %=2 D YN^DICN
15 I %=0 W !!,"Select YES to update the database" G UPD
16 Q:%=-1
17 S UPD=$S(%=1:1,1:0)
18 S ZTSAVE("UPD")=""
19 D QUE^ORUTL1("DEQUE^ORELR5","Check from 69 to 100",.ZTSAVE)
20 Q
21DEQUE ;Queued entry point
22 U IO
23 W !,"Inconsistency report between LAB (69) and OE/RR (100) files..."
24 W !,"Date/time Started: "_$$DATETIME^ORU($$NOW^XLFDT())
25 W !,"Now looking for data..."
26 N LRDFN,ORAFIX,STCNT,TOTCNT,DCNT,PTCNT,F100CNT,ENTCNT
27 S (ORAFIX,STCNT,TOTCNT,DCNT,PTCNT,F100CNT,ENTCNT,LRDFN)=0
28 F S LRDFN=$O(^LRO(69,"D",LRDFN)) Q:LRDFN<1 D LOOP(LRDFN,UPD)
29 W:IOSL-$Y<10 @IOF
30 W !!,"Total Inconsistencies Found"
31 W !,"Date/time Completed: "_$$DATETIME^ORU($$NOW^XLFDT())
32 W !,"-------------------------------------------------"
33 I DCNT W !,"Bad entry in ^LRO(69,""D""",?40,$J(DCNT,7)
34 I F100CNT W !,"Broken pointer to 100",?40,$J(F100CNT,7)
35 I ENTCNT W !,"Inconsistent entry dates",?40,$J(ENTCNT,7)
36 I PTCNT W !,"Patient mismatch"_$S(UPD:" (not fixed)",1:""),?40,$J(PTCNT,7)
37 I STCNT W !,"Status update on panel test",?40,$J(STCNT,7)
38 W !,"================================================="
39 W !,"Total: ",?40,$J(TOTCNT,7)
40 I $D(ZTQUEUED) S ZTREQ="@"
41 Q
42LOOP(LRDFN,ORAFIX) ;Loop on patient
43 I '$D(^LR(LRDFN,0)) D WRT(,,,"No entry in ^LR("_LRDFN,ORAFIX) S DCNT=DCNT+1,TOTCNT=TOTCNT+1 K:ORAFIX ^LRO(69,"D",LRDFN) Q
44 Q:$P(^LR(LRDFN,0),"^",2)'=2 ;Not in patient file.
45 S DFN=$P(^LR(LRDFN,0),"^",3)
46 Q:'$D(^LRO(69,"D",$G(LRDFN)))
47 N LRODT,LRSN,LRTI,LRTST,LRENT,X,X0,X3,ORX1,ORX2,ORIFN,X8O
48 S LRODT=0 F S LRODT=$O(^LRO(69,"D",LRDFN,LRODT)) Q:'LRODT S LRSN=0 F S LRSN=$O(^LRO(69,"D",LRDFN,LRODT,LRSN)) Q:'LRSN D
49 . I '$D(^LRO(69,LRODT,1,LRSN,0)) D WRT(LRODT,LRSN,,"D X-ref invalid",ORAFIX) S DCNT=DCNT+1,TOTCNT=TOTCNT+1 K:ORAFIX ^LRO(69,"D",LRDFN,LRODT,LRSN) Q
50 . S X=^LRO(69,LRODT,1,LRSN,0),LRENT=$P(X,"^",5)
51 . S LRTI=0 F S LRTI=$O(^LRO(69,LRODT,1,LRSN,2,LRTI)) Q:LRTI<1 S X0=^(LRTI,0) D
52 .. S LRTST=+X0,ORIFN=$P(X0,"^",7)
53 .. I ORIFN D
54 ... I '$D(^OR(100,ORIFN)) D WRT(LRODT,LRSN,LRTI,"Broken pointer to 100:"_ORIFN,ORAFIX) S F100CNT=F100CNT+1,TOTCNT=TOTCNT+1 S:ORAFIX $P(^LRO(69,LRODT,1,LRSN,2,LRTI,0),"^",7)="P" Q ;P=purged
55 ... S X=^OR(100,ORIFN,0),X3=$G(^(3))
56 ... I DFN'=+$P(X,"^",2) D WRT(LRODT,LRSN,LRTI,"Patient mismatch:"_ORIFN_"<"_$P(X3,"^",3)_">") S PTCNT=PTCNT+1,TOTCNT=TOTCNT+1 Q
57 ... D STATUS(LRODT,LRSN,LRTI,X0,ORAFIX)
58 ... I LRENT,$P(X,"^",7)>$S($P($P(X,"^",8),".",2):$P(X,"^",8),1:$P(X,"^",8)_".2359") D
59 .... S ORX1=$$FMADD^XLFDT($P(X,"^",7),,,30),ORX2=$$FMADD^XLFDT($P(X,"^",7),,,-30)
60 .... I LRENT<ORX2!(LRENT>ORX1) S ENTCNT=ENTCNT+1,TOTCNT=TOTCNT+1 I ORAFIX D
61 ..... S $P(^OR(100,ORIFN,0),"^",7)=LRENT
62 ..... I $P(X,"^",7)=+$G(^OR(100,ORIFN,8,1,0)) S X8O=$G(^(0)) D
63 ...... N DI,DIC,DIE,DA,DR,D0,DQ,DISYS
64 ...... I $P(X,"^",11) K ^OR(100,"ACT",$P(X,"^",2),9999999-+X8O,$P(X,"^",11),ORIFN,1)
65 ...... K ^OR(100,"AC",$P(X,"^",2),9999999-+X8O,ORIFN,1),^OR(100,"AF",+X8O,ORIFN,1),^OR(100,"AS",$P(X,"^",2),9999999-(+X8O),ORIFN,1)
66 ...... I $P(X8O,"^",16)=+X8O K ^OR(100,"AR",$P(X,"^",2),9999999-(+X8O),ORIFN,1) S ^OR(100,"AR",$P(X,"^",2),9999999-LRENT,ORIFN,1)="",$P(^OR(100,ORIFN,8,1,0),"^",16)=LRENT
67 ...... S $P(^OR(100,ORIFN,8,1,0),"^")=LRENT,^OR(100,"AF",LRENT,ORIFN,1)=""
68 ...... D S1^ORDD100(ORIFN,1,"",LRENT),SET^ORDD100(ORIFN,1),ACT1^ORDD100A(ORIFN,1)
69 Q
70WRT(LRODT,LRSN,LRTST,TEXT,FIXED) ;Write error message
71 Q:$E(IOST,1,2)="P-"
72 W "."
73 ;W !,$G(LRODT)_";"_$G(LRSN)_";"_$G(LRTST)_"=>"_TEXT_$S($G(FIXED):" FIXED",1:"")
74 Q
75STATUS(I,J,K,Z,UPDATE) ;Check status of exploded panels
76 Q:'$D(^LRO(69,I,1,J,2,K,0)) S:'$D(Z) Z=^(0)
77 N F,X,X7,Z7,ORSTS,ORIFN
78 K ^TMP("ORCHKLRO",$J)
79 S F=1,Z7=$P(Z,"^",7)
80 I $P(Z,"^",8) D
81 . N TST,T,N
82 . S T=0 F S T=$O(^LAB(60,+Z,2,T)) Q:'T S TST(+^(T,0))=""
83 . S T=0 F S T=$O(TST(T)) Q:'T I $D(^LRO(69,I,1,J,2,"B",T)) S N=$O(^(T,0)) I $D(^LRO(69,I,1,J,2,N,0)) S X=^(0),X7=$P(X,"^",7) D
84 .. I X7,Z7,X7'=Z7,'$D(^TMP("ORCHKLRO",$J,Z7)) D Q
85 ... N X1,X2
86 ... S X1=$P($G(^OR(100,X7,3)),"^",3),X2=$P($G(^OR(100,Z7,3)),"^",3)
87 ... Q:X1="" Q:X2="" Q:X1=X2 Q:X2=14 Q:X2=1 Q:X2=2 Q:X2=13
88 ... I F S STCNT=STCNT+1,TOTCNT=TOTCNT+1
89 ... S F=0
90 ... I $G(UPDATE) D
91 .... I $S(+$G(^DD(100,0,"VR")):+^("VR"),1:0)<3 S ORSTS=X1,ORIFN=Z7 D ST^ORX
92 .... I $S(+$G(^DD(100,0,"VR")):+^("VR"),1:0)'<3 D STATUS^ORCSAVE2(Z7,X1)
93 .... S ^TMP("ORCHKLRO",$J,Z7)=""
94 K ^TMP("ORCHKLRO",$J)
95 Q
Note: See TracBrowser for help on using the repository browser.