PXCEVFI5 ;ISL/dee - Check to see if the encounter is a standalone and if it needs to be deleted ;3/17/04 12:24pm
;;1.0;PCE PATIENT CARE ENCOUNTER;**14,99,124,199**;Aug 12, 1996;Build 51
;
Q
CHECK ;Check to see if this is a standalone and if it is make sure it has
; a procedure or stop code. If it does not have either then allow the
; user to continue editing it or to delete the encounter.
;Also check that if there are diagnoses for the encounter that one of
; them is primary.
;
;Quit if no visit ien
I '$D(^AUPNVSIT(PXCEVIEN)) S PXCEEXIT=1 Q
N PXCEVST0,PXCEPDX,PXCEAPPT
S PXCEVST0=^AUPNVSIT(PXCEVIEN,0)
;Quit if Historical visit
I $P(PXCEVST0,"^",7)="E" S PXCEEXIT=1 Q
;Get primary Dx if one
I '$D(^AUPNVPOV("AD",PXCEVIEN)) S PXCEPDX=-1 ;no Dx so do not need a primary one
E S PXCEPDX=$$PRIMVPOV^PXUTL1(PXCEVIEN)
;Get if there is an appointment
S PXCEAPPT=$$VSTAPPT^PXUTL1(PXCEPAT,+PXCEVST0,$P(PXCEVST0,"^",22),PXCEVIEN)
;Quit if there is an appointment and primary Dx
I PXCEPDX,PXCEAPPT S PXCEEXIT=1 Q
;Quit if there are procedures or stop codes and a primary Dx
;DROP PROCEDURE CHECK
S PXCEEXIT=1 Q
;
I PXCEPDX,$D(^AUPNVCPT("AD",PXCEVIEN))!($D(^AUPNVSIT("AD",PXCEVIEN))) S PXCEEXIT=1 Q
N DIR,X,Y,PXCECNT
S DIR("B")="NO"
S DIR(0)="Y"
S PXCECNT=1
I 'PXCEPDX D
. S DIR("A",PXCECNT)="None of the diagnoses for this encounter are Primary."
. S PXCECNT=PXCECNT+1
I 'PXCEAPPT,'$D(^AUPNVCPT("AD",PXCEVIEN)),'$D(^AUPNVSIT("AD",PXCEVIEN)) D
. I $G(PXQUIT) D Q
.. N DIR
.. S DIR(0)="FOA"
.. S DIR("A",1)="This encounter does not have a procedure, it will be DELETED."
.. S DIR("A")="Press any key to continue: "
.. D ^DIR
.. I $$DELVFILE^PXAPI("ALL",PXCEVIEN)
. S DIR("A",PXCECNT)="This encounter must have a procedure."
. S PXCECNT=PXCECNT+1
. S DIR("A",PXCECNT)="It will be deleted if a procedure is not added."
. S PXCECNT=PXCECNT+1
. S DIR("A")="Delete this encounter"
. D ^DIR
. I Y=1 D
.. I $$DELVFILE^PXAPI("ALL",PXCEVIEN)
.. S PXCEEXIT=1
. E S PXCEEXIT=0
E D
. S DIR("A")="Quit anyway"
. D ^DIR
. I Y=0 S PXCEEXIT=0
. E S PXCEEXIT=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCEVFI5 2168 printed Oct 16, 2024@18:29:04 Page 2
PXCEVFI5 ;ISL/dee - Check to see if the encounter is a standalone and if it needs to be deleted ;3/17/04 12:24pm
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**14,99,124,199**;Aug 12, 1996;Build 51
+2 ;
+3 QUIT
CHECK ;Check to see if this is a standalone and if it is make sure it has
+1 ; a procedure or stop code. If it does not have either then allow the
+2 ; user to continue editing it or to delete the encounter.
+3 ;Also check that if there are diagnoses for the encounter that one of
+4 ; them is primary.
+5 ;
+6 ;Quit if no visit ien
+7 IF '$DATA(^AUPNVSIT(PXCEVIEN))
SET PXCEEXIT=1
QUIT
+8 NEW PXCEVST0,PXCEPDX,PXCEAPPT
+9 SET PXCEVST0=^AUPNVSIT(PXCEVIEN,0)
+10 ;Quit if Historical visit
+11 IF $PIECE(PXCEVST0,"^",7)="E"
SET PXCEEXIT=1
QUIT
+12 ;Get primary Dx if one
+13 ;no Dx so do not need a primary one
IF '$DATA(^AUPNVPOV("AD",PXCEVIEN))
SET PXCEPDX=-1
+14 IF '$TEST
SET PXCEPDX=$$PRIMVPOV^PXUTL1(PXCEVIEN)
+15 ;Get if there is an appointment
+16 SET PXCEAPPT=$$VSTAPPT^PXUTL1(PXCEPAT,+PXCEVST0,$PIECE(PXCEVST0,"^",22),PXCEVIEN)
+17 ;Quit if there is an appointment and primary Dx
+18 IF PXCEPDX
IF PXCEAPPT
SET PXCEEXIT=1
QUIT
+19 ;Quit if there are procedures or stop codes and a primary Dx
+20 ;DROP PROCEDURE CHECK
+21 SET PXCEEXIT=1
QUIT
+22 ;
+23 IF PXCEPDX
IF $DATA(^AUPNVCPT("AD",PXCEVIEN))!($DATA(^AUPNVSIT("AD",PXCEVIEN)))
SET PXCEEXIT=1
QUIT
+24 NEW DIR,X,Y,PXCECNT
+25 SET DIR("B")="NO"
+26 SET DIR(0)="Y"
+27 SET PXCECNT=1
+28 IF 'PXCEPDX
Begin DoDot:1
+29 SET DIR("A",PXCECNT)="None of the diagnoses for this encounter are Primary."
+30 SET PXCECNT=PXCECNT+1
End DoDot:1
+31 IF 'PXCEAPPT
IF '$DATA(^AUPNVCPT("AD",PXCEVIEN))
IF '$DATA(^AUPNVSIT("AD",PXCEVIEN))
Begin DoDot:1
+32 IF $GET(PXQUIT)
Begin DoDot:2
+33 NEW DIR
+34 SET DIR(0)="FOA"
+35 SET DIR("A",1)="This encounter does not have a procedure, it will be DELETED."
+36 SET DIR("A")="Press any key to continue: "
+37 DO ^DIR
+38 IF $$DELVFILE^PXAPI("ALL",PXCEVIEN)
End DoDot:2
QUIT
+39 SET DIR("A",PXCECNT)="This encounter must have a procedure."
+40 SET PXCECNT=PXCECNT+1
+41 SET DIR("A",PXCECNT)="It will be deleted if a procedure is not added."
+42 SET PXCECNT=PXCECNT+1
+43 SET DIR("A")="Delete this encounter"
+44 DO ^DIR
+45 IF Y=1
Begin DoDot:2
+46 IF $$DELVFILE^PXAPI("ALL",PXCEVIEN)
+47 SET PXCEEXIT=1
End DoDot:2
+48 IF '$TEST
SET PXCEEXIT=0
End DoDot:1
+49 IF '$TEST
Begin DoDot:1
+50 SET DIR("A")="Quit anyway"
+51 DO ^DIR
+52 IF Y=0
SET PXCEEXIT=0
+53 IF '$TEST
SET PXCEEXIT=1
End DoDot:1
+54 QUIT
+55 ;
