- XDRDLIST ;SF-IRMFO/IHS/OHPRD/JCM - PRINT POTENTIAL AND VERIFIED DUPLICATES; [ 08/13/92 09:50 AM ] ;8/28/08 18:13
- ;;7.3;TOOLKIT;**23,113**;Apr 25, 1995;Build 9
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;;
- N XDRFL,XDRFLD
- START ;
- S XDRQFLG=0
- ; XT*7.3*113 input variable XDRNOPT to FILE^XDRDQUE-if UNDEF, allows PATIENT file to be selected
- N XDRNOPT
- ;W !!,"Choose type of list."
- S DIR("?")="BRIEF prints the fields: RECORD1, RECORD2 and the IEN for each entry. CAPTIONED is FileMan's CAPTIONED format."
- S DIR("A")="Choose type of list",DIR(0)="SO^1:BRIEF;2:CAPTIONED" D ^DIR K DIR G:$D(DIRUT) END
- S XDRFLD=Y
- I '$D(XDRFL) S DIC("A")="Select File you wish to list for: " D FILE^XDRDQUE G:XDRQFLG END
- D ASK G:XDRQFLG END ; Asks which type of listing you want
- D @$S(XDRDLIST("ASK")=1:"POT",XDRDLIST("ASK")=2:"NOT",XDRDLIST("ASK")=3:"VER",1:"MERGED")
- G:'XDRQFLG START
- END D EOJ ; End of job and cleans up variables
- Q ; End of routine
- ;
- ASK ;
- K XDRDLIST("ASK")
- S XDRDLIST("GL")=$S($D(^DIC(XDRFL,0,"GL")):$P(^DIC(XDRFL,0,"GL"),U,2),1:"")
- I XDRDLIST("GL")']"" S XDRQFLG=1 G ASKX
- W !!,"This utility provides reports on verified and unverified potential duplicates."
- WHCH S DIR("A")="report",DIR(0)="SO^1:UNVERIFIED potential duplicates;2:NOT READY TO MERGE VERIFIED duplicates;3:READY TO MERGE VERIFIED duplicates;4:MERGED VERIFIED duplicates" D ^DIR K DIR
- I $D(DIRUT) S XDRQFLG=1 G ASKX
- I Y=" " S XDRQFLG=1 G ASKX
- S XDRDLIST("ASK")=$S(Y=1:1,Y=2:2,Y=3:3,1:4)
- I XDRDLIST("ASK")=1,'$D(^VA(15,"APOT",XDRDLIST("GL"))) W !,"There are no unverified potential duplicates at this time.",$C(7) K XDRDLIST("ASK") G WHCH
- I XDRDLIST("ASK")=3,'$D(^VA(15,"AMRG",XDRDLIST("GL"),1)) W !,"There are no READY TO MERGE verified duplicates at this time.",$C(7) K XDRDLIST("ASK") G WHCH
- I XDRDLIST("ASK")=2,'$D(^VA(15,"AMRG",XDRDLIST("GL"),0)) W !,"There are no NOT READY TO MERGE verified duplicates at this time.",$C(7) K XDRDLIST("ASK") G WHCH
- I XDRDLIST("ASK")=4,'$D(^VA(15,"AFR",XDRDLIST("GL"))) W !,"There are no MERGED VERIFIED duplicates at this time.",$C(7) K XDRDLIST("ASK") G WHCH
- ;
- ASKX ;
- Q
- ;
- POT ;
- S DIC="^VA(15,",L="",FLDS=$S(XDRFLD=1:"[XDR BRIEF LIST]",1:"[CAPTIONED]")
- S BY="[XDR POTENTIAL DUPLICATE LIST]"
- S DIS(0)="I $P($P(^VA(15,D0,0),U),"";"",2)=XDRDLIST(""GL"")"
- S DHD="Unverified Potential Duplicates"
- D EN1^DIP K DIC,DIS,DHD,L,FLDS,BY
- Q
- ;
- VER ;
- S DIC="^VA(15,",L="",FLDS=$S(XDRFLD=1:"[XDR BRIEF LIST]",1:"[CAPTIONED]")
- ;S DIC="^VA(15,",L="",FLDS="[CAPTIONED]"
- S BY="[XDR READY TO MERGE LIST]"
- S DIS(0)="I $P($P(^VA(15,D0,0),U),"";"",2)=XDRDLIST(""GL"")"
- S DHD="Verified Duplicates Ready to Merge"
- D EN1^DIP K DIC,DIS,DHD,L,FLDS,BY
- Q
- ;
- NOT ;
- S DIC="^VA(15,",L="",FLDS=$S(XDRFLD=1:"[XDR BRIEF LIST]",1:"[CAPTIONED]")
- ;S DIC="^VA(15,",L="",FLDS="[CAPTIONED]"
- S BY="[XDR NOT READY TO MERGE LIST]"
- S DIS(0)="I $P($P(^VA(15,D0,0),U),"";"",2)=XDRDLIST(""GL"")"
- S DHD="Verified Duplicates Not Ready to Merge"
- D EN1^DIP K DIC,DIS,DHD,L,FLDS,BY
- Q
- MERGED ;
- S DIC="^VA(15,",L="",FLDS=$S(XDRFLD=1:"[XDR BRIEF LIST]",1:"[XDR MERGED LIST]")
- ;S DIC="^VA(15,",L="",FLDS="[XDR MERGED LIST]"
- S BY="[XDR MERGED LIST]"
- S DIS(0)="I $P($P(^VA(15,D0,0),U),"";"",2)=XDRDLIST(""GL"")"
- S DHD="Verified Duplicates that are Merged"
- D EN1^DIP K DIC,DIS,DHD,L,FLDS,BY
- Q
- EOJ ;
- K XDRDLIST,DIRUT,X,Y,DTOUT,DUOUT,XDRD,XDRFL,XDRQFLG
- Q
- XDRDLIST ;SF-IRMFO/IHS/OHPRD/JCM - PRINT POTENTIAL AND VERIFIED DUPLICATES; [ 08/13/92 09:50 AM ] ;8/28/08 18:13
- +1 ;;7.3;TOOLKIT;**23,113**;Apr 25, 1995;Build 9
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;;
- +4 NEW XDRFL,XDRFLD
- START ;
- +1 SET XDRQFLG=0
- +2 ; XT*7.3*113 input variable XDRNOPT to FILE^XDRDQUE-if UNDEF, allows PATIENT file to be selected
- +3 NEW XDRNOPT
- +4 ;W !!,"Choose type of list."
- +5 SET DIR("?")="BRIEF prints the fields: RECORD1, RECORD2 and the IEN for each entry. CAPTIONED is FileMan's CAPTIONED format."
- +6 SET DIR("A")="Choose type of list"
- SET DIR(0)="SO^1:BRIEF;2:CAPTIONED"
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- GOTO END
- +7 SET XDRFLD=Y
- +8 IF '$DATA(XDRFL)
- SET DIC("A")="Select File you wish to list for: "
- DO FILE^XDRDQUE
- IF XDRQFLG
- GOTO END
- +9 ; Asks which type of listing you want
- DO ASK
- IF XDRQFLG
- GOTO END
- +10 DO @$SELECT(XDRDLIST("ASK")=1:"POT",XDRDLIST("ASK")=2:"NOT",XDRDLIST("ASK")=3:"VER",1:"MERGED")
- +11 IF 'XDRQFLG
- GOTO START
- END ; End of job and cleans up variables
- DO EOJ
- +1 ; End of routine
- QUIT
- +2 ;
- ASK ;
- +1 KILL XDRDLIST("ASK")
- +2 SET XDRDLIST("GL")=$SELECT($DATA(^DIC(XDRFL,0,"GL")):$PIECE(^DIC(XDRFL,0,"GL"),U,2),1:"")
- +3 IF XDRDLIST("GL")']""
- SET XDRQFLG=1
- GOTO ASKX
- +4 WRITE !!,"This utility provides reports on verified and unverified potential duplicates."
- WHCH SET DIR("A")="report"
- SET DIR(0)="SO^1:UNVERIFIED potential duplicates;2:NOT READY TO MERGE VERIFIED duplicates;3:READY TO MERGE VERIFIED duplicates;4:MERGED VERIFIED duplicates"
- DO ^DIR
- KILL DIR
- +1 IF $DATA(DIRUT)
- SET XDRQFLG=1
- GOTO ASKX
- +2 IF Y=" "
- SET XDRQFLG=1
- GOTO ASKX
- +3 SET XDRDLIST("ASK")=$SELECT(Y=1:1,Y=2:2,Y=3:3,1:4)
- +4 IF XDRDLIST("ASK")=1
- IF '$DATA(^VA(15,"APOT",XDRDLIST("GL")))
- WRITE !,"There are no unverified potential duplicates at this time.",$CHAR(7)
- KILL XDRDLIST("ASK")
- GOTO WHCH
- +5 IF XDRDLIST("ASK")=3
- IF '$DATA(^VA(15,"AMRG",XDRDLIST("GL"),1))
- WRITE !,"There are no READY TO MERGE verified duplicates at this time.",$CHAR(7)
- KILL XDRDLIST("ASK")
- GOTO WHCH
- +6 IF XDRDLIST("ASK")=2
- IF '$DATA(^VA(15,"AMRG",XDRDLIST("GL"),0))
- WRITE !,"There are no NOT READY TO MERGE verified duplicates at this time.",$CHAR(7)
- KILL XDRDLIST("ASK")
- GOTO WHCH
- +7 IF XDRDLIST("ASK")=4
- IF '$DATA(^VA(15,"AFR",XDRDLIST("GL")))
- WRITE !,"There are no MERGED VERIFIED duplicates at this time.",$CHAR(7)
- KILL XDRDLIST("ASK")
- GOTO WHCH
- +8 ;
- ASKX ;
- +1 QUIT
- +2 ;
- POT ;
- +1 SET DIC="^VA(15,"
- SET L=""
- SET FLDS=$SELECT(XDRFLD=1:"[XDR BRIEF LIST]",1:"[CAPTIONED]")
- +2 SET BY="[XDR POTENTIAL DUPLICATE LIST]"
- +3 SET DIS(0)="I $P($P(^VA(15,D0,0),U),"";"",2)=XDRDLIST(""GL"")"
- +4 SET DHD="Unverified Potential Duplicates"
- +5 DO EN1^DIP
- KILL DIC,DIS,DHD,L,FLDS,BY
- +6 QUIT
- +7 ;
- VER ;
- +1 SET DIC="^VA(15,"
- SET L=""
- SET FLDS=$SELECT(XDRFLD=1:"[XDR BRIEF LIST]",1:"[CAPTIONED]")
- +2 ;S DIC="^VA(15,",L="",FLDS="[CAPTIONED]"
- +3 SET BY="[XDR READY TO MERGE LIST]"
- +4 SET DIS(0)="I $P($P(^VA(15,D0,0),U),"";"",2)=XDRDLIST(""GL"")"
- +5 SET DHD="Verified Duplicates Ready to Merge"
- +6 DO EN1^DIP
- KILL DIC,DIS,DHD,L,FLDS,BY
- +7 QUIT
- +8 ;
- NOT ;
- +1 SET DIC="^VA(15,"
- SET L=""
- SET FLDS=$SELECT(XDRFLD=1:"[XDR BRIEF LIST]",1:"[CAPTIONED]")
- +2 ;S DIC="^VA(15,",L="",FLDS="[CAPTIONED]"
- +3 SET BY="[XDR NOT READY TO MERGE LIST]"
- +4 SET DIS(0)="I $P($P(^VA(15,D0,0),U),"";"",2)=XDRDLIST(""GL"")"
- +5 SET DHD="Verified Duplicates Not Ready to Merge"
- +6 DO EN1^DIP
- KILL DIC,DIS,DHD,L,FLDS,BY
- +7 QUIT
- MERGED ;
- +1 SET DIC="^VA(15,"
- SET L=""
- SET FLDS=$SELECT(XDRFLD=1:"[XDR BRIEF LIST]",1:"[XDR MERGED LIST]")
- +2 ;S DIC="^VA(15,",L="",FLDS="[XDR MERGED LIST]"
- +3 SET BY="[XDR MERGED LIST]"
- +4 SET DIS(0)="I $P($P(^VA(15,D0,0),U),"";"",2)=XDRDLIST(""GL"")"
- +5 SET DHD="Verified Duplicates that are Merged"
- +6 DO EN1^DIP
- KILL DIC,DIS,DHD,L,FLDS,BY
- +7 QUIT
- EOJ ;
- +1 KILL XDRDLIST,DIRUT,X,Y,DTOUT,DUOUT,XDRD,XDRFL,XDRQFLG
- +2 QUIT
