Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XDRDSCOR

XDRDSCOR.m

Go to the documentation of this file.
  1. XDRDSCOR ;IHS/OHPRD/JCM - SETS SCORES FOR DUPLICATE CHECKING; [ 08/13/92 09:50 AM ]
  1. ;;7.3;TOOLKIT;;Apr 25, 1995
  1. START ;
  1. S XDRQFLG=0
  1. I '$D(XDRFL)!('$D(XDRD(0))) D FILE^XDRDQUE G:XDRQFLG END
  1. S XDRDSCOR("PDT%")=$P(XDRD(0),U,15)
  1. S:$P(XDRD(0),U,18) XDRDSCOR("VDT%")=$P(XDRD(0),U,18)
  1. I '$O(^VA(15.1,XDRFL,11,0)) S XDRERR=3 D ^XDREMSG G END
  1. F XDRDORD=0:0 S XDRDORD=$O(^VA(15.1,XDRFL,11,"AO",XDRDORD)) Q:'XDRDORD D TEST
  1. END ;
  1. K XDRDORD
  1. Q
  1. ;
  1. TEST ;
  1. S XDRDTST=$O(^VA(15.1,XDRFL,11,"AO",XDRDORD,0))
  1. S XDRDTEST(XDRDORD)=^VA(15.1,XDRFL,11,XDRDTST,0)
  1. S XDRDTEST("FILE")=$S('$P(XDRDTEST(XDRDORD),U,4):XDRFL,1:$P(XDRDTEST(XDRDORD),U,4))
  1. 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)_";")
  1. K XDRDTST,XDRDTEST("FILE")
  1. Q