source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRUBL.m@ 862

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

initial load of WorldVistAEHR

File size: 784 bytes
RevLine 
[613]1LRUBL ;AVAMC/REG - FIND PATIENT MISMATCHES ;2/18/93 13:24
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 D END W !!,"FIND PATIENT MISMATCHES IN VA PATIENT NUMBER FIELD OF FILE 65"
4 S ZTRTN="QUE^LRUBL" D BEG^LRUTL G:POP!($D(ZTSK)) END
5QUE U IO D H S (A,C,M)=0 F LRC=0:1 S A=$O(^LRD(65,A)) Q:'A F B=0:0 S B=$O(^LRD(65,A,3,B)) Q:'B S X=^(B,0),P=$P(X,"^",6),DFN=$P(X,"^",7) I DFN,$D(^DPT(DFN,0)) S C=C+1,Y=^(0) I $P(Y,"^")'=P D W
6 W !!,"# units: ",LRC,!,"# relocations: ",C,!,"# missmatches: ",M D END^LRUTL,END Q
7W W !!,P," not ",$P(Y,"^")," (SSN: ",$P(Y,"^",9),") Unit IFN:",A S M=M+1
8 W !,"DATE/TIME RELOCATION: " S Y=+X D D^DIQ W Y,?45,"Unit ID: ",$P(^LRD(65,A,0),"^") Q
9 ;
10H S X="N",%DT="T" D ^%DT,D^DIQ W @IOF,Y," ",$$INS^LRU,!,"PATIENT MISMATCHES IN 65.03,.07 DATA ELEMENT" Q
11END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.