XDRMVFY.m

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 ---XDRMVFY   1400     printed  Apr 09, 2024@21:43:20                                                                                                                                                                                                     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