ADELETE.m

ADELETE ; IHS/HQT/MJL  - DELETE DENTAL VISIT ;12:30 PM  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;**26**;APRIL 1999;Build 13

 ;;IHS/OIT/GAB 11.2014 Modified for 2015 Code Updates - PATCH 26

 S $P(ADELIN,"*",79)="",ADEFAST=0,ADETITL="VISIT DELETION MODE",AUPNLK("ALL")=""

CTRL ;------->LOOK UP PATIENT

 D PTLOOK^ADEGRL1 G:Y<1 END S ^ADEUTL("ADELOCK",ADEPAT)="" D HRN^ADEGRL3

 ;------->LOOK UP VISIT

VS D VSLOOK^ADEGRL2 G:'Y END I ADENEWVS W *7," ??" G VS

 S ADECON=$P(^ADEPCD(ADEDFN,0),U,9) S:ADECON="c" ADECON=1,ADEDIR=0 S:ADECON'="c" ADECON=0,ADEDIR=1

 ;------->DISPLAY

 D MOD^ADEGRL,LIST^ADEGRL3

 ;------->CONFIRM

C W !!?5,"DELETE THIS VISIT" S %=2 D YN^DICN

 I %Y["?" W !?10,"ANSWER `Y' TO DELETE THIS VISIT, `N' TO ABORT" G C

Z G:%'=1 END

 ;------->DELETE PCC VISIT AND VISIT RELATED

 S ADENEWVS=1 D ^ADEAPC2

 ;------->IF FAILED APPT UPDATE ^ADEPAT

 ;IHS/OIT/GAB 11.2014 commented the below & added the next line for the 2015 updates - Patch #26

 ;I $D(ADEV("9130"))!$D(ADEV("9140")) D FAIL

 I $D(ADEV("9130"))!$D(ADEV("9140"))!$D(ADEV("9986"))!$D(ADEV("9987")) D FAIL

 ;------->DELETE ENTRY IN ^ADEPCD

 D DELPCD

 ;------->END

END K:$D(ADEPAT) ^ADEUTL("ADELOCK",ADEPAT),DIK K AUPNLK("ALL") D END^ADEGRL Q

DELPCD S DA=ADEDFN,DIK="^ADEPCD(" D ^DIK Q

FAIL Q:'$D(^ADEPAT(ADEPAT,"FA"))

 S X=ADEVDATE,%DT="" D ^%DT

 I '$D(^ADEPAT(ADEPAT,"FA","B",Y)) K X,Y,%DT Q

 S DA=$O(^ADEPAT(ADEPAT,"FA","B",Y,0)) I '+DA K X,Y,%DT Q

 S DIE="^ADEPAT(DA(1),""FA"",",DA(1)=ADEPAT,DR=".01///@" D ^DIE

 K DA,DIE,DR,X,Y,%DT Q

ADELETE   ; IHS/HQT/MJL  - DELETE DENTAL VISIT ;12:30 PM  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;**26**;APRIL 1999;Build 13

 +2       ;;IHS/OIT/GAB 11.2014 Modified for 2015 Code Updates - PATCH 26

 +3        SET $PIECE(ADELIN,"*",79)=""

           SET ADEFAST=0

           SET ADETITL="VISIT DELETION MODE"

           SET AUPNLK("ALL")=""

CTRL      ;------->LOOK UP PATIENT

 +1        DO PTLOOK^ADEGRL1

           IF Y<1

               GOTO END

           SET ^ADEUTL("ADELOCK",ADEPAT)=""

           DO HRN^ADEGRL3

 +2       ;------->LOOK UP VISIT

VS         DO VSLOOK^ADEGRL2

           IF 'Y

               GOTO END

           IF ADENEWVS

               WRITE *7," ??"

               GOTO VS

 +1        SET ADECON=$PIECE(^ADEPCD(ADEDFN,0),U,9)

           IF ADECON="c"

               SET ADECON=1

               SET ADEDIR=0

           IF ADECON'="c"

               SET ADECON=0

               SET ADEDIR=1

 +2       ;------->DISPLAY

 +3        DO MOD^ADEGRL

           DO LIST^ADEGRL3

 +4       ;------->CONFIRM

C          WRITE !!?5,"DELETE THIS VISIT"

           SET %=2

           DO YN^DICN

 +1        IF %Y["?"

               WRITE !?10,"ANSWER `Y' TO DELETE THIS VISIT, `N' TO ABORT"

               GOTO C

Z          IF %'=1

               GOTO END

 +1       ;------->DELETE PCC VISIT AND VISIT RELATED

 +2        SET ADENEWVS=1

           DO ^ADEAPC2

 +3       ;------->IF FAILED APPT UPDATE ^ADEPAT

 +4       ;IHS/OIT/GAB 11.2014 commented the below & added the next line for the 2015 updates - Patch #26

 +5       ;I $D(ADEV("9130"))!$D(ADEV("9140")) D FAIL

 +6        IF $DATA(ADEV("9130"))!$DATA(ADEV("9140"))!$DATA(ADEV("9986"))!$DATA(ADEV("9987"))

               DO FAIL

 +7       ;------->DELETE ENTRY IN ^ADEPCD

 +8        DO DELPCD

 +9       ;------->END

END        IF $DATA(ADEPAT)

               KILL ^ADEUTL("ADELOCK",ADEPAT),DIK

           KILL AUPNLK("ALL")

           DO END^ADEGRL

           QUIT 

DELPCD     SET DA=ADEDFN

           SET DIK="^ADEPCD("

           DO ^DIK

           QUIT 

FAIL       IF '$DATA(^ADEPAT(ADEPAT,"FA"))

               QUIT 

 +1        SET X=ADEVDATE

           SET %DT=""

           DO ^%DT

 +2        IF '$DATA(^ADEPAT(ADEPAT,"FA","B",Y))

               KILL X,Y,%DT

               QUIT 

 +3        SET DA=$ORDER(^ADEPAT(ADEPAT,"FA","B",Y,0))

           IF '+DA

               KILL X,Y,%DT

               QUIT 

 +4        SET DIE="^ADEPAT(DA(1),""FA"","

           SET DA(1)=ADEPAT

           SET DR=".01///@"

           DO ^DIE

 +5        KILL DA,DIE,DR,X,Y,%DT

           QUIT