VAQREQ10 ;ALB/JFP - REQUEST PDX RECORD, PROMPT PATIENT;01MAR93
;;1.5;PATIENT DATA EXCHANGE;**25**;NOV 17, 1993
; -- Entry Points
REQ D KILL^XUSCLEAN S VAQOPT="REQ" G INIT
UNS D KILL^XUSCLEAN S VAQOPT="UNS" G INIT
QUIT
INIT ; -- Intialization
D ^VAQUTL98
N POP,TASK,DFN
S:'$D(VAQOPT) VAQOPT="" ; -- should be set from entry point
;
MAIN ; -- Main entry point
K VAQDFN,VAQIN,VAQNM,VAQISSN,VAQESSN,VAQIDOB,VAQEDOB,VAQIELG,VAQEELG
K VAQAUSIT,VAQDOM,VAQDZ,VAQNOTI,VAQPID,VAQRQADD,VAQRQDT,VAQRQSIT
K VAQTRN,VAQDZN,VAQPR,DFN
S POP=0
;
; -- Call to Dir to request patient from patient file (2)
S DIR("A")="Select Patient Name: "
S DIR(0)="FAO^1:30^S X=$$UP^XLFSTR(X) K:(X'=$C(32)&($L(X)<1)) X"
S DIR("?")="Enter Patient's Name (Last,First Middle) or SSN"
W !! D ^DIR K DIR G:$D(DIRUT) EXIT
S VAQIN=$$UP^XLFSTR(Y)
;
; -- Function call to get patient DFN (DIC)
S TASK=$D(ZTSK) ; -- task = 1 (batch), task = 0 interactive
D:$D(XRTL) T0^%ZOSV ; -- Capacity start
S VAQDFN=$$GETDFN^VAQUTL97(VAQIN,TASK)
S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; -- Capacity stop
D:VAQDFN=-1 MANUAL ; -- not in patient file (manual request)
G:POP MLOOP
D:VAQDFN>0 VADPT ; -- pulls off MAS data
D EP^VAQREQ01 ; -- Call to list processor (status screen)
MLOOP G MAIN ; -- loop back until no more patient added
;
EXIT ; -- Cleanup and exit routine
K POP,TASK,DFN
K DIROUT,DIRUT,DTOUT,DUOUT,X,Y,BADSSN
K VAQDFN,VAQIN,VAQNM,VAQISSN,VAQESSN,VAQIDOB,VAQEDOB,VAQIELG,VAQEELG
K VAQAUSIT,VAQDOM,VAQDZ,VAQNOTI,VAQPID,VAQOPT,VAQRQADD,VAQRQDT,VAQRQSIT
K VAQTRN,VAQDZN,VAQPR
QUIT
;
MANUAL ; -- Gets Patient name SSN AND DOB if patient not found local PT file
; -- Don't allow manual entry of unsolicited request
I VAQOPT="UNS" W !!,"An unsolicited PDX request requires an entry from the patient file...",!,"Press any key to continue: " S POP=1 R X:DTIME QUIT
;
; -- Request data
S VAQEELG="Not Available"
W !,$C(7)
S DIR(0)="Y"
S DIR("A")=VAQIN_" not found in local patient file... Request PDX"
S DIR("B")="YES"
S DIR("?")="You will be required to enter the needed information."
S DIR("?",1)="Enter 'YES' to request a PDX for a patient not in your Patient File."
D ^DIR K DIR I $D(DIRUT)!('Y) S POP=1 QUIT
;
; -- Request patient name
S DIR(0)="FAO^3:30^S X=$$UP^XLFSTR(X) K:(X?1P.E)!(X'?1U.ANP)!(X'["","") X"
S DIR("A")=" Patient name : "
S DIR("B")=VAQIN
S DIR("?")="Enter patient's name in uppercase (LAST,FIRST MIDDLE)"
S DIR("??")="^D PAT^VAQREQ09"
D ^DIR K DIR I $D(DUOUT)!$D(DTOUT) S POP=1 QUIT
S VAQNM=$$UP^XLFSTR(Y)
;
; -- Request pt SSN
S DIR(0)="FAO^9:10^K:(X'?9N)&(X'?9N1""P"")!($D(BADSSN(X))) X"
S DIR("A")=" SSN : "
S DIR("?")="Enter patient's SSN (without dashes)"
D ^DIR K DIR I $D(DUOUT)!$D(DTOUT) S POP=1 QUIT
S VAQISSN=Y,VAQESSN=$$DASHSSN^VAQUTL99(Y)
;
; -- Checks for name or ssn required
I (VAQNM="")&(VAQISSN="") W !!,"Patient name or SSN is required...Press any key to continue: " S POP=1 R X:DTIME QUIT
;
; -- Request pt DOB
S DIR(0)="DAO^::EP"
S DIR("A")=" DATE OF BIRTH : "
S DIR("?")="Enter patient's date of birth"
D ^DIR K DIR I $D(DUOUT)!$D(DTOUT) S POP=1 QUIT
S VAQIDOB=Y,VAQEDOB=$$DOBFMT^VAQUTL99(Y)
QUIT
;
VADPT ; -- Pulls off patient demographics, for DFN
; -- Gets name,ssn,dob
S DFN=$P(VAQDFN,U,1)
D DEM^VADPT,ELIG^VADPT
S VAQNM=VADM(1)
S VAQISSN=$P(VADM(2),U,1),VAQESSN=$P(VADM(2),U,2)
S VAQIDOB=$P(VADM(3),U,1),VAQEDOB=$P(VADM(3),U,2)
S VAQIELG=$P(VAEL(6),U,1),VAQEELG=$P(VAEL(6),U,2)
K VADM,VAEL,VAERR,VA
QUIT
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQREQ10 3625 printed Sep 23, 2025@20:02:29 Page 2
VAQREQ10 ;ALB/JFP - REQUEST PDX RECORD, PROMPT PATIENT;01MAR93
+1 ;;1.5;PATIENT DATA EXCHANGE;**25**;NOV 17, 1993
+2 ; -- Entry Points
REQ DO KILL^XUSCLEAN
SET VAQOPT="REQ"
GOTO INIT
UNS DO KILL^XUSCLEAN
SET VAQOPT="UNS"
GOTO INIT
+1 QUIT
INIT ; -- Intialization
+1 DO ^VAQUTL98
+2 NEW POP,TASK,DFN
+3 ; -- should be set from entry point
if '$DATA(VAQOPT)
SET VAQOPT=""
+4 ;
MAIN ; -- Main entry point
+1 KILL VAQDFN,VAQIN,VAQNM,VAQISSN,VAQESSN,VAQIDOB,VAQEDOB,VAQIELG,VAQEELG
+2 KILL VAQAUSIT,VAQDOM,VAQDZ,VAQNOTI,VAQPID,VAQRQADD,VAQRQDT,VAQRQSIT
+3 KILL VAQTRN,VAQDZN,VAQPR,DFN
+4 SET POP=0
+5 ;
+6 ; -- Call to Dir to request patient from patient file (2)
+7 SET DIR("A")="Select Patient Name: "
+8 SET DIR(0)="FAO^1:30^S X=$$UP^XLFSTR(X) K:(X'=$C(32)&($L(X)<1)) X"
+9 SET DIR("?")="Enter Patient's Name (Last,First Middle) or SSN"
+10 WRITE !!
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+11 SET VAQIN=$$UP^XLFSTR(Y)
+12 ;
+13 ; -- Function call to get patient DFN (DIC)
+14 ; -- task = 1 (batch), task = 0 interactive
SET TASK=$DATA(ZTSK)
+15 ; -- Capacity start
if $DATA(XRTL)
DO T0^%ZOSV
+16 SET VAQDFN=$$GETDFN^VAQUTL97(VAQIN,TASK)
+17 ; -- Capacity stop
if $DATA(XRT0)
SET XRTN=$TEXT(+0)
if $DATA(XRT0)
DO T1^%ZOSV
+18 ; -- not in patient file (manual request)
if VAQDFN=-1
DO MANUAL
+19 if POP
GOTO MLOOP
+20 ; -- pulls off MAS data
if VAQDFN>0
DO VADPT
+21 ; -- Call to list processor (status screen)
DO EP^VAQREQ01
MLOOP ; -- loop back until no more patient added
GOTO MAIN
+1 ;
EXIT ; -- Cleanup and exit routine
+1 KILL POP,TASK,DFN
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT,X,Y,BADSSN
+3 KILL VAQDFN,VAQIN,VAQNM,VAQISSN,VAQESSN,VAQIDOB,VAQEDOB,VAQIELG,VAQEELG
+4 KILL VAQAUSIT,VAQDOM,VAQDZ,VAQNOTI,VAQPID,VAQOPT,VAQRQADD,VAQRQDT,VAQRQSIT
+5 KILL VAQTRN,VAQDZN,VAQPR
+6 QUIT
+7 ;
MANUAL ; -- Gets Patient name SSN AND DOB if patient not found local PT file
+1 ; -- Don't allow manual entry of unsolicited request
+2 IF VAQOPT="UNS"
WRITE !!,"An unsolicited PDX request requires an entry from the patient file...",!,"Press any key to continue: "
SET POP=1
READ X:DTIME
QUIT
+3 ;
+4 ; -- Request data
+5 SET VAQEELG="Not Available"
+6 WRITE !,$CHAR(7)
+7 SET DIR(0)="Y"
+8 SET DIR("A")=VAQIN_" not found in local patient file... Request PDX"
+9 SET DIR("B")="YES"
+10 SET DIR("?")="You will be required to enter the needed information."
+11 SET DIR("?",1)="Enter 'YES' to request a PDX for a patient not in your Patient File."
+12 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!('Y)
SET POP=1
QUIT
+13 ;
+14 ; -- Request patient name
+15 SET DIR(0)="FAO^3:30^S X=$$UP^XLFSTR(X) K:(X?1P.E)!(X'?1U.ANP)!(X'["","") X"
+16 SET DIR("A")=" Patient name : "
+17 SET DIR("B")=VAQIN
+18 SET DIR("?")="Enter patient's name in uppercase (LAST,FIRST MIDDLE)"
+19 SET DIR("??")="^D PAT^VAQREQ09"
+20 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET POP=1
QUIT
+21 SET VAQNM=$$UP^XLFSTR(Y)
+22 ;
+23 ; -- Request pt SSN
+24 SET DIR(0)="FAO^9:10^K:(X'?9N)&(X'?9N1""P"")!($D(BADSSN(X))) X"
+25 SET DIR("A")=" SSN : "
+26 SET DIR("?")="Enter patient's SSN (without dashes)"
+27 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET POP=1
QUIT
+28 SET VAQISSN=Y
SET VAQESSN=$$DASHSSN^VAQUTL99(Y)
+29 ;
+30 ; -- Checks for name or ssn required
+31 IF (VAQNM="")&(VAQISSN="")
WRITE !!,"Patient name or SSN is required...Press any key to continue: "
SET POP=1
READ X:DTIME
QUIT
+32 ;
+33 ; -- Request pt DOB
+34 SET DIR(0)="DAO^::EP"
+35 SET DIR("A")=" DATE OF BIRTH : "
+36 SET DIR("?")="Enter patient's date of birth"
+37 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET POP=1
QUIT
+38 SET VAQIDOB=Y
SET VAQEDOB=$$DOBFMT^VAQUTL99(Y)
+39 QUIT
+40 ;
VADPT ; -- Pulls off patient demographics, for DFN
+1 ; -- Gets name,ssn,dob
+2 SET DFN=$PIECE(VAQDFN,U,1)
+3 DO DEM^VADPT
DO ELIG^VADPT
+4 SET VAQNM=VADM(1)
+5 SET VAQISSN=$PIECE(VADM(2),U,1)
SET VAQESSN=$PIECE(VADM(2),U,2)
+6 SET VAQIDOB=$PIECE(VADM(3),U,1)
SET VAQEDOB=$PIECE(VADM(3),U,2)
+7 SET VAQIELG=$PIECE(VAEL(6),U,1)
SET VAQEELG=$PIECE(VAEL(6),U,2)
+8 KILL VADM,VAEL,VAERR,VA
+9 QUIT
+10 ;
END ; -- End of code
+1 QUIT
