| 1 | VAQEXT04 ;ALB/JFP,CMM,JRP - PDX, PROCESS EXTERNAL (MANUAL),PROCESS SCREEN;01MAR93
|
|---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;**10,14,25**;NOV 17, 1993
|
|---|
| 3 | PM ; -- Process remote request, manually
|
|---|
| 4 | K ^TMP("VAQR5",$J)
|
|---|
| 5 | D SEL^VALM2
|
|---|
| 6 | Q:'$D(VALMY)
|
|---|
| 7 | ;COPY VALMY ARRAY INTO TMP GLOBAL (IT'S USED LATER ON)
|
|---|
| 8 | S SDI="" F S SDI=$O(VALMY(SDI)) Q:SDI="" S ^TMP("VAQR5",$J,SDI)=""
|
|---|
| 9 | ;LOOP THROUGH COPY OF VALMY
|
|---|
| 10 | S SDI="" F S SDI=$O(^TMP("VAQR5",$J,SDI)) Q:SDI="" D
|
|---|
| 11 | .S SDAT=$G(^TMP("VAQR3","VAQIDX",$J,SDI))
|
|---|
| 12 | .S VAQTRNO=$P(SDAT,U,2),VAQTRDE=""
|
|---|
| 13 | .S VAQTRDE=$O(^VAT(394.61,"B",VAQTRNO,VAQTRDE))
|
|---|
| 14 | .F ND=0,"QRY" S NODE(ND)=$G(^VAT(394.61,VAQTRDE,ND))
|
|---|
| 15 | .S VAQPTNM=$P(NODE("QRY"),U,1),VAQISSN=$P(NODE("QRY"),U,2)
|
|---|
| 16 | .S VAQESSN=$$DASHSSN^VAQUTL99(VAQISSN)
|
|---|
| 17 | .S VAQIDOB=$P(NODE("QRY"),U,3),VAQEDOB=$$DOBFMT^VAQUTL99(VAQIDOB)
|
|---|
| 18 | .S VAQPTID=$P(NODE("QRY"),U,4)
|
|---|
| 19 | .D FIND
|
|---|
| 20 | S VALMBG=1
|
|---|
| 21 | D INIT^VAQEXT01
|
|---|
| 22 | S VALMBCK="R"
|
|---|
| 23 | K ^TMP("VAQR5",$J)
|
|---|
| 24 | QUIT
|
|---|
| 25 | ;
|
|---|
| 26 | FIND ; -- Looks for match in local data base
|
|---|
| 27 | N DPTD,HSDI,VAQCHK,DFNARR
|
|---|
| 28 | S HSDI=SDI
|
|---|
| 29 | I VAQISSN="" D
|
|---|
| 30 | .S DX=0,DY=VALM("BM")+1 X IOXY W IOEDEOP
|
|---|
| 31 | S VAQDFN=-1
|
|---|
| 32 | ;Look for exact match on SSN
|
|---|
| 33 | S:(VAQISSN'="") VAQDFN=$$GETDFN^VAQUTL97(VAQISSN,1)
|
|---|
| 34 | ;No match found
|
|---|
| 35 | I (VAQDFN<0) D NFND^VAQEXT02 S SDI=HSDI Q
|
|---|
| 36 | ;Exact match found
|
|---|
| 37 | S DFN=$P(VAQDFN,U,1),VAQHDOB=$P(^DPT(DFN,0),U,3)
|
|---|
| 38 | I (VAQHDOB=VAQIDOB)&VAQDFN>0 D Q
|
|---|
| 39 | . S DPTD(DFN)=""
|
|---|
| 40 | . D EP^VAQEXT02
|
|---|
| 41 | . S VAQDFN=1
|
|---|
| 42 | . S SDI=HSDI
|
|---|
| 43 | ;DOB not match but SSN does match - process as not found
|
|---|
| 44 | I (VAQHDOB'=VAQIDOB)&VAQDFN>0 D
|
|---|
| 45 | . D NFND^VAQEXT02 S SDI=HSDI
|
|---|
| 46 | Q
|
|---|
| 47 | ;Dont use code below per request nois id CTX-0597-70919
|
|---|
| 48 | ;Look for possible matches (duplicates)
|
|---|
| 49 | S DFNTR=$P(SDAT,U,2)
|
|---|
| 50 | S VAQCHK=""
|
|---|
| 51 | D EP^VAQLED03
|
|---|
| 52 | S DPTD=+$G(DPTD)
|
|---|
| 53 | ;Include exact lookup on name as possible match
|
|---|
| 54 | S VAQDFN=+$$GETDFN^VAQUTL97(VAQPTNM,1)
|
|---|
| 55 | S:(VAQDFN>0) DPTD=DPTD+1,DPTD(VAQDFN)=""
|
|---|
| 56 | ;No possible matches - process as not found
|
|---|
| 57 | I ('DPTD) D NFND^VAQEXT02 S SDI=HSDI Q
|
|---|
| 58 | ;Possible matches found
|
|---|
| 59 | D EP^VAQEXT02
|
|---|
| 60 | S SDI=HSDI
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | TASK ; -- Load taskman variables and task off
|
|---|
| 64 | S ZTRTN="GENXMIT^VAQADM50",ZTDESC="PDX, MANUAL PROCESS",ZTDTH=$H,ZTIO=""
|
|---|
| 65 | S ZTSAVE("VAQTRN(")=""
|
|---|
| 66 | I ZTRTN'="" D ^%ZTLOAD
|
|---|
| 67 | I '$D(ZTSK) W !,"Error queueing Transaction (manual)...call IRM " D PAUSE^VAQUTL95
|
|---|
| 68 | K ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
|
|---|
| 69 | QUIT
|
|---|
| 70 | ;
|
|---|
| 71 | END ; -- End of code
|
|---|
| 72 | QUIT
|
|---|
