| [613] | 1 | VAQREQ10 ;ALB/JFP - REQUEST PDX RECORD, PROMPT PATIENT;01MAR93
 | 
|---|
 | 2 |  ;;1.5;PATIENT DATA EXCHANGE;**25**;NOV 17, 1993
 | 
|---|
 | 3 |  ; -- Entry Points
 | 
|---|
 | 4 | REQ D KILL^XUSCLEAN S VAQOPT="REQ" G INIT
 | 
|---|
 | 5 | UNS D KILL^XUSCLEAN S VAQOPT="UNS" G INIT
 | 
|---|
 | 6 |  QUIT
 | 
|---|
 | 7 | INIT ; -- Intialization
 | 
|---|
 | 8 |  D ^VAQUTL98
 | 
|---|
 | 9 |  N POP,TASK,DFN
 | 
|---|
 | 10 |  S:'$D(VAQOPT) VAQOPT="" ; -- should be set from entry point
 | 
|---|
 | 11 |  ;
 | 
|---|
 | 12 | MAIN ; -- Main entry point
 | 
|---|
 | 13 |  K VAQDFN,VAQIN,VAQNM,VAQISSN,VAQESSN,VAQIDOB,VAQEDOB,VAQIELG,VAQEELG
 | 
|---|
 | 14 |  K VAQAUSIT,VAQDOM,VAQDZ,VAQNOTI,VAQPID,VAQRQADD,VAQRQDT,VAQRQSIT
 | 
|---|
 | 15 |  K VAQTRN,VAQDZN,VAQPR,DFN
 | 
|---|
 | 16 |  S POP=0
 | 
|---|
 | 17 |  ;
 | 
|---|
 | 18 |  ; -- Call to Dir to request patient from patient file (2)
 | 
|---|
 | 19 |  S DIR("A")="Select Patient Name: "
 | 
|---|
 | 20 |  S DIR(0)="FAO^1:30^S X=$$UP^XLFSTR(X) K:(X'=$C(32)&($L(X)<1)) X"
 | 
|---|
 | 21 |  S DIR("?")="Enter Patient's Name (Last,First Middle) or SSN"
 | 
|---|
 | 22 |  W !! D ^DIR K DIR G:$D(DIRUT) EXIT
 | 
|---|
 | 23 |  S VAQIN=$$UP^XLFSTR(Y)
 | 
|---|
 | 24 |  ;
 | 
|---|
 | 25 |  ; -- Function call to get patient DFN (DIC)
 | 
|---|
 | 26 |  S TASK=$D(ZTSK) ; -- task = 1 (batch), task = 0 interactive
 | 
|---|
 | 27 |  D:$D(XRTL) T0^%ZOSV ; -- Capacity start
 | 
|---|
 | 28 |  S VAQDFN=$$GETDFN^VAQUTL97(VAQIN,TASK)
 | 
|---|
 | 29 |  S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; -- Capacity stop
 | 
|---|
 | 30 |  D:VAQDFN=-1 MANUAL ; -- not in patient file (manual request)
 | 
|---|
 | 31 |  G:POP MLOOP
 | 
|---|
 | 32 |  D:VAQDFN>0 VADPT ; -- pulls off MAS data
 | 
|---|
 | 33 |  D EP^VAQREQ01 ; -- Call to list processor (status screen)
 | 
|---|
 | 34 | MLOOP G MAIN ; -- loop back until no more patient added
 | 
|---|
 | 35 |  ;
 | 
|---|
 | 36 | EXIT ; -- Cleanup and exit routine
 | 
|---|
 | 37 |  K POP,TASK,DFN
 | 
|---|
 | 38 |  K DIROUT,DIRUT,DTOUT,DUOUT,X,Y,BADSSN
 | 
|---|
 | 39 |  K VAQDFN,VAQIN,VAQNM,VAQISSN,VAQESSN,VAQIDOB,VAQEDOB,VAQIELG,VAQEELG
 | 
|---|
 | 40 |  K VAQAUSIT,VAQDOM,VAQDZ,VAQNOTI,VAQPID,VAQOPT,VAQRQADD,VAQRQDT,VAQRQSIT
 | 
|---|
 | 41 |  K VAQTRN,VAQDZN,VAQPR
 | 
|---|
 | 42 |  QUIT
 | 
|---|
 | 43 |  ;
 | 
|---|
 | 44 | MANUAL ; -- Gets Patient name SSN AND DOB if patient not found local PT file
 | 
|---|
 | 45 |  ; -- Don't allow manual entry of unsolicited request
 | 
|---|
 | 46 |  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
 | 
|---|
 | 47 |  ;
 | 
|---|
 | 48 |  ; -- Request data
 | 
|---|
 | 49 |  S VAQEELG="Not Available"
 | 
|---|
 | 50 |  W !,$C(7)
 | 
|---|
 | 51 |  S DIR(0)="Y"
 | 
|---|
 | 52 |  S DIR("A")=VAQIN_" not found in local patient file...  Request PDX"
 | 
|---|
 | 53 |  S DIR("B")="YES"
 | 
|---|
 | 54 |  S DIR("?")="You will be required to enter the needed information."
 | 
|---|
 | 55 |  S DIR("?",1)="Enter 'YES' to request a PDX for a patient not in your Patient File."
 | 
|---|
 | 56 |  D ^DIR K DIR I $D(DIRUT)!('Y) S POP=1 QUIT
 | 
|---|
 | 57 |  ;
 | 
|---|
 | 58 |  ; -- Request patient name
 | 
|---|
 | 59 |  S DIR(0)="FAO^3:30^S X=$$UP^XLFSTR(X) K:(X?1P.E)!(X'?1U.ANP)!(X'["","") X"
 | 
|---|
 | 60 |  S DIR("A")="   Patient name : "
 | 
|---|
 | 61 |  S DIR("B")=VAQIN
 | 
|---|
 | 62 |  S DIR("?")="Enter patient's name in uppercase (LAST,FIRST MIDDLE)"
 | 
|---|
 | 63 |  S DIR("??")="^D PAT^VAQREQ09"
 | 
|---|
 | 64 |  D ^DIR K DIR I $D(DUOUT)!$D(DTOUT) S POP=1 QUIT
 | 
|---|
 | 65 |  S VAQNM=$$UP^XLFSTR(Y)
 | 
|---|
 | 66 |  ;
 | 
|---|
 | 67 |  ; -- Request pt SSN
 | 
|---|
 | 68 |  S DIR(0)="FAO^9:10^K:(X'?9N)&(X'?9N1""P"")!($D(BADSSN(X))) X"
 | 
|---|
 | 69 |  S DIR("A")="   SSN : "
 | 
|---|
 | 70 |  S DIR("?")="Enter patient's SSN (without dashes)"
 | 
|---|
 | 71 |  D ^DIR K DIR I $D(DUOUT)!$D(DTOUT) S POP=1 QUIT
 | 
|---|
 | 72 |  S VAQISSN=Y,VAQESSN=$$DASHSSN^VAQUTL99(Y)
 | 
|---|
 | 73 |  ;
 | 
|---|
 | 74 |  ; -- Checks for name or ssn required
 | 
|---|
 | 75 |  I (VAQNM="")&(VAQISSN="") W !!,"Patient name or SSN is required...Press any key to continue: " S POP=1 R X:DTIME QUIT
 | 
|---|
 | 76 |  ;
 | 
|---|
 | 77 |  ; -- Request pt DOB
 | 
|---|
 | 78 |  S DIR(0)="DAO^::EP"
 | 
|---|
 | 79 |  S DIR("A")="   DATE OF BIRTH : "
 | 
|---|
 | 80 |  S DIR("?")="Enter patient's date of birth"
 | 
|---|
 | 81 |  D ^DIR K DIR I $D(DUOUT)!$D(DTOUT) S POP=1 QUIT
 | 
|---|
 | 82 |  S VAQIDOB=Y,VAQEDOB=$$DOBFMT^VAQUTL99(Y)
 | 
|---|
 | 83 |  QUIT
 | 
|---|
 | 84 |  ;
 | 
|---|
 | 85 | VADPT ; -- Pulls off patient demographics, for DFN
 | 
|---|
 | 86 |  ; -- Gets name,ssn,dob
 | 
|---|
 | 87 |  S DFN=$P(VAQDFN,U,1)
 | 
|---|
 | 88 |  D DEM^VADPT,ELIG^VADPT
 | 
|---|
 | 89 |  S VAQNM=VADM(1)
 | 
|---|
 | 90 |  S VAQISSN=$P(VADM(2),U,1),VAQESSN=$P(VADM(2),U,2)
 | 
|---|
 | 91 |  S VAQIDOB=$P(VADM(3),U,1),VAQEDOB=$P(VADM(3),U,2)
 | 
|---|
 | 92 |  S VAQIELG=$P(VAEL(6),U,1),VAQEELG=$P(VAEL(6),U,2)
 | 
|---|
 | 93 |  K VADM,VAEL,VAERR,VA
 | 
|---|
 | 94 |  QUIT
 | 
|---|
 | 95 |  ;
 | 
|---|
 | 96 | END ; -- End of code
 | 
|---|
 | 97 |  QUIT
 | 
|---|