VAQLED10 ;ALB/JFP - LOAD/EDIT PDX RECORD, PROMPT PDX;01APR93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
INIT ; -- Intialization
D ^VAQUTL98
;
N POP,DFN
;
S:'$D(VAQOPT) VAQOPT="" ; -- should be set from menu option
MAIN ; -- Main entry point
K POP,DFN,X,Y,ND,NODE
K BADSSN,FLE,FLD ; -- table entries
K DIROUT,DIRUT,DTOUT,DUOUT
K VAQIN,VAQDFN,VAQPTNM,VAQISSN,VAQIDOB,VAQEDOB,VAQPTID,VAQESSN
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)
S VAQDFN=$$GETTRN^VAQUTL96(X)
D:VAQDFN=-1 PTNFND ; -- patient not in transaction file
G:POP MLOOP
D:VAQDFN>0 HEADER ; -- builds variables for header
D EP^VAQLED01 ; -- Call to list processor (status 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
;
;W !,"VAQDFN = ",VAQDFN
F ND=0,"QRY" S NODE(ND)=$G(^VAT(394.61,+VAQDFN,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)
QUIT
;
EXIT ; -- Cleanup and exit routine
K POP,DFN,X,Y,ND,NODE
K BADSSN,FLE,FLD ; -- table entries
K DIROUT,DIRUT,DTOUT,DUOUT
K VAQIN,VAQDFN,VAQPTNM,VAQISSN,VAQIDOB,VAQEDOB,VAQPTID,VAQOPT,VAQESSN
QUIT
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQLED10 1762 printed Sep 23, 2025@20:01:44 Page 2
VAQLED10 ;ALB/JFP - LOAD/EDIT PDX RECORD, PROMPT PDX;01APR93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
INIT ; -- Intialization
+1 DO ^VAQUTL98
+2 ;
+3 NEW POP,DFN
+4 ;
+5 ; -- should be set from menu option
if '$DATA(VAQOPT)
SET VAQOPT=""
MAIN ; -- Main entry point
+1 KILL POP,DFN,X,Y,ND,NODE
+2 ; -- table entries
KILL BADSSN,FLE,FLD
+3 KILL DIROUT,DIRUT,DTOUT,DUOUT
+4 KILL VAQIN,VAQDFN,VAQPTNM,VAQISSN,VAQIDOB,VAQEDOB,VAQPTID,VAQESSN
+5 SET POP=0
+6 ;
+7 ; -- Call to Dir to request patient from patient file (2)
+8 SET DIR("A")="Identify PDX: "
+9 SET DIR(0)="FAO^1:30^K:(X'=$C(32)&($L(X)<3)) X"
+10 SET DIR("?")="Enter Patient's Name (Last,First Middle) or SSN or Transaction #"
+11 SET DIR("??")="^D HLPTRN1^VAQLED09"
+12 WRITE !!
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+13 SET (X,VAQIN)=Y
+14 ;
+15 ; -- Function call to get patient from transaction file (DIC)
+16 SET VAQDFN=$$GETTRN^VAQUTL96(X)
+17 ; -- patient not in transaction file
if VAQDFN=-1
DO PTNFND
+18 if POP
GOTO MLOOP
+19 ; -- builds variables for header
if VAQDFN>0
DO HEADER
+20 ; -- Call to list processor (status screen)
DO EP^VAQLED01
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 ;
+1 ;W !,"VAQDFN = ",VAQDFN
+2 FOR ND=0,"QRY"
SET NODE(ND)=$GET(^VAT(394.61,+VAQDFN,ND))
+3 SET VAQPTNM=$PIECE(NODE("QRY"),U,1)
SET VAQISSN=$PIECE(NODE("QRY"),U,2)
+4 SET VAQESSN=$$DASHSSN^VAQUTL99(VAQISSN)
+5 SET VAQIDOB=$PIECE(NODE("QRY"),U,3)
SET VAQEDOB=$$DOBFMT^VAQUTL99(VAQIDOB)
+6 SET VAQPTID=$PIECE(NODE("QRY"),U,4)
+7 QUIT
+8 ;
EXIT ; -- Cleanup and exit routine
+1 KILL POP,DFN,X,Y,ND,NODE
+2 ; -- table entries
KILL BADSSN,FLE,FLD
+3 KILL DIROUT,DIRUT,DTOUT,DUOUT
+4 KILL VAQIN,VAQDFN,VAQPTNM,VAQISSN,VAQIDOB,VAQEDOB,VAQPTID,VAQOPT,VAQESSN
+5 QUIT
+6 ;
END ; -- End of code
+1 QUIT
