VAQEXT04 ;ALB/JFP,CMM,JRP - PDX, PROCESS EXTERNAL (MANUAL),PROCESS SCREEN;01MAR93
;;1.5;PATIENT DATA EXCHANGE;**10,14,25**;NOV 17, 1993
PM ; -- Process remote request, manually
K ^TMP("VAQR5",$J)
D SEL^VALM2
Q:'$D(VALMY)
;COPY VALMY ARRAY INTO TMP GLOBAL (IT'S USED LATER ON)
S SDI="" F S SDI=$O(VALMY(SDI)) Q:SDI="" S ^TMP("VAQR5",$J,SDI)=""
;LOOP THROUGH COPY OF VALMY
S SDI="" F S SDI=$O(^TMP("VAQR5",$J,SDI)) Q:SDI="" D
.S SDAT=$G(^TMP("VAQR3","VAQIDX",$J,SDI))
.S VAQTRNO=$P(SDAT,U,2),VAQTRDE=""
.S VAQTRDE=$O(^VAT(394.61,"B",VAQTRNO,VAQTRDE))
.F ND=0,"QRY" S NODE(ND)=$G(^VAT(394.61,VAQTRDE,ND))
.S VAQPTNM=$P(NODE("QRY"),U,1),VAQISSN=$P(NODE("QRY"),U,2)
.S VAQESSN=$$DASHSSN^VAQUTL99(VAQISSN)
.S VAQIDOB=$P(NODE("QRY"),U,3),VAQEDOB=$$DOBFMT^VAQUTL99(VAQIDOB)
.S VAQPTID=$P(NODE("QRY"),U,4)
.D FIND
S VALMBG=1
D INIT^VAQEXT01
S VALMBCK="R"
K ^TMP("VAQR5",$J)
QUIT
;
FIND ; -- Looks for match in local data base
N DPTD,HSDI,VAQCHK,DFNARR
S HSDI=SDI
I VAQISSN="" D
.S DX=0,DY=VALM("BM")+1 X IOXY W IOEDEOP
S VAQDFN=-1
;Look for exact match on SSN
S:(VAQISSN'="") VAQDFN=$$GETDFN^VAQUTL97(VAQISSN,1)
;No match found
I (VAQDFN<0) D NFND^VAQEXT02 S SDI=HSDI Q
;Exact match found
S DFN=$P(VAQDFN,U,1),VAQHDOB=$P(^DPT(DFN,0),U,3)
I (VAQHDOB=VAQIDOB)&VAQDFN>0 D Q
. S DPTD(DFN)=""
. D EP^VAQEXT02
. S VAQDFN=1
. S SDI=HSDI
;DOB not match but SSN does match - process as not found
I (VAQHDOB'=VAQIDOB)&VAQDFN>0 D
. D NFND^VAQEXT02 S SDI=HSDI
Q
;Dont use code below per request nois id CTX-0597-70919
;Look for possible matches (duplicates)
S DFNTR=$P(SDAT,U,2)
S VAQCHK=""
D EP^VAQLED03
S DPTD=+$G(DPTD)
;Include exact lookup on name as possible match
S VAQDFN=+$$GETDFN^VAQUTL97(VAQPTNM,1)
S:(VAQDFN>0) DPTD=DPTD+1,DPTD(VAQDFN)=""
;No possible matches - process as not found
I ('DPTD) D NFND^VAQEXT02 S SDI=HSDI Q
;Possible matches found
D EP^VAQEXT02
S SDI=HSDI
Q
;
TASK ; -- Load taskman variables and task off
S ZTRTN="GENXMIT^VAQADM50",ZTDESC="PDX, MANUAL PROCESS",ZTDTH=$H,ZTIO=""
S ZTSAVE("VAQTRN(")=""
I ZTRTN'="" D ^%ZTLOAD
I '$D(ZTSK) W !,"Error queueing Transaction (manual)...call IRM " D PAUSE^VAQUTL95
K ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
QUIT
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQEXT04 2331 printed Mar 13, 2025@21:30:11 Page 2
VAQEXT04 ;ALB/JFP,CMM,JRP - PDX, PROCESS EXTERNAL (MANUAL),PROCESS SCREEN;01MAR93
+1 ;;1.5;PATIENT DATA EXCHANGE;**10,14,25**;NOV 17, 1993
PM ; -- Process remote request, manually
+1 KILL ^TMP("VAQR5",$JOB)
+2 DO SEL^VALM2
+3 if '$DATA(VALMY)
QUIT
+4 ;COPY VALMY ARRAY INTO TMP GLOBAL (IT'S USED LATER ON)
+5 SET SDI=""
FOR
SET SDI=$ORDER(VALMY(SDI))
if SDI=""
QUIT
SET ^TMP("VAQR5",$JOB,SDI)=""
+6 ;LOOP THROUGH COPY OF VALMY
+7 SET SDI=""
FOR
SET SDI=$ORDER(^TMP("VAQR5",$JOB,SDI))
if SDI=""
QUIT
Begin DoDot:1
+8 SET SDAT=$GET(^TMP("VAQR3","VAQIDX",$JOB,SDI))
+9 SET VAQTRNO=$PIECE(SDAT,U,2)
SET VAQTRDE=""
+10 SET VAQTRDE=$ORDER(^VAT(394.61,"B",VAQTRNO,VAQTRDE))
+11 FOR ND=0,"QRY"
SET NODE(ND)=$GET(^VAT(394.61,VAQTRDE,ND))
+12 SET VAQPTNM=$PIECE(NODE("QRY"),U,1)
SET VAQISSN=$PIECE(NODE("QRY"),U,2)
+13 SET VAQESSN=$$DASHSSN^VAQUTL99(VAQISSN)
+14 SET VAQIDOB=$PIECE(NODE("QRY"),U,3)
SET VAQEDOB=$$DOBFMT^VAQUTL99(VAQIDOB)
+15 SET VAQPTID=$PIECE(NODE("QRY"),U,4)
+16 DO FIND
End DoDot:1
+17 SET VALMBG=1
+18 DO INIT^VAQEXT01
+19 SET VALMBCK="R"
+20 KILL ^TMP("VAQR5",$JOB)
+21 QUIT
+22 ;
FIND ; -- Looks for match in local data base
+1 NEW DPTD,HSDI,VAQCHK,DFNARR
+2 SET HSDI=SDI
+3 IF VAQISSN=""
Begin DoDot:1
+4 SET DX=0
SET DY=VALM("BM")+1
XECUTE IOXY
WRITE IOEDEOP
End DoDot:1
+5 SET VAQDFN=-1
+6 ;Look for exact match on SSN
+7 if (VAQISSN'="")
SET VAQDFN=$$GETDFN^VAQUTL97(VAQISSN,1)
+8 ;No match found
+9 IF (VAQDFN<0)
DO NFND^VAQEXT02
SET SDI=HSDI
QUIT
+10 ;Exact match found
+11 SET DFN=$PIECE(VAQDFN,U,1)
SET VAQHDOB=$PIECE(^DPT(DFN,0),U,3)
+12 IF (VAQHDOB=VAQIDOB)&VAQDFN>0
Begin DoDot:1
+13 SET DPTD(DFN)=""
+14 DO EP^VAQEXT02
+15 SET VAQDFN=1
+16 SET SDI=HSDI
End DoDot:1
QUIT
+17 ;DOB not match but SSN does match - process as not found
+18 IF (VAQHDOB'=VAQIDOB)&VAQDFN>0
Begin DoDot:1
+19 DO NFND^VAQEXT02
SET SDI=HSDI
End DoDot:1
+20 QUIT
+21 ;Dont use code below per request nois id CTX-0597-70919
+22 ;Look for possible matches (duplicates)
+23 SET DFNTR=$PIECE(SDAT,U,2)
+24 SET VAQCHK=""
+25 DO EP^VAQLED03
+26 SET DPTD=+$GET(DPTD)
+27 ;Include exact lookup on name as possible match
+28 SET VAQDFN=+$$GETDFN^VAQUTL97(VAQPTNM,1)
+29 if (VAQDFN>0)
SET DPTD=DPTD+1
SET DPTD(VAQDFN)=""
+30 ;No possible matches - process as not found
+31 IF ('DPTD)
DO NFND^VAQEXT02
SET SDI=HSDI
QUIT
+32 ;Possible matches found
+33 DO EP^VAQEXT02
+34 SET SDI=HSDI
+35 QUIT
+36 ;
TASK ; -- Load taskman variables and task off
+1 SET ZTRTN="GENXMIT^VAQADM50"
SET ZTDESC="PDX, MANUAL PROCESS"
SET ZTDTH=$HOROLOG
SET ZTIO=""
+2 SET ZTSAVE("VAQTRN(")=""
+3 IF ZTRTN'=""
DO ^%ZTLOAD
+4 IF '$DATA(ZTSK)
WRITE !,"Error queueing Transaction (manual)...call IRM "
DO PAUSE^VAQUTL95
+5 KILL ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
+6 QUIT
+7 ;
END ; -- End of code
+1 QUIT
