Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAQLED10

VAQLED10.m

Go to the documentation of this file.
  1. VAQLED10 ;ALB/JFP - LOAD/EDIT PDX RECORD, PROMPT PDX;01APR93
  1. ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
  1. INIT ; -- Intialization
  1. D ^VAQUTL98
  1. ;
  1. N POP,DFN
  1. ;
  1. S:'$D(VAQOPT) VAQOPT="" ; -- should be set from menu option
  1. MAIN ; -- Main entry point
  1. K POP,DFN,X,Y,ND,NODE
  1. K BADSSN,FLE,FLD ; -- table entries
  1. K DIROUT,DIRUT,DTOUT,DUOUT
  1. K VAQIN,VAQDFN,VAQPTNM,VAQISSN,VAQIDOB,VAQEDOB,VAQPTID,VAQESSN
  1. S POP=0
  1. ;
  1. ; -- Call to Dir to request patient from patient file (2)
  1. S DIR("A")="Identify PDX: "
  1. S DIR(0)="FAO^1:30^K:(X'=$C(32)&($L(X)<3)) X"
  1. S DIR("?")="Enter Patient's Name (Last,First Middle) or SSN or Transaction #"
  1. S DIR("??")="^D HLPTRN1^VAQLED09"
  1. W !! D ^DIR K DIR G:$D(DIRUT) EXIT
  1. S (X,VAQIN)=Y
  1. ;
  1. ; -- Function call to get patient from transaction file (DIC)
  1. S VAQDFN=$$GETTRN^VAQUTL96(X)
  1. D:VAQDFN=-1 PTNFND ; -- patient not in transaction file
  1. G:POP MLOOP
  1. D:VAQDFN>0 HEADER ; -- builds variables for header
  1. D EP^VAQLED01 ; -- Call to list processor (status screen)
  1. MLOOP G MAIN ; -- loop back until no more patient added
  1. ;
  1. PTNFND ; -- Requested PDX not found
  1. W !,"Patient not found in PDX transaction file..."
  1. S POP=1
  1. QUIT
  1. ;
  1. ;W !,"VAQDFN = ",VAQDFN
  1. F ND=0,"QRY" S NODE(ND)=$G(^VAT(394.61,+VAQDFN,ND))
  1. S VAQPTNM=$P(NODE("QRY"),U,1),VAQISSN=$P(NODE("QRY"),U,2)
  1. S VAQESSN=$$DASHSSN^VAQUTL99(VAQISSN)
  1. S VAQIDOB=$P(NODE("QRY"),U,3),VAQEDOB=$$DOBFMT^VAQUTL99(VAQIDOB)
  1. S VAQPTID=$P(NODE("QRY"),U,4)
  1. QUIT
  1. ;
  1. EXIT ; -- Cleanup and exit routine
  1. K POP,DFN,X,Y,ND,NODE
  1. K BADSSN,FLE,FLD ; -- table entries
  1. K DIROUT,DIRUT,DTOUT,DUOUT
  1. K VAQIN,VAQDFN,VAQPTNM,VAQISSN,VAQIDOB,VAQEDOB,VAQPTID,VAQOPT,VAQESSN
  1. QUIT
  1. ;
  1. END ; -- End of code
  1. QUIT