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

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

initial load of WorldVistAEHR

File size: 5.7 KB
Line 
1PXCEAE ;ISL/dee,ISA/KWP - Main routine for the List Manager display of a visit and related v-files ;04/26/99
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**37,67,99,147,156,172**;Aug 12, 1996
3 ;; ;
4 Q
5EN ;+ -- main entry point for PXCE DISPLAY VISIT
6 Q:$G(PXCEVIEN)'>0
7 ;The selection list for the AICS' package interface used in help messages
8 N PXCEHLST
9 ;
10 N PXCEAEVW S PXCEAEVW="B"
11 N PXCEVDEL S PXCEVDEL=0
12 ;
13 I '$D(PXCEPAT) N PXCEPAT D
14 . S PXCEPAT=$P($G(^AUPNVSIT(PXCEVIEN,0)),"^",5)
15 ; next 3 lines PX*1.0*172
16 N PXREC,PXPTSSN,PXDUZ S PXDUZ=DUZ,PXPTSSN=$P($G(^DPT(PXCEPAT,0)),U,9)
17 D SEC^PXCEEXP(.PXREC,PXDUZ,PXPTSSN)
18 I PXREC W !!,"Security regulations prohibit computer access to your own medical record." H 3 Q
19 S PXCECAT="AEP" D PATINFO^PXCEPAT(.PXCEPAT) K PXCECAT
20 ;
21 I '$D(PXCEHLOC) N PXCEHLOC S PXCEHLOC=$P($G(^AUPNVSIT(PXCEVIEN,0)),"^",22)
22 ;+If not called from encounter viewer lock ^PXLCKUSR
23 ;+and create ^XTMP("PXLCKUSR",VISIEN)=DUZ
24 I PXCEKEYS'["V" D
25 .N PXRESVAL,PXVISIEN,PXMSG,PXUSR
26 .S PXMSG="",PXVISIEN=PXCEVIEN
27 .I $D(^XTMP("PXLCKUSR",PXVISIEN)) S PXUSR=$G(^VA(200,^XTMP("PXLCKUSR",PXVISIEN),0)),PXUSR=$S(PXUSR="":"Unknown",1:$P(PXUSR,"^")),PXMSG="Encounter Locked by "_PXUSR
28 .S PXRESVAL=$$LOCK^PXUALOCK("^PXLCKUSR("_PXVISIEN_")",5,0,PXMSG,0)
29 .I 'PXRESVAL Q
30 .S PXRESVAL=$$CREATE^PXUAXTMP("PXLCKUSR",PXVISIEN,365,"PCE Encounter Lock",DUZ)
31 .I 'PXRESVAL D UNLOCK^PXUALOCK("^PXLCKUSR("_PXVISIEN_")") Q
32 .D EN^VALM("PXCE ADD/EDIT MENU")
33 .D UNLOCK^PXUALOCK("^PXLCKUSR("_PXVISIEN_")"),DELETE^PXUAXTMP("PXLCKUSR",PXVISIEN)
34 I PXCEKEYS["V",$D(^TMP("VALM DATA",$J,VALMEVL,"EXP")),^("EXP")]"" X ^("EXP")
35 Q
36 ;
37GETVIEN ;Ask the user which visit.
38 N PXCEVIDX
39 S PXCEVIDX=+$P(XQORNOD(0),"^",3)
40 S:PXCEVIDX'>0 PXCEVIDX=$$SEL1^PXCE("")
41 Q:PXCEVIDX'>0
42 S PXCEVIEN=$G(^TMP("PXCEIDX",$J,PXCEVIDX))
43 ;Check that it is not related to a no show or canceled apppointment
44 D APPCHECK^PXCESDAM(.PXCEVIEN)
45 Q:'$D(PXCEVIEN)
46 ;Cannot edit future visits
47 I $P(+^AUPNVSIT(PXCEVIEN,0),".")>DT D Q
48 . W !!,$C(7),"Can not update future encounters."
49 . D WAIT^PXCEHELP
50 . K PXCEVIEN
51 ;Check if the visit can be associated with an appointment.
52 S PXCEAPPM=$G(^DPT($P(^AUPNVSIT(PXCEVIEN,0),"^",5),"S",+^AUPNVSIT(PXCEVIEN,0),0))
53 I $P(PXCEVIEN,"^",7)="E" D I 'Y K PXCEVIEN Q
54 . W !!,"This is a historical encounter for documenting a clinical encounter only"
55 . W !,"and will not be used by Scheduling, Billing or Workload credit."
56 . D PAUSE^PXCEHELP
57 Q
58 ;
59HDR ; -- header code
60 I '$D(^AUPNVSIT(PXCEVIEN,0)) S VALMQUIT=1 Q
61 K VALMHDR
62 N VISIT0
63 ;
64 ;PATIENT
65 S VISIT0=^AUPNVSIT(PXCEVIEN,0)
66 S VALMHDR(1)=$E(PXCEPAT("NAME"),1,26)
67 S VALMHDR(1)=$E(VALMHDR(1)_$E(" ",1,(27-$L(VALMHDR(1))))_PXCEPAT("SSN")_" ",1,40)
68 S VALMHDR(1)=VALMHDR(1)_"Clinic: "_$S($P(VISIT0,"^",22)>0:$P(^SC($P(VISIT0,"^",22),0),"^"),1:"")
69 ;
70 ;DATE
71 S VALMHDR(2)=$E("Encounter Date "_$S($P(VISIT0,"^",1)>0:$$DATE^PXCEDATE($P(VISIT0,"^",1)),1:"")_" ",1,40)
72 S VALMHDR(2)=VALMHDR(2)_"Clinic Stop: "_$S($P(VISIT0,"^",8)>0:$$DISPLY08^PXCECSTP($P(VISIT0,"^",8)),1:"")
73 ;
74 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
75 ;
76 Q
77 ;
78KEYS(PXCEPROT,PXCEEND) ;Set up ^XQORM("KEY") array so that can edit an item by having its
79 ; number be and action to edit it.
80 N PXCEPIEN,PXCEINDX
81 S PXCEPIEN=$O(^ORD(101,"B",PXCEPROT,0))_"^1"
82 F PXCEINDX=1:1:PXCEEND S XQORM("KEY",PXCEINDX)=PXCEPIEN
83 ;
84 Q
85 ;
86INIT ; -- init variables and list array
87 D BUILD^PXCEAE1(PXCEVIEN,PXCEAEVW,"^TMP(""PXCEAE"",$J)","^TMP(""PXCEAEIX"",$J)")
88 I '$D(VALMBCK) K VALMHDR S VALMBCK="R"
89 Q
90 ;
91HELP ; -- help code
92 S X="?" D DISP^XQORM1 W !!
93 Q
94 ;
95EXIT ; -- exit code
96 ;
97 ;Check for incomplete ENCOUNTER if not already removed.
98 N PXQUIT
99 S PXQUIT=1
100 D:'$G(PXCEEXIT) CHECK^PXCEVFI5
101 ;
102 D CLEAN^VALM10
103 K ^TMP("PXCEAE",$J),^TMP("PXCEAEIX",$J)
104 D EVENT^PXKMAIN
105 K PXCEVIEN,PXCEAPPM
106 Q
107 ;
108EXPND ; -- expand code
109 S PXCEAEVW=$S(PXCEAEVW="B":"D",1:"B")
110 D BUILD^PXCEAE1(PXCEVIEN,PXCEAEVW,"^TMP(""PXCEAE"",$J)","^TMP(""PXCEAEIX"",$J)")
111 D DONE^PXCE
112 Q
113 ;
114EDIT ; -- edit a V-File entry
115 N PXCEFIDX
116 S PXCEFIDX=+$P(XQORNOD(0),"^",3)
117 D DOMANY(PXCEFIDX,"E","EN^PXCEVFIL(PXCECAT)")
118 Q
119 ;
120DEL ; -- delete a V-File entries
121 I PXCEKEYS'["D",PXCEKEYS'["d" W !!!,$C(7),"Error: You do not have delete access." D WAIT^PXCEHELP Q
122 D DOMANY(0,"D","DEL^PXCEVFI2(PXCECAT)")
123 Q
124 ;
125DOMANY(PXCEFIDX,WHATDO,WHATTODO) ;Process one or more V-File entries
126 ;WHATDO is E for edit and D for delete
127 ;WHATTODO is the routine to call
128 ;
129 I WHATDO="D" N PXCEDELV S PXCEDELV=0
130 D FULL^VALM1
131 I WHATDO="E" D
132 . S:PXCEFIDX'>0 PXCEFIDX=$$SEL^PXCEAE2("Edit",1)
133 E I WHATDO="D" D
134 . S:PXCEFIDX'>0 PXCEFIDX=$$SEL^PXCEAE2("Delete",2)
135 E W "??",$C(7) Q
136 Q:+PXCEFIDX'>0
137 N PXCEINDX,PXCEFIX1,PXCEFIX2
138 F PXCEINDX=1:1 S PXCEFIX1=$P(PXCEFIDX,",",PXCEINDX) Q:PXCEFIX1']"" D
139 . I $L(PXCEFIX1,"-")=1 D
140 .. I WHATDO="D",PXCEFIX1=1 S PXCEDELV=1
141 .. E D DO1(PXCEFIX1,WHATDO,WHATTODO)
142 . E F PXCEFIX2=$P(PXCEFIX1,"-",1):1:$P(PXCEFIX1,"-",2) D
143 .. I WHATDO="D",PXCEFIX2=1 S PXCEDELV=1
144 .. E D DO1(PXCEFIX2,WHATDO,WHATTODO)
145 I WHATDO="D",PXCEDELV D DO1(1,WHATDO,WHATTODO)
146 D INIT
147 Q
148 ;
149DO1(PXCEFIDX,WHATDO,WHATTODO) ;Process one V-File entry
150 ;PXCEFIDX is and index into ^TMP("PXCEAEIX",$J, which tells the V-File
151 ; and the IEN to process
152 ;WHATDO is E for edit and D for delete
153 ;WHATTODO is the routine to call
154 ;
155 N PXCEONE,PXCECAT,PXCEFIEN
156 S PXCEONE=$G(^TMP("PXCEAEIX",$J,PXCEFIDX))
157 S PXCEFIEN=+PXCEONE
158 S PXCECAT=$P(PXCEONE,"^",2)
159 I PXCECAT="CSTP",WHATDO="E" W !!!,$C(7),"You cannot edit stop codes." S PXCENOER=1 D WAIT^PXCEHELP Q
160 I PXCECAT="VST",$P(^AUPNVSIT(PXCEFIEN,0),"^",7)="E" S PXCECAT="HIST"
161 D @$S("~VST~HIST~CSTP~CPT~IMM~PED~POV~PRV~SK~TRT~HF~XAM~"[("~"_PXCECAT_"~"):WHATTODO,1:"QUIT")
162 Q
163 ;
164QUIT Q
165 ;
Note: See TracBrowser for help on using the repository browser.