1 | PXCEHIST ;ISL/dee - Used to add an historical visit and display a visit ;9/5/96
|
---|
2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,22**;Aug 12, 1996
|
---|
3 | ;; ;
|
---|
4 | Q
|
---|
5 | ;
|
---|
6 | ;Line with the line label "FORMAT"
|
---|
7 | ;;Long name~File Number~Node Subscripts~Allow Duplicate entries (not used on visit)~File global name
|
---|
8 | ; 1 2 3 4 5
|
---|
9 | ;
|
---|
10 | ;Following lines:
|
---|
11 | ;;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~
|
---|
12 | ; 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10
|
---|
13 | ;The Display & Edit routines are for special cases.
|
---|
14 | ;
|
---|
15 | FORMAT ;;Historical Encounter~9000010~0,21,150,800,811,812~~^AUPNVSIT
|
---|
16 | ;;0~1~.01~Encounter Date and (optional) Time: ~Encounter Date and Time: ~~EVISITDT^PXCEHIST(-1)~~~B
|
---|
17 | ;;0~5~.05~Patient Name: ~Patient Name: ~~EPAT^PXCEVSIT~~~D
|
---|
18 | ;;0~6~.06~Location of Encounter: ~Location of Encounter: ~~ELOC^PXCEHIST~~~D
|
---|
19 | ;;811~1~81101~Comment: ~Comment: ~~~~~D
|
---|
20 | ;;
|
---|
21 | ;
|
---|
22 | ;********************************
|
---|
23 | ;Special cases for display of visit are in PXCEVSIT.
|
---|
24 | ;
|
---|
25 | ;********************************
|
---|
26 | ;Special cases for edit of visit are in PXCEVSIT and below.
|
---|
27 | ;
|
---|
28 | EVISITDT(DTPARM) ;
|
---|
29 | I $P(PXCEAFTR(0),"^",1)']"" D
|
---|
30 | . D EVISITDT^PXCEVSIT(DTPARM)
|
---|
31 | E S (X,Y)=$P(PXCEAFTR(0),"^",1)
|
---|
32 | Q
|
---|
33 | ;
|
---|
34 | ELOC ;Used to edit location of the visit for historical visits
|
---|
35 | ;Ask if it is a location outside the VA
|
---|
36 | S DIR(0)="YA"
|
---|
37 | S DIR("A")="Is this a VA location? "
|
---|
38 | I $P(PXCEAFTR(0),"^",6)]"" S DIR("B")="Y"
|
---|
39 | E I $P(PXCEAFTR(21),"^",1)]"" S DIR("B")="N"
|
---|
40 | E S DIR("B")="N"
|
---|
41 | D ^DIR
|
---|
42 | K DIR,DA
|
---|
43 | I $D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT)=1 Q ;for visit
|
---|
44 | I Y S INOROUT="I" G IN
|
---|
45 | E S INOROUT="O" G OUT
|
---|
46 | ;
|
---|
47 | IN ;This is a va location
|
---|
48 | N DIERR,PXCEDILF,PXCEINT,PXCEEXT
|
---|
49 | I $P(PXCEAFTR(0),"^",6)'="" S PXCEINT=$P(PXCEAFTR(0),"^",6)
|
---|
50 | E S PXCEINT=+$$SITE^VASITE(+PXCEAFTR(0)) ;default to this site
|
---|
51 | S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,.06,"",PXCEINT,"PXCEDILF")
|
---|
52 | S DIR("B")=$S('$D(DIERR)&PXCEEXT]"":PXCEEXT,1:PXCEINT)
|
---|
53 | S DIR(0)="9000010,.06A"
|
---|
54 | S DIR("A")=$P(PXCETEXT,"~",4)
|
---|
55 | S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
|
---|
56 | D ^DIR
|
---|
57 | K DIR,DA
|
---|
58 | I X="@" S Y="@"
|
---|
59 | E I $D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT)=1 Q ;for visit
|
---|
60 | ;
|
---|
61 | S $P(PXCEAFTR(0),"^",6)=$P(Y,"^")
|
---|
62 | S $P(PXCEAFTR(21),"^",1)=""
|
---|
63 | S $P(PXCEAFTR(0),"^",3)="V"
|
---|
64 | G FINISH
|
---|
65 | ;
|
---|
66 | OUT ;This is a non va location
|
---|
67 | I $P(PXCEAFTR(21),"^",1)'="" D
|
---|
68 | . S DIR("B")=$P(PXCEAFTR(21),"^",1)
|
---|
69 | S DIR(0)="9000010,2101A"
|
---|
70 | S DIR("A")="Non VA Location of Encounter? "
|
---|
71 | D ^DIR
|
---|
72 | K DIR,DA
|
---|
73 | I X="@" S Y="@"
|
---|
74 | E I $D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT)=1 Q ;for visit
|
---|
75 | ;
|
---|
76 | S $P(PXCEAFTR(21),"^",1)=$P(Y,"^")
|
---|
77 | S $P(PXCEAFTR(0),"^",6)=""
|
---|
78 | S $P(PXCEAFTR(0),"^",3)="O"
|
---|
79 | FINISH ;
|
---|
80 | S $P(PXCEAFTR(0),"^",7)="E"
|
---|
81 | S $P(PXCEAFTR(0),"^",22)=""
|
---|
82 | Q
|
---|
83 | ;
|
---|
84 | ;********************************
|
---|
85 | ;Display text for the .01 field which is a Date and Time.
|
---|
86 | ;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.)
|
---|
87 | DISPLY01(PXCEVSIT) ;
|
---|
88 | Q $$DISPLY01^PXCESIT(PXCEVSIT)
|
---|
89 | ;
|
---|