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

PXCEHIST.m

Go to the documentation of this file. 
  1. PXCEHIST ;ISL/dee - Used to add an historical visit and display a visit ;9/5/96
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,22**;Aug 12, 1996
  1.  ;; ;
  1.  Q
  1.  ;
  1.  ;Line with the line label "FORMAT"
  1.  ;;Long name~File Number~Node Subscripts~Allow Duplicate entries (not used on visit)~File global name
  1.  ;     1         2             3                   4                                        5
  1.  ;
  1.  ;Following lines:
  1.  ;;Node~Piece~,Field Number~Edit Label~Display Label~Display Routine~Edit Routine~Help Text for DIR("?")~Set of PXCEKEYS that can Edit~D if Detail Display Only~
  1.  ;  1  ~  2  ~      3      ~     4    ~        5    ~        6      ~     7      ~       8              ~          9                  ~       10
  1.  ;The Display & Edit routines are for special cases.
  1.  ;
  1. FORMAT ;;Historical Encounter~9000010~0,21,150,800,811,812~~^AUPNVSIT
  1.  ;;0~1~.01~Encounter Date and (optional) Time:  ~Encounter Date and Time:  ~~EVISITDT^PXCEHIST(-1)~~~B
  1.  ;;0~5~.05~Patient Name:  ~Patient Name:  ~~EPAT^PXCEVSIT~~~D
  1.  ;;0~6~.06~Location of Encounter:  ~Location of Encounter:  ~~ELOC^PXCEHIST~~~D
  1.  ;;811~1~81101~Comment:  ~Comment:  ~~~~~D
  1.  ;;
  1.  ;
  1.  ;********************************
  1.  ;Special cases for display of visit are in PXCEVSIT.
  1.  ;
  1.  ;********************************
  1.  ;Special cases for edit of visit are in PXCEVSIT and below.
  1.  ;
  1. EVISITDT(DTPARM) ;
  1.  I $P(PXCEAFTR(0),"^",1)']"" D
  1.  . D EVISITDT^PXCEVSIT(DTPARM)
  1.  E  S (X,Y)=$P(PXCEAFTR(0),"^",1)
  1.  Q
  1.  ;
  1. ELOC ;Used to edit location of the visit for historical visits
  1.  ;Ask if it is a location outside the VA
  1.  S DIR(0)="YA"
  1.  S DIR("A")="Is this a VA location?  "
  1.  I $P(PXCEAFTR(0),"^",6)]"" S DIR("B")="Y"
  1.  E  I $P(PXCEAFTR(21),"^",1)]"" S DIR("B")="N"
  1.  E  S DIR("B")="N"
  1.  D ^DIR
  1.  K DIR,DA
  1.  I $D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT)=1 Q  ;for visit
  1.  I Y S INOROUT="I" G IN
  1.  E  S INOROUT="O" G OUT
  1.  ;
  1. IN ;This is a va location
  1.  N DIERR,PXCEDILF,PXCEINT,PXCEEXT
  1.  I $P(PXCEAFTR(0),"^",6)'="" S PXCEINT=$P(PXCEAFTR(0),"^",6)
  1.  E  S PXCEINT=+$$SITE^VASITE(+PXCEAFTR(0)) ;default to this site
  1.  S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,.06,"",PXCEINT,"PXCEDILF")
  1.  S DIR("B")=$S('$D(DIERR)&PXCEEXT]"":PXCEEXT,1:PXCEINT)
  1.  S DIR(0)="9000010,.06A"
  1.  S DIR("A")=$P(PXCETEXT,"~",4)
  1.  S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
  1.  D ^DIR
  1.  K DIR,DA
  1.  I X="@" S Y="@"
  1.  E  I $D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT)=1 Q  ;for visit
  1.  ;
  1.  S $P(PXCEAFTR(0),"^",6)=$P(Y,"^")
  1.  S $P(PXCEAFTR(21),"^",1)=""
  1.  S $P(PXCEAFTR(0),"^",3)="V"
  1.  G FINISH
  1.  ;
  1. OUT ;This is a non va location
  1.  I $P(PXCEAFTR(21),"^",1)'="" D
  1.  . S DIR("B")=$P(PXCEAFTR(21),"^",1)
  1.  S DIR(0)="9000010,2101A"
  1.  S DIR("A")="Non VA Location of Encounter?  "
  1.  D ^DIR
  1.  K DIR,DA
  1.  I X="@" S Y="@"
  1.  E  I $D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT)=1 Q  ;for visit
  1.  ;
  1.  S $P(PXCEAFTR(21),"^",1)=$P(Y,"^")
  1.  S $P(PXCEAFTR(0),"^",6)=""
  1.  S $P(PXCEAFTR(0),"^",3)="O"
  1. FINISH ;
  1.  S $P(PXCEAFTR(0),"^",7)="E"
  1.  S $P(PXCEAFTR(0),"^",22)=""
  1.  Q
  1.  ;
  1.  ;********************************
  1.  ;Display text for the .01 field which is a Date and Time.
  1.  ;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.)
  1. DISPLY01(PXCEVSIT) ;
  1.  Q $$DISPLY01^PXCESIT(PXCEVSIT)
  1.  ;