- 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 ---[H[J[2J[HXDRDSCOR 857 printed Jan 18, 2025@03:40:21 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