| 1 | XDRPTCAN ;SF-IRMFO/IHS/OHPRD/JCM/JLI ;5/30/97 10:28
|
|---|
| 2 | ;;7.3;TOOLKIT;**23**;Apr 25, 1995
|
|---|
| 3 | ;;
|
|---|
| 4 | ;
|
|---|
| 5 | ; Calls: EN^DIQ1
|
|---|
| 6 | ;
|
|---|
| 7 | START ;
|
|---|
| 8 | K ^TMP("XDRD",$J,XDRFL),XDRDCAN
|
|---|
| 9 | Q:$P(^DPT(XDRCD,0),U,19)
|
|---|
| 10 | D VALUE
|
|---|
| 11 | I $E(XDRDCAN(2,XDRCD,.09,"I"),1,5)="00000" Q
|
|---|
| 12 | D NAME
|
|---|
| 13 | D SSN
|
|---|
| 14 | D DOB
|
|---|
| 15 | END D EOJ
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | VALUE ;
|
|---|
| 19 | S DA=XDRCD K XDRCD S XDRCD=DA
|
|---|
| 20 | N XDRI F XDRI=0:0 S XDRI=$O(XDRDSCOR("DR",XDRI)) Q:XDRI'>0 D
|
|---|
| 21 | . S DIC=XDRI,DA=XDRCD,DIQ(0)="I",DIQ="XDRDCAN",DR=XDRDSCOR("DR",XDRI)
|
|---|
| 22 | . D EN^DIQ1 K DIC,DR,DIQ
|
|---|
| 23 | . M XDRCD=XDRDCAN K DA
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | NAME ;
|
|---|
| 27 | G:XDRDCAN(XDRFL,XDRCD,.01,"I")']"" NAMEX
|
|---|
| 28 | F Q:XDRDCAN(XDRFL,XDRCD,.01,"I")'["MERGING INTO" S XDRDCAN(XDRFL,XDRCD,.01,"I")=$P(XDRDCAN(XDRFL,XDRCD,.01,"I"),"(",2,99),XDRDCAN(XDRFL,XDRCD,.01,"I")=$E(XDRDCAN(XDRFL,XDRCD,.01,"I"),1,$L(XDRDCAN(XDRFL,XDRCD,.01,"I"))-1)
|
|---|
| 29 | S XDRDCAN("NAME")=XDRDCAN(XDRFL,XDRCD,.01,"I")
|
|---|
| 30 | S XDRDCAN("LNAME&FI")=$P(XDRDCAN("NAME"),",",1)_","_$E($P(XDRDCAN("NAME"),",",2),1)_"AAA"
|
|---|
| 31 | S XDRDCAN("BNAME")=XDRDCAN("LNAME&FI")
|
|---|
| 32 | F I=0:0 S XDRDCAN("BNAME")=$O(^DPT("B",XDRDCAN("BNAME"))) Q:XDRDCAN("BNAME")=""!(($P(XDRDCAN("NAME"),",",1)_","_$E($P(XDRDCAN("NAME"),",",2),1))'=($P(XDRDCAN("BNAME"),",",1)_","_$E($P(XDRDCAN("BNAME"),",",2),1))) D
|
|---|
| 33 | . S XDRDCAN("FIND")=XDRCD
|
|---|
| 34 | . F S XDRDCAN("FIND")=$O(^DPT("B",XDRDCAN("BNAME"),XDRDCAN("FIND"))) Q:XDRDCAN("FIND")'>0 S ^TMP("XDRD",$J,XDRFL,XDRDCAN("FIND"))=""
|
|---|
| 35 | . ;S:$O(^DPT("B",XDRDCAN("BNAME"),""))'=XDRCD ^TMP("XDRD",$J,XDRFL,$O(^DPT("B",XDRDCAN("BNAME"),"")))=""
|
|---|
| 36 | . Q
|
|---|
| 37 | NAMEX Q
|
|---|
| 38 | ;
|
|---|
| 39 | SSN ;Get patients with same last four digits of ssn
|
|---|
| 40 | I XDRDCAN(XDRFL,XDRCD,.09,"I")']"" S ^XTMP("XDRERR","BADSSN",XDRCD)="" G SSNX
|
|---|
| 41 | I XDRDCAN(XDRFL,XDRCD,.09,"I")'?9N.E S ^XTMP("XDRERR","BADSSN",XDRCD)="" G SSNX
|
|---|
| 42 | S XDRDCAN("SSN")=XDRDCAN(XDRFL,XDRCD,.09,"I")
|
|---|
| 43 | S XDRDCAN("L4SSN")=$E(XDRDCAN("SSN"),6,9)
|
|---|
| 44 | S XDRDCAN("BL4SSN")=XDRCD
|
|---|
| 45 | F %=0:0 S XDRDCAN("BL4SSN")=$O(^DPT("BS",XDRDCAN("L4SSN"),XDRDCAN("BL4SSN"))) Q:'XDRDCAN("BL4SSN") S ^TMP("XDRD",$J,XDRFL,XDRDCAN("BL4SSN"))=""
|
|---|
| 46 | ;
|
|---|
| 47 | ; Check SSNS with same first five digits
|
|---|
| 48 | ; Commented out the following line, is not specific enough for IHS
|
|---|
| 49 | ; but would be useful for the VA
|
|---|
| 50 | ;
|
|---|
| 51 | ;S XDRDCAN("F5SSN")=$E(XDRDCAN("SSN"),1,5)_"0000",XDRDCAN("5SSN")=XDRDCAN("F5SSN") D
|
|---|
| 52 | ;. F %=0:0 S XDRDCAN("5SSN")=$O(^DPT("SSN",XDRDCAN("5SSN"))) Q:XDRDCAN("5SSN")'=+XDRDCAN("5SSN")!($E(XDRDCAN("5SSN"),1,5)'=$E(XDRDCAN("SSN"),1,5)) S ^TMP("XDRDCAN",$J,XDRFL,$O(^DPT("SSN",XDRDCAN("5SSN"),"")))=""
|
|---|
| 53 | ;. Q
|
|---|
| 54 | SSNX Q
|
|---|
| 55 | ;
|
|---|
| 56 | DOB ;Get patients with same date of birth
|
|---|
| 57 | G:XDRDCAN(XDRFL,XDRCD,.03,"I")']"" DOBX
|
|---|
| 58 | S XDRDCAN("DOB")=XDRDCAN(XDRFL,XDRCD,.03,"I")
|
|---|
| 59 | S XDRDCAN("BDOB")=XDRCD
|
|---|
| 60 | F %=0:0 S XDRDCAN("BDOB")=$O(^DPT("ADOB",XDRDCAN("DOB"),XDRDCAN("BDOB"))) Q:'XDRDCAN("BDOB") S ^TMP("XDRD",$J,XDRFL,XDRDCAN("BDOB"))=""
|
|---|
| 61 | ;
|
|---|
| 62 | ;Transpose day of birth and get patients with same date of birth
|
|---|
| 63 | ;
|
|---|
| 64 | S XDRDCAN("TDOB")=$E(XDRDCAN("DOB"),1,5)_$E(XDRDCAN("DOB"),7)_$E(XDRDCAN("DOB"),6)
|
|---|
| 65 | S XDRDCAN("BDOB")=XDRCD
|
|---|
| 66 | F %=0:0 S XDRDCAN("BDOB")=$O(^DPT("ADOB",XDRDCAN("TDOB"),XDRDCAN("BDOB"))) Q:'XDRDCAN("BDOB") S ^TMP("XDRD",$J,XDRFL,XDRDCAN("BDOB"))=""
|
|---|
| 67 | DOBX Q
|
|---|
| 68 | ;
|
|---|
| 69 | EOJ ;
|
|---|
| 70 | K XDRDCAN,%
|
|---|
| 71 | Q
|
|---|
