VAQEXT02 ;ALB/JFP - PDX, PROCESS EXTERNAL (MANUAL),PROCESS SCREEN;01MAR93
;;1.5;PATIENT DATA EXCHANGE;**1,10,14**;NOV 17, 1993
EP ; -- Main entry point for the list processor
; -- K XQORS,VALMEVL ;(only kill on the first screen in)
D EN^VALM("VAQ PROCESS PDX4")
N VALMCNT S VALMCNT=0
QUIT
;
INIT ; -- Builds array of Patients based on PDX transactions for manual
; processing
;
K ^TMP("VAQR4",$J),^TMP("VAQR4","VAQIDX",$J)
N VAQST,VAQFLAG,VAQCMNT,VAQDFN,VAQECNT
N VADM,VA,VAERR
;
S (VAQECNT,VALMCNT)=0,(VAQDFN,DFN)=""
F S DFN=$O(DPTD(DFN)) Q:DFN="" D
.S VAQECNT=VAQECNT+1
.D DEM^VADPT
.S X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")
.S X=$$SETFLD^VALM1(VADM(1),X,"LOCAL PATIENT NAME")
.S X=$$SETFLD^VALM1($P(VADM(2),U,2),X,"SSN")
.S VA("DOB")=$$DOBFMT^VAQUTL99($P(VADM(3),U,1))
.S X=$$SETFLD^VALM1(VA("DOB"),X,"DOB")
.S X=$$SETFLD^VALM1(VA("PID"),X,"PID")
.D TMP
QUIT
;
TMP ; -- Set the array used by list processor
S VALMCNT=VALMCNT+1
S ^TMP("VAQR4",$J,VALMCNT,0)=$E(X,1,79)
S ^TMP("VAQR4",$J,"IDX",VALMCNT,VAQECNT)=""
S ^TMP("VAQR4","VAQIDX",$J,VAQECNT)=VALMCNT_"^"_VAQTRDE_"^"_DFN
Q
;
HD ; -- Make header line for list processor
Q:'$D(VALMY)
HD1 N X,SP50
S SP50=$J("",50)
S X=$$SETSTR^VALM1("Remote Patient: "_VAQPTNM,"",1,41)
S:VAQPTID="" X=$$SETSTR^VALM1("SSN: "_VAQESSN,X,42,17)
S:VAQPTID'="" X=$$SETSTR^VALM1(" ID: "_VAQPTID,X,42,17)
S X=$$SETSTR^VALM1(" DOB: "_VAQEDOB,X,59,20)
S VALMHDR(1)=" "
S VALMHDR(2)=X
S VALMHDR(3)=" "
QUIT
;
REJ ; -- Reject PDX with comment
S VAQST="REJ",VAQFLAG=0,VAQCMNT="Reject "
D CLEAR^VALM1
S:'$D(VAQSIG) VAQSIG=$$VRFYUSER^VAQAUT(DUZ) ; -- Signature
I VAQSIG<0 K VAQSIG D TRANEX QUIT
D EP^VAQREQ08 ; -- Comment for reject
D EP^VAQEXT03
D TRANEX
QUIT
;
REL ; -- Release PDX with comment
D SEL^VALM2
Q:'$D(VALMY)
N ENT S ENT=$O(VALMY(""))
S DFN=$P(^TMP("VAQR4","VAQIDX",$J,ENT),"^",3)
S VAQFLAG=0,VAQST="REL",VAQCMNT="Release "
D CLEAR^VALM1
S:'$D(VAQSIG) VAQSIG=$$VRFYUSER^VAQAUT(DUZ) ; -- Signature
I VAQSIG<0 K VAQSIG D TRANEX QUIT
D EP^VAQREQ08 ; -- Comment for reject
D EP^VAQEXT03 ; --
D TRANEX
QUIT
;
NFND ; -- Not found (reject)
D CLEAR^VALM1 ;clears screen
S DIR(0)="Y",DIR("B")="YES"
S DIR("A")="Requested patient not found...Process as not found"
D ^DIR K DIR
I ('Y)!($D(DUOUT))!($D(DTOUT)) S VALMBCK="Q" QUIT
S:'$D(VAQSIG) VAQSIG=$$VRFYUSER^VAQAUT(DUZ) ; -- Signature
I VAQSIG<0 K VAQSIG D TRANEX QUIT
S:'$D(DFN) DFN=""
S VAQST="NFND"
D:Y EP^VAQEXT03
D TRANEX
QUIT
;
EXP ; -- Expand entry
D SEL^VALM2
Q:'$D(VALMY)
N ENT S ENT=$O(VALMY(""))
S DFN=$P(^TMP("VAQR4","VAQIDX",$J,ENT),"^",3)
D EP^VAQDIS01
S VALMBCK="R"
QUIT
;
TRANEX ; -- Pauses screen
D PAUSE^VAQUTL95
S:'$D(VAQFLAG) VAQFLAG=""
S VALMBCK=$S(VAQFLAG=0:"R",1:"Q")
QUIT
;
EXIT ; -- Note: The list processor cleans up its own variables.
; All other variables cleaned up here.
;
K ^TMP("VAQR4",$J),^TMP("VAQR4","VAQIDX",$J)
K VAQST,VAQFLAG,VAQCMNT,VAQDFN,VAQECNT
K VALMCNT,VADM,SP50,DFN
Q
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQEXT02 3144 printed Dec 13, 2024@02:25:40 Page 2
VAQEXT02 ;ALB/JFP - PDX, PROCESS EXTERNAL (MANUAL),PROCESS SCREEN;01MAR93
+1 ;;1.5;PATIENT DATA EXCHANGE;**1,10,14**;NOV 17, 1993
EP ; -- Main entry point for the list processor
+1 ; -- K XQORS,VALMEVL ;(only kill on the first screen in)
+2 DO EN^VALM("VAQ PROCESS PDX4")
+3 NEW VALMCNT
SET VALMCNT=0
+4 QUIT
+5 ;
INIT ; -- Builds array of Patients based on PDX transactions for manual
+1 ; processing
+2 ;
+3 KILL ^TMP("VAQR4",$JOB),^TMP("VAQR4","VAQIDX",$JOB)
+4 NEW VAQST,VAQFLAG,VAQCMNT,VAQDFN,VAQECNT
+5 NEW VADM,VA,VAERR
+6 ;
+7 SET (VAQECNT,VALMCNT)=0
SET (VAQDFN,DFN)=""
+8 FOR
SET DFN=$ORDER(DPTD(DFN))
if DFN=""
QUIT
Begin DoDot:1
+9 SET VAQECNT=VAQECNT+1
+10 DO DEM^VADPT
+11 SET X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")
+12 SET X=$$SETFLD^VALM1(VADM(1),X,"LOCAL PATIENT NAME")
+13 SET X=$$SETFLD^VALM1($PIECE(VADM(2),U,2),X,"SSN")
+14 SET VA("DOB")=$$DOBFMT^VAQUTL99($PIECE(VADM(3),U,1))
+15 SET X=$$SETFLD^VALM1(VA("DOB"),X,"DOB")
+16 SET X=$$SETFLD^VALM1(VA("PID"),X,"PID")
+17 DO TMP
End DoDot:1
+18 QUIT
+19 ;
TMP ; -- Set the array used by list processor
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("VAQR4",$JOB,VALMCNT,0)=$EXTRACT(X,1,79)
+3 SET ^TMP("VAQR4",$JOB,"IDX",VALMCNT,VAQECNT)=""
+4 SET ^TMP("VAQR4","VAQIDX",$JOB,VAQECNT)=VALMCNT_"^"_VAQTRDE_"^"_DFN
+5 QUIT
+6 ;
HD ; -- Make header line for list processor
+1 if '$DATA(VALMY)
QUIT
HD1 NEW X,SP50
+1 SET SP50=$JUSTIFY("",50)
+2 SET X=$$SETSTR^VALM1("Remote Patient: "_VAQPTNM,"",1,41)
+3 if VAQPTID=""
SET X=$$SETSTR^VALM1("SSN: "_VAQESSN,X,42,17)
+4 if VAQPTID'=""
SET X=$$SETSTR^VALM1(" ID: "_VAQPTID,X,42,17)
+5 SET X=$$SETSTR^VALM1(" DOB: "_VAQEDOB,X,59,20)
+6 SET VALMHDR(1)=" "
+7 SET VALMHDR(2)=X
+8 SET VALMHDR(3)=" "
+9 QUIT
+10 ;
REJ ; -- Reject PDX with comment
+1 SET VAQST="REJ"
SET VAQFLAG=0
SET VAQCMNT="Reject "
+2 DO CLEAR^VALM1
+3 ; -- Signature
if '$DATA(VAQSIG)
SET VAQSIG=$$VRFYUSER^VAQAUT(DUZ)
+4 IF VAQSIG<0
KILL VAQSIG
DO TRANEX
QUIT
+5 ; -- Comment for reject
DO EP^VAQREQ08
+6 DO EP^VAQEXT03
+7 DO TRANEX
+8 QUIT
+9 ;
REL ; -- Release PDX with comment
+1 DO SEL^VALM2
+2 if '$DATA(VALMY)
QUIT
+3 NEW ENT
SET ENT=$ORDER(VALMY(""))
+4 SET DFN=$PIECE(^TMP("VAQR4","VAQIDX",$JOB,ENT),"^",3)
+5 SET VAQFLAG=0
SET VAQST="REL"
SET VAQCMNT="Release "
+6 DO CLEAR^VALM1
+7 ; -- Signature
if '$DATA(VAQSIG)
SET VAQSIG=$$VRFYUSER^VAQAUT(DUZ)
+8 IF VAQSIG<0
KILL VAQSIG
DO TRANEX
QUIT
+9 ; -- Comment for reject
DO EP^VAQREQ08
+10 ; --
DO EP^VAQEXT03
+11 DO TRANEX
+12 QUIT
+13 ;
NFND ; -- Not found (reject)
+1 ;clears screen
DO CLEAR^VALM1
+2 SET DIR(0)="Y"
SET DIR("B")="YES"
+3 SET DIR("A")="Requested patient not found...Process as not found"
+4 DO ^DIR
KILL DIR
+5 IF ('Y)!($DATA(DUOUT))!($DATA(DTOUT))
SET VALMBCK="Q"
QUIT
+6 ; -- Signature
if '$DATA(VAQSIG)
SET VAQSIG=$$VRFYUSER^VAQAUT(DUZ)
+7 IF VAQSIG<0
KILL VAQSIG
DO TRANEX
QUIT
+8 if '$DATA(DFN)
SET DFN=""
+9 SET VAQST="NFND"
+10 if Y
DO EP^VAQEXT03
+11 DO TRANEX
+12 QUIT
+13 ;
EXP ; -- Expand entry
+1 DO SEL^VALM2
+2 if '$DATA(VALMY)
QUIT
+3 NEW ENT
SET ENT=$ORDER(VALMY(""))
+4 SET DFN=$PIECE(^TMP("VAQR4","VAQIDX",$JOB,ENT),"^",3)
+5 DO EP^VAQDIS01
+6 SET VALMBCK="R"
+7 QUIT
+8 ;
TRANEX ; -- Pauses screen
+1 DO PAUSE^VAQUTL95
+2 if '$DATA(VAQFLAG)
SET VAQFLAG=""
+3 SET VALMBCK=$SELECT(VAQFLAG=0:"R",1:"Q")
+4 QUIT
+5 ;
EXIT ; -- Note: The list processor cleans up its own variables.
+1 ; All other variables cleaned up here.
+2 ;
+3 KILL ^TMP("VAQR4",$JOB),^TMP("VAQR4","VAQIDX",$JOB)
+4 KILL VAQST,VAQFLAG,VAQCMNT,VAQDFN,VAQECNT
+5 KILL VALMCNT,VADM,SP50,DFN
+6 QUIT
+7 ;
END ; -- End of code
+1 QUIT
