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

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

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1PXCEVFI5 ;ISL/dee - Check to see if the encounter is a standalone and if it needs to be deleted ;3/17/04 12:24pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**14,99,124**;Aug 12, 1996
3 ;
4 Q
5CHECK ;Check to see if this is a standalone and if it is make sure it has
6 ; a procedure or stop code. If it does not have either then allow the
7 ; user to continueing edit it or delete the encounter.
8 ;Also check that if there are diagnosis for the encounter that one of
9 ; them is primary.
10 ;
11 ;Quit if no visit ien
12 I '$D(^AUPNVSIT(PXCEVIEN)) S PXCEEXIT=1 Q
13 N PXCEVST0,PXCEPDX,PXCEAPPT
14 S PXCEVST0=^AUPNVSIT(PXCEVIEN,0)
15 ;Quit if Historical visit
16 I $P(PXCEVST0,"^",7)="E" S PXCEEXIT=1 Q
17 ;Get primary Dx if one
18 I '$D(^AUPNVPOV("AD",PXCEVIEN)) S PXCEPDX=-1 ;no Dx so do not need a primary one
19 E S PXCEPDX=$$PRIMVPOV^PXUTL1(PXCEVIEN)
20 ;Get if there is an appointment
21 S PXCEAPPT=$$VSTAPPT^PXUTL1(PXCEPAT,+PXCEVST0,$P(PXCEVST0,"^",22),PXCEVIEN)
22 ;Quit if there is an appointment and primary Dx
23 I PXCEPDX,PXCEAPPT S PXCEEXIT=1 Q
24 ;Quit if there are procedures or stop codes and a primary Dx
25 ;DROP PROCEDURE CHECK
26 S PXCEEXIT=1 Q
27 ;
28 I PXCEPDX,$D(^AUPNVCPT("AD",PXCEVIEN))!($D(^AUPNVSIT("AD",PXCEVIEN))) S PXCEEXIT=1 Q
29 N DIR,X,Y,PXCECNT
30 S DIR("B")="NO"
31 S DIR(0)="Y"
32 S PXCECNT=1
33 I 'PXCEPDX D
34 . S DIR("A",PXCECNT)="None of the diagnosis for this encounter are Primary."
35 . S PXCECNT=PXCECNT+1
36 I 'PXCEAPPT,'$D(^AUPNVCPT("AD",PXCEVIEN)),'$D(^AUPNVSIT("AD",PXCEVIEN)) D
37 . I $G(PXQUIT) D Q
38 .. N DIR
39 .. S DIR(0)="FOA"
40 .. S DIR("A",1)="This encounter does not have a procedure, it will be DELETED."
41 .. S DIR("A")="Press any key to continue: "
42 .. D ^DIR
43 .. I $$DELVFILE^PXAPI("ALL",PXCEVIEN)
44 . S DIR("A",PXCECNT)="This encounter must have a procedure."
45 . S PXCECNT=PXCECNT+1
46 . S DIR("A",PXCECNT)="It will be deleted if a procedure is not added."
47 . S PXCECNT=PXCECNT+1
48 . S DIR("A")="Delete this encounter"
49 . D ^DIR
50 . I Y=1 D
51 .. I $$DELVFILE^PXAPI("ALL",PXCEVIEN)
52 .. S PXCEEXIT=1
53 . E S PXCEEXIT=0
54 E D
55 . S DIR("A")="Quit anyway"
56 . D ^DIR
57 . I Y=0 S PXCEEXIT=0
58 . E S PXCEEXIT=1
59 Q
60 ;
Note: See TracBrowser for help on using the repository browser.