VAQDIS10 ;ALB/JFP - DISPLAY,REQUEST PDX BY PATIENT;01APR93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
INIT ; -- Intialization
D ^VAQUTL98
;
N POP,DFN,VAQIN,VAQDFN,X,Y
;
S:'$D(VAQOPT) VAQOPT="" ; -- should be set from menu option
MAIN ; -- Main entry point
K BADSSN,FLE,FLD ; -- table entries
K DIROUT,DIRUT,DTOUT,DUOUT
S POP=0
;
; -- Call to Dir to request patient from patient file (2)
S DIR("A")="Identify PDX: "
S DIR(0)="FAO^1:30^K:(X'=$C(32)&($L(X)<3)) X"
S DIR("?")="Enter Patient's Name (Last,First Middle) or SSN or Transaction #"
S DIR("??")="^D HLPTRN1^VAQLED09"
W !! D ^DIR K DIR G:$D(DIRUT) EXIT
S (X,VAQIN)=Y
;
; -- Function call to get patient from transaction file (DIC)
D:$D(XRTL) T0^%ZOSV ; -- Capacity start
S VAQDFN=$$GETTRN^VAQUTL96(X)
S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; -- Capacity stop
D:VAQDFN=-1 PTNFND ; -- patient not in transaction file
G:POP MLOOP
D EP^VAQDIS11 ; -- Call to list processor (selection screen)
MLOOP G MAIN ; -- loop back until no more patient added
;
PTNFND ; -- Requested PDX not found
W !,"Patient not found in PDX transaction file..."
S POP=1
QUIT
;
EXIT ; -- Cleanup and exit routine
K BADSSN,FLE,FLD ; -- table entries
K DIROUT,DIRUT,DTOUT,DUOUT
K VAQOPT
QUIT
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDIS10 1325 printed Sep 23, 2025@20:00:56 Page 2
VAQDIS10 ;ALB/JFP - DISPLAY,REQUEST PDX BY PATIENT;01APR93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
INIT ; -- Intialization
+1 DO ^VAQUTL98
+2 ;
+3 NEW POP,DFN,VAQIN,VAQDFN,X,Y
+4 ;
+5 ; -- should be set from menu option
if '$DATA(VAQOPT)
SET VAQOPT=""
MAIN ; -- Main entry point
+1 ; -- table entries
KILL BADSSN,FLE,FLD
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT
+3 SET POP=0
+4 ;
+5 ; -- Call to Dir to request patient from patient file (2)
+6 SET DIR("A")="Identify PDX: "
+7 SET DIR(0)="FAO^1:30^K:(X'=$C(32)&($L(X)<3)) X"
+8 SET DIR("?")="Enter Patient's Name (Last,First Middle) or SSN or Transaction #"
+9 SET DIR("??")="^D HLPTRN1^VAQLED09"
+10 WRITE !!
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+11 SET (X,VAQIN)=Y
+12 ;
+13 ; -- Function call to get patient from transaction file (DIC)
+14 ; -- Capacity start
if $DATA(XRTL)
DO T0^%ZOSV
+15 SET VAQDFN=$$GETTRN^VAQUTL96(X)
+16 ; -- Capacity stop
if $DATA(XRT0)
SET XRTN=$TEXT(+0)
if $DATA(XRT0)
DO T1^%ZOSV
+17 ; -- patient not in transaction file
if VAQDFN=-1
DO PTNFND
+18 if POP
GOTO MLOOP
+19 ; -- Call to list processor (selection screen)
DO EP^VAQDIS11
MLOOP ; -- loop back until no more patient added
GOTO MAIN
+1 ;
PTNFND ; -- Requested PDX not found
+1 WRITE !,"Patient not found in PDX transaction file..."
+2 SET POP=1
+3 QUIT
+4 ;
EXIT ; -- Cleanup and exit routine
+1 ; -- table entries
KILL BADSSN,FLE,FLD
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT
+3 KILL VAQOPT
+4 QUIT
+5 ;
END ; -- End of code
+1 QUIT
