source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRDSCOR.m@ 1736

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

initial load of WorldVistAEHR

File size: 837 bytes
RevLine 
[613]1XDRDSCOR ;IHS/OHPRD/JCM - SETS SCORES FOR DUPLICATE CHECKING; [ 08/13/92 09:50 AM ]
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3START ;
4 S XDRQFLG=0
5 I '$D(XDRFL)!('$D(XDRD(0))) D FILE^XDRDQUE G:XDRQFLG END
6 S XDRDSCOR("PDT%")=$P(XDRD(0),U,15)
7 S:$P(XDRD(0),U,18) XDRDSCOR("VDT%")=$P(XDRD(0),U,18)
8 I '$O(^VA(15.1,XDRFL,11,0)) S XDRERR=3 D ^XDREMSG G END
9 F XDRDORD=0:0 S XDRDORD=$O(^VA(15.1,XDRFL,11,"AO",XDRDORD)) Q:'XDRDORD D TEST
10END ;
11 K XDRDORD
12 Q
13 ;
14TEST ;
15 S XDRDTST=$O(^VA(15.1,XDRFL,11,"AO",XDRDORD,0))
16 S XDRDTEST(XDRDORD)=^VA(15.1,XDRFL,11,XDRDTST,0)
17 S XDRDTEST("FILE")=$S('$P(XDRDTEST(XDRDORD),U,4):XDRFL,1:$P(XDRDTEST(XDRDORD),U,4))
18 S XDRDSCOR("DR",XDRDTEST("FILE"))=$S($D(XDRDSCOR("DR",XDRDTEST("FILE"))):XDRDSCOR("DR",XDRDTEST("FILE"))_$P(XDRDTEST(XDRDORD),U,5)_";",1:$P(XDRDTEST(XDRDORD),U,5)_";")
19 K XDRDTST,XDRDTEST("FILE")
20 Q
Note: See TracBrowser for help on using the repository browser.