source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCEVSIT.m

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1PXCEVSIT ;slc/dee,ISA/KWP-Used in editing a visit ; 1/7/02 11:36am
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**9,23,70,116,147,151**;Aug 12, 1996
3 Q
4 ;
5 ;********************************
6 ;
7 ;Functions
8 ;
9ELIGIBIL(PATIENT,HOSPLOC,DATETIME) ;+Eligibility from appointment if there is one.
10 Q:$G(PATIENT)'>0 -1
11 Q:$G(HOSPLOC)'>0 -1
12 Q:$G(DATETIME)'>1600000 -1
13 Q:'($D(^SC(HOSPLOC,"S",DATETIME,1))\10) -1
14 N PXCEELIG,PXCEINDX
15 S PXCEELIG=-1
16 S PXCEINDX=0
17 F S PXCEINDX=$O(^SC(HOSPLOC,"S",DATETIME,1,PXCEINDX)) Q:PXCEINDX="" I $P($G(^SC(HOSPLOC,"S",DATETIME,1,PXCEINDX,0)),"^",1)=PATIENT S PXCEELIG=$S($P(^(0),"^",10)>0:$P(^(0),"^",10),1:-1) Q
18 Q PXCEELIG
19 ;
20 ;********************************
21 ;Special cases for edit of the visit.
22 ;
23EVISITDT(REQTIME,DEFAULT) ;
24 ;+REQTIME is 1 if time is required,
25 ;+ 0 if time is optional
26 ;+ -1 if the date can be imprecise
27 ;+DEFAULT is the default date/time is there is not one in the file.
28 ;+ If it is -1 then NOW will be used as the default.
29 ;+ If it is 0 then TODAY will be used as the default.
30 N PXLIMDT
31 S PXLIMDT=$S(PXCECAT="HIST":0,1:$$SWITCHD^PXAPI)
32 S DIR(0)="DO^"_$S(PXLIMDT>2960000:PXLIMDT,1:"")_":"_(DT+.24)_":ESP"
33 I $G(REQTIME)=1 S DIR(0)=DIR(0)_"RX"
34 E I $G(REQTIME)=-1 S DIR(0)=DIR(0)_"T"
35 E S DIR(0)=DIR(0)_"TX"
36 I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))'="" S DIR("B")=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
37 E I ($D(DEFAULT)#2) D
38 . N %H,%I,%
39 . I DEFAULT>0 S DIR("B")=DEFAULT
40 . E I DEFAULT=0 S DIR("B")=DT
41 . E I DEFAULT=-1 D NOW^%DTC S DIR("B")=%
42 I $D(DIR("B"))#2 S Y=DIR("B") D DD^%DT S DIR("B")=Y
43 S DIR("A")=$P(PXCETEXT,"~",4)
44 S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
45 D ^DIR
46 I '$D(DIRUT),'$D(DUOUT),+VADM(6),$P(Y,".")>+VADM(6) S (DIRUT,DUOUT)=1 W VADM(7) R Y:10
47 K DIR,DA
48 Q
49 ;
50 ;
51EHOSPLOC ;
52 N HLOC,PXRES
53 I $P(PXCEAFTR(0),"^",22)'="" D
54 . N DIERR,PXCEDILF,PXCEINT,PXCEEXT
55 . S PXCEINT=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
56 . S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
57 . S DIR("B")=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
58 S DIR(0)="PA^44:AEMQ"
59 S DIR("A")=$P(PXCETEXT,"~",4)
60 I $P(PXCETEXT,"~",8)]"" S DIR("?")=$P(PXCETEXT,"~",8)
61 ;Only clinics that are not occasion of service
62 ; and are not dispositioning clinics
63 ;S DIR("S")="I $P(^(0),U,3)=""C""&'+$G(^(""OOS""))&'$O(^PX(815,1,""DHL"",""B"",Y,0))"
64 ;Only hospital locations that are not dispositioning clinics
65 ;
66 ;not occasion of service and not dispositioning clinics
67 ;S DIR("S")="I '+$G(^(""OOS""))&'$O(^PX(815,1,""DHL"",""B"",Y,0))"
68 ;Exclude disposition clinics from the above listed condition.
69 S DIR("S")="I '+$G(^(""OOS""))" ;PX*1*116
70 D ^DIR
71 K DIR,DA
72 I $D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT)=1 Q
73 I +Y'>0,PXCECAT'="HIST" D HELPHLOC W !,$C(7) G EHOSPLOC
74 S HLOC=$S(+Y>0:+Y,1:"")
75 I HLOC'="" S PXRES=$$CLNCK^SDUTL2(HLOC,1) I 'PXRES D G EHOSPLOC
76 .W !,$C(7),?5,"Clinic MUST be corrected before continuing."
77 S $P(PXCEAFTR(0),"^",22)=HLOC
78 ;
79 ;Get the eligibility and appointment type
80 ; if there is not already an appointment.
81 ; Creating a new visit or will lookup and find an old visit.
82 I '$$APPOINT^PXUTL1(PXCEPAT,+PXCEAFTR(0),HLOC) D
83 . S PXELAP=$$ELAP^SDPCE($P(PXCEAFTR(0),"^",5),$P(PXCEAFTR(0),"^",22))
84 E I HLOC>0 D
85 . ;Get the ELIGIBILITY for the appointment if there is one.
86 . N PXCEELIG
87 . S PXCEELIG=$$ELIGIBIL(PXCEPAT,HLOC,$P(PXCEAFTR(0),"^",1))
88 . S:PXCEELIG>0 $P(PXCEAFTR(0),"^",21)=PXCEELIG
89 Q
90 ;
91HELPDISP ;
92 W !,"You can not select a Dispositioning Clinic."
93 Q
94 ;
95HELPHLOC ;
96 W !!,"Enter the name of the Clinic for this Encounter."
97 W !,"Hospital Location is required."
98 Q
99 ;
100EWORKLOD(ASK) ;
101 ;+If ASK=0 do not ask default to the one for the Hospital Location
102 N DIC,DA
103EWORKLD2 ;
104 K DTOUT,DUOUT,DIC,DA
105 I $P(PXCEAFTR(0),"^",8)+$P(PXCEAFTR(0),"^",22) D
106 . N DIERR,PXCEDILF,PXCEINT,PXCEEXT
107 . I $P(PXCEAFTR(0),"^",8)'="" S PXCEINT=$P(PXCEAFTR(0),"^",8)
108 . E S PXCEINT=$P(^SC($P(PXCEAFTR(0),"^",22),0),"^",7)
109 . S Y=+PXCEINT
110 . S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
111 . S DIC("B")=$S('$D(DIERR):PXCEEXT,1:$P(PXCEAFTR(0),"^",8))
112 S DIC="^DIC(40.7,"
113 S DIC(0)="AEM"
114 S DIC("S")="I $P(^(0),U,3)=""""!($P(^(0),U,3)'<$P(PXCEAFTR(0),U))"
115 S DIC("A")=$P(PXCETEXT,"~",4)
116 I Y'>0!ASK D
117 . D ^DIC
118 K DIR,DA
119 I $D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT)=1 Q
120 I +Y'>0,PXCECAT'="HIST" G EWORKLD2
121 ;+set the stop code into the visit file
122 S $P(PXCEAFTR(0),"^",8)=$S(+Y>0:+Y,1:"")
123 N PXHLOC,PXSC
124 S PXHLOC=$P(PXCEAFTR(0),"^",22)
125 S PXSC=$P($G(^SC(+PXHLOC,0)),"^",7)
126 ;+if the hospital location is a ward then set the encounter type to a P for primary
127 I $P($G(^SC(+PXHLOC,0)),"^",3)["W" S $P(PXCEAFTR(150),"^",3)="P" Q
128 ;+if the stop code on file for the hospital location is the stop code entered or if the stop code in the hospital location file is null then set the encounter type to P for primary
129 I PXSC=+Y!(PXSC=""&PXHLOC) S $P(PXCEAFTR(150),"^",3)="P"
130 Q
131 ;
132ECODT ;Check out date time
133 N PXCHKOUT
134 D CHIKOUT^PXBAPI2("",PXCEPAT,+$P(PXCEAFTR(0),"^",22),$P(PXCEAFTR(0),"^",1))
135 S:PXCHKOUT>0 $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=PXCHKOUT
136 Q
137 ;
138EPAT ;
139 I $P(PXCEAFTR(0),"^",5)'="" Q
140 S DIR(0)="9000010,.05A"
141 S DIR("A")=$P(PXCETEXT,"~",4)
142 S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
143 D ^DIR
144 K DIR,DA
145 I X="@" S Y="@"
146 E I $D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT)=1 Q ;for visit
147 S $P(PXCEAFTR(0),"^",5)=$P(Y,"^")
148 S PXCEPAT=$P(Y,"^") D PATINFO^PXCEPAT(.PXCEPAT) I $D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT)=1 ;PX*1*147
149 Q
150 ;
151SKIP ;Just returns used when need a edit routine that does nothing.
152 Q
153 ;
Note: See TracBrowser for help on using the repository browser.