Routine: APCDVDEL

APCDVDEL ; IHS/CMI/LAB - VISIT DELETE ;

 ;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88

 D GETPAT

 I APCDPAT="" W !!,"No PATIENT selected!" D EOJ Q

 D GETVISIT

 I APCDVSIT="" W !!,"No VISIT selected!" D EOJ Q

 D DSPLY

 I $D(^AUPNVNOT("AD",APCDVSIT)) W !!,"This visit has a TIU Note attached to it.  You cannot delete it.",! D PAUSE^APCDALV1 S APCDQ=1 Q

 I $D(^AUPNVREF("AD",APCDVSIT)) W !!,"This visit has a V Referral attached to it.  You cannot delete it.",! D PAUSE^APCDALV1 S APCDQ=1 Q  ;ADDED TO PREVENT DELETING A VISIT WITH V REFERRAL (IF NOT A DEMO PATIENT)

 W !!,"THE ABOVE VISIT AND RELATED V FILE ENTRIES WILL BE REMOVED FOREVER !!!"

 D DELETE

 D EOJ

GETPAT ; GET PATIENT

W !

 S APCDPAT=""

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y<0

 S APCDPAT=+Y

GETVISIT ;

 S APCDLOOK="",APCDVSIT=""

 K APCDVLK

 D ^APCDVLK

 K APCDLOOK

DSPLY ;

 S APCDVDSP=APCDVSIT D ^APCDVDSP

DELETE ; DELETE VISIT AND RELATED V FILES

 W !,"Sure you want to delete" S %=2 D YN^DICN S %Y=$E(%Y)

 Q:%Y="^"

 Q:"Nn"[%Y

 S DIE="^AUPNVSIT(",DA=APCDVSIT,DR=2201 D ^DIE K DA,DIE,DR

 I $P($G(^AUPNVSIT(APCDVSIT,22)),U)="" S DA=APCDVSIT,DIE="^AUPNVSIT(",DR="2201///NO RESPONSE FROM OPERATOR" D ^DIE K DA,DIE,DR

 ;UPDATE DELETE LOG

 D UPDLOG(APCDVSIT)

 S APCDVDLT=APCDVSIT D ^APCDVDLT

EOJ ; EOJ HOUSE KEEPING

 K %,%DT,%X,%Y,C,DIYS,X,Y

 K APCDCAT,APCDCLN,APCDDATE,APCDLOC,APCDPAT,APCDTYPE,APCDVSIT

UPDLOG(F,T) ;EP - CALLED TO UPDATE DELETE LOG

 S T=$G(T)

 D EN^XBNEW("UPDLOG1^APCDVDEL","F;T")

UPDLOG1 ;

 I '$G(F) Q

 I '$D(^AUPNVSIT(F,0)) Q

 I $D(^APCDVDEL("B",F)) S DIE="^APCDVDEL(",DA=$O(^APCDVDEL("B",F,0)),DR=".02///"_$$NOW^XLFDT_";.05////"_DUZ_";.04////"_$G(T) S:$G(T) DR=DR_";.03///"_$$NOW^XLFDT D ^DIE K DIE,DA,DR Q

 S X=F,DIC="^APCDVDEL(",DIC(0)="L",DIADD=1,DLAYGO=9001003.92,DIC("DR")=".02///"_$$NOW^XLFDT_";.05////"_DUZ_";.04////"_$G(T) S:$G(T) DIC("DR")=DIC("DR")_";.03///"_$$NOW^XLFDT K DD,DO,D0 D FILE^DICN

 K DIC,DR,DIADD,DLAYGO,X

APCDVDEL  ; IHS/CMI/LAB - VISIT DELETE ;

 +1       ;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88

 +2       ;

 +3        DO GETPAT

 +4        IF APCDPAT=""

               WRITE !!,"No PATIENT selected!"

               DO EOJ

               QUIT

 +5        DO GETVISIT

 +6        IF APCDVSIT=""

               WRITE !!,"No VISIT selected!"

               DO EOJ

               QUIT

 +7        DO DSPLY

 +8        IF $DATA(^AUPNVNOT("AD",APCDVSIT))

               WRITE !!,"This visit has a TIU Note attached to it.  You cannot delete it.",!

               DO PAUSE^APCDALV1

               SET APCDQ=1

               QUIT

 +9       ;ADDED TO PREVENT DELETING A VISIT WITH V REFERRAL (IF NOT A DEMO PATIENT)

           IF $DATA(^AUPNVREF("AD",APCDVSIT))

               WRITE !!,"This visit has a V Referral attached to it.  You cannot delete it.",!

               DO PAUSE^APCDALV1

               SET APCDQ=1

               QUIT

 +10       WRITE !!,"THE ABOVE VISIT AND RELATED V FILE ENTRIES WILL BE REMOVED FOREVER !!!"

 +11       DO DELETE

 +12       DO EOJ

 +13       QUIT

 +14      ;

GETPAT    ; GET PATIENT

 +1        WRITE !

 +2        SET APCDPAT=""

 +3        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +4        IF Y<0

               QUIT

 +5        SET APCDPAT=+Y

 +6        QUIT

 +7       ;

GETVISIT  ;

 +1        SET APCDLOOK=""

           SET APCDVSIT=""

 +2        KILL APCDVLK

 +3        DO ^APCDVLK

 +4        KILL APCDLOOK

 +5        QUIT

 +6       ;

DSPLY     ;

 +1        SET APCDVDSP=APCDVSIT

           DO ^APCDVDSP

 +2        QUIT

 +3       ;

DELETE    ; DELETE VISIT AND RELATED V FILES

 +1        WRITE !,"Sure you want to delete"

           SET %=2

           DO YN^DICN

           SET %Y=$EXTRACT(%Y)

 +2        IF %Y="^"

               QUIT

 +3        IF "Nn"[%Y

               QUIT

 +4        SET DIE="^AUPNVSIT("

           SET DA=APCDVSIT

           SET DR=2201

           DO ^DIE

           KILL DA,DIE,DR

 +5        IF $PIECE($GET(^AUPNVSIT(APCDVSIT,22)),U)=""

               SET DA=APCDVSIT

               SET DIE="^AUPNVSIT("

               SET DR="2201///NO RESPONSE FROM OPERATOR"

               DO ^DIE

               KILL DA,DIE,DR

 +6       ;UPDATE DELETE LOG

 +7        DO UPDLOG(APCDVSIT)

 +8        SET APCDVDLT=APCDVSIT

           DO ^APCDVDLT

 +9        QUIT

 +10      ;

EOJ       ; EOJ HOUSE KEEPING

 +1        KILL %,%DT,%X,%Y,C,DIYS,X,Y

 +2        KILL APCDCAT,APCDCLN,APCDDATE,APCDLOC,APCDPAT,APCDTYPE,APCDVSIT

 +3        QUIT

 +4       ;

UPDLOG(F,T) ;EP - CALLED TO UPDATE DELETE LOG

 +1        SET T=$GET(T)

 +2        DO EN^XBNEW("UPDLOG1^APCDVDEL","F;T")

 +3        QUIT

UPDLOG1   ;

 +1        IF '$GET(F)

               QUIT

 +2        IF '$DATA(^AUPNVSIT(F,0))

               QUIT

 +3        IF $DATA(^APCDVDEL("B",F))

               SET DIE="^APCDVDEL("

               SET DA=$ORDER(^APCDVDEL("B",F,0))

               SET DR=".02///"_$$NOW^XLFDT_";.05////"_DUZ_";.04////"_$G(T)

               IF $GET(T)

                   SET DR=DR_";.03///"_$$NOW^XLFDT

               DO ^DIE

               KILL DIE,DA,DR

               QUIT

 +4        SET X=F

           SET DIC="^APCDVDEL("

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=9001003.92

           SET DIC("DR")=".02///"_$$NOW^XLFDT_";.05////"_DUZ_";.04////"_$G(T)

           IF $GET(T)

               SET DIC("DR")=DIC("DR")_";.03///"_$$NOW^XLFDT

           KILL DD,DO,D0

           DO FILE^DICN

 +5        KILL DIC,DR,DIADD,DLAYGO,X

 +6        QUIT

APCDVDEL.m