Routine: PXCEVFI5

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCEVFI5   2168     printed  Feb 18, 2025@23:54:39                                                                                                                                                                                                    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      ;

PXCEVFI5.m