XDRDSCOR.m

XDRDSCOR ;IHS/OHPRD/JCM - SETS SCORES FOR DUPLICATE CHECKING;   [ 08/13/92  09:50 AM ]

 ;;7.3;TOOLKIT;;Apr 25, 1995

START ;

 S XDRQFLG=0

 I '$D(XDRFL)!('$D(XDRD(0))) D FILE^XDRDQUE G:XDRQFLG END

 S XDRDSCOR("PDT%")=$P(XDRD(0),U,15)

 S:$P(XDRD(0),U,18) XDRDSCOR("VDT%")=$P(XDRD(0),U,18)

 I '$O(^VA(15.1,XDRFL,11,0)) S XDRERR=3 D ^XDREMSG G END

 F XDRDORD=0:0 S XDRDORD=$O(^VA(15.1,XDRFL,11,"AO",XDRDORD)) Q:'XDRDORD  D TEST

END ;

 K XDRDORD

 Q

 ;

TEST ;

 S XDRDTST=$O(^VA(15.1,XDRFL,11,"AO",XDRDORD,0))

 S XDRDTEST(XDRDORD)=^VA(15.1,XDRFL,11,XDRDTST,0)

 S XDRDTEST("FILE")=$S('$P(XDRDTEST(XDRDORD),U,4):XDRFL,1:$P(XDRDTEST(XDRDORD),U,4))

 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)_";")

 K XDRDTST,XDRDTEST("FILE")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XDRDSCOR   857     printed  Apr 09, 2024@21:43:10                                                                                                                                                                                                     Page 2

XDRDSCOR  ;IHS/OHPRD/JCM - SETS SCORES FOR DUPLICATE CHECKING;   [ 08/13/92  09:50 AM ]

 +1       ;;7.3;TOOLKIT;;Apr 25, 1995

START     ;

 +1        SET XDRQFLG=0

 +2        IF '$DATA(XDRFL)!('$DATA(XDRD(0)))

               DO FILE^XDRDQUE

               if XDRQFLG

                   GOTO END

 +3        SET XDRDSCOR("PDT%")=$PIECE(XDRD(0),U,15)

 +4        if $PIECE(XDRD(0),U,18)

               SET XDRDSCOR("VDT%")=$PIECE(XDRD(0),U,18)

 +5        IF '$ORDER(^VA(15.1,XDRFL,11,0))

               SET XDRERR=3

               DO ^XDREMSG

               GOTO END

 +6        FOR XDRDORD=0:0

               SET XDRDORD=$ORDER(^VA(15.1,XDRFL,11,"AO",XDRDORD))

               if 'XDRDORD

                   QUIT 

               DO TEST

END       ;

 +1        KILL XDRDORD

 +2        QUIT 

 +3       ;

TEST      ;

 +1        SET XDRDTST=$ORDER(^VA(15.1,XDRFL,11,"AO",XDRDORD,0))

 +2        SET XDRDTEST(XDRDORD)=^VA(15.1,XDRFL,11,XDRDTST,0)

 +3        SET XDRDTEST("FILE")=$SELECT('$PIECE(XDRDTEST(XDRDORD),U,4):XDRFL,1:$PIECE(XDRDTEST(XDRDORD),U,4))

 +4        SET XDRDSCOR("DR",XDRDTEST("FILE"))=$SELECT($DATA(XDRDSCOR("DR",XDRDTEST("FILE"))):XDRDSCOR("DR",XDRDTEST("FILE"))_$PIECE(XDRDTEST(XDRDORD),U,5)_";",1:$PIECE(XDRDTEST(XDRDORD),U,5)_";")

 +5        KILL XDRDTST,XDRDTEST("FILE")

 +6        QUIT