source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCEHIST.m@ 700

Last change on this file since 700 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1PXCEHIST ;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 ;
15FORMAT ;;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 ;
28EVISITDT(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 ;
34ELOC ;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 ;
47IN ;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 ;
66OUT ;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"
79FINISH ;
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.)
87DISPLY01(PXCEVSIT) ;
88 Q $$DISPLY01^PXCESIT(PXCEVSIT)
89 ;
Note: See TracBrowser for help on using the repository browser.