- 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
