XDRMVFY ;SF-IRMFO/IHS/OHPRD/JCM - VERIFY POTENTIAL DUPLICATES ;09/30/2010
;;7.3;TOOLKIT;**23,126**;Apr 25, 1995;Build 2
;;Per VHA Directive 2004-038, this routine should not be modified.
;;
; Inserted DITC+4-6 IHS/OHPRD/JCM 3/26/91
START ;
D DITC
G:XDRQFLG END
D VERIFY
G:XDRQFLG!(XDRMSTAT="") END
D STATUS
END D EOJ
Q
;
DITC ;
S DIT(1)=XDRMCD,DIT(2)=XDRMCD2,DFF=XDRFL,IOP=IO(0)
D EN^DITC K IOP
I $D(DUOUT)!($D(DTOUT))!($D(DIRUT)) S XDRQFLG=1 K DIRUT,DUOUT,DTOUT
;*********************************
;I $G(DUZ("AG"))="I",'XDRQFLG,XDRFL=2 D ^DPTDZCH ;IHS/OHPRD/JCM 3/26/91
;*********************************
Q
;
VERIFY ; Verifies if duplicate or not.
S XDRMSTAT=""
S DIR(0)="S^V:VERIFIED DUPLICATE;N:VERIFIED, NOT A DUPLICATE;U:UNABLE TO MAKE DETERMINATION"
S DIR("A")="Verification status of potential duplicate pair"
D ^DIR K DIR
I $D(DUOUT)!($D(DTOUT)) S XDRQFLG=1 G VERIFYX
S XDRMSTAT=$S(Y="V":"V",Y="N":"N",1:"")
D:XDRMSTAT="V" VERWARN^XDRRMRG1 ;p126 REM
VERIFYX Q
;
STATUS ;
S DIE="^VA(15,",DA=XDRMPDA,DIE("NO^")=1,DR=".03///"_XDRMSTAT
S:XDRMSTAT="V" XDRMRG=1,DR=DR_";.04//2"
D ^DIE K DIE,DR,DA
Q
;
EOJ ;
K DIT,DFF,IOP,XDRMSTAT,DIRUT
Q
;********************************************
; EN entry point added specifically for APMFVFY for MFI
EN ;
S XDRQFLG=0
D DITC
G:XDRQFLG ENX
D VERIFY
ENX K DIT,DFF,IOP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRMVFY 1400 printed Nov 22, 2024@17:49:33 Page 2
XDRMVFY ;SF-IRMFO/IHS/OHPRD/JCM - VERIFY POTENTIAL DUPLICATES ;09/30/2010
+1 ;;7.3;TOOLKIT;**23,126**;Apr 25, 1995;Build 2
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;;
+4 ; Inserted DITC+4-6 IHS/OHPRD/JCM 3/26/91
START ;
+1 DO DITC
+2 if XDRQFLG
GOTO END
+3 DO VERIFY
+4 if XDRQFLG!(XDRMSTAT="")
GOTO END
+5 DO STATUS
END DO EOJ
+1 QUIT
+2 ;
DITC ;
+1 SET DIT(1)=XDRMCD
SET DIT(2)=XDRMCD2
SET DFF=XDRFL
SET IOP=IO(0)
+2 DO EN^DITC
KILL IOP
+3 IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DIRUT))
SET XDRQFLG=1
KILL DIRUT,DUOUT,DTOUT
+4 ;*********************************
+5 ;I $G(DUZ("AG"))="I",'XDRQFLG,XDRFL=2 D ^DPTDZCH ;IHS/OHPRD/JCM 3/26/91
+6 ;*********************************
+7 QUIT
+8 ;
VERIFY ; Verifies if duplicate or not.
+1 SET XDRMSTAT=""
+2 SET DIR(0)="S^V:VERIFIED DUPLICATE;N:VERIFIED, NOT A DUPLICATE;U:UNABLE TO MAKE DETERMINATION"
+3 SET DIR("A")="Verification status of potential duplicate pair"
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DUOUT)!($DATA(DTOUT))
SET XDRQFLG=1
GOTO VERIFYX
+6 SET XDRMSTAT=$SELECT(Y="V":"V",Y="N":"N",1:"")
+7 ;p126 REM
if XDRMSTAT="V"
DO VERWARN^XDRRMRG1
VERIFYX QUIT
+1 ;
STATUS ;
+1 SET DIE="^VA(15,"
SET DA=XDRMPDA
SET DIE("NO^")=1
SET DR=".03///"_XDRMSTAT
+2 if XDRMSTAT="V"
SET XDRMRG=1
SET DR=DR_";.04//2"
+3 DO ^DIE
KILL DIE,DR,DA
+4 QUIT
+5 ;
EOJ ;
+1 KILL DIT,DFF,IOP,XDRMSTAT,DIRUT
+2 QUIT
+3 ;********************************************
+4 ; EN entry point added specifically for APMFVFY for MFI
EN ;
+1 SET XDRQFLG=0
+2 DO DITC
+3 if XDRQFLG
GOTO ENX
+4 DO VERIFY
ENX KILL DIT,DFF,IOP
+1 QUIT
