AGKPAT.m

AGKPAT ; IHS/ASDS/EFG - DELETE PATIENT ; 

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

NODFN ;EP - Without Pre-Defined Patient, FROM OTHER SYSTEMS.

 D ^AGVAR

NODFNA S DIC("W")="D ^AGSCANP" D PTLK^AG

 Q:'$D(DFN)

 S AG("NAME")=$P(^DPT(DFN,0),U)

NODFN1 W !!,"You wish to delete """,AG("NAME"),""".",!,"  CORRECT? (Y/N) : " D READ^AG G END:$D(DTOUT)!$D(DFOUT)!$D(DLOUT),NODFNA:$D(DUOUT) I $D(DQOUT)!((Y'["Y")&(Y'["N")) D YN^AG G NODFN1

 G DFN:Y["Y",NODFNA

DFN ;EP - With Pre-Defined Patient.

 I '$D(DFN) W !,"No deletion has occurred - undefined patient." H 4 Q

 D WAIT^DICD

A G L1:'$D(^AUPNPAT(DFN,41)) S DA=DFN,DR=.02,DIC=9000001.41,AG("DRENT1")=DUZ(2) D ^AGDICLK I $D(AG("LKERR")) W !!,*7,"Patient not registered at this facility." H 2 G END

 S AG=.01 F  S AG=$O(^DD(2,.01,"DEL",AG)) Q:'AG  X ^DD(2,.01,"DEL",AG,0) G END:$T

 G L1:AGDENT=1 S DA(1)=DFN,DA=DUZ(2),DIK="^AUPNPAT("_DA(1)_",41," D ^DIK,Z1 G END

L1 D Z1 S DA=DFN,DIK="^AUPNPAT(" D ^DIK S DA=DFN,DIK="^DPT(" D ^DIK K AG("EDIT") S AG("PTR")=0

 G END:'$D(^AUPNMCD("B",DFN))

L4 F IEN=0:0 S IEN=$O(^AUPNMCD("B",DFN,IEN)) Q:'IEN  S DIE="^AUPNMCD(",DA=IEN,DR=".01///@" D ^DIE

END K AG,DA,AGDATE,DFN,DIC,DIE,DR,IEN,AGDTS

 Q

Z1 ;EP - Find and Kill ^AGPATCH entries.

 S AGDATE=$P(^AUPNPAT(DFN,0),U,2)-1 F AG("Z3")=0:0 S AGDATE=$O(^AGPATCH(AGDATE)) Q:+AGDATE=0  K ^AGPATCH(AGDATE,DUZ(2),DFN)

B ;Set DPSC Flags.

 G B2:Y'=1 I $D(^AUPNPAT(DFN,41)) D NOW^%DTC S AGDTS=% S ^AGPATCH(AGDTS,DUZ(2),DFN)=DUZ(2)_U_$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2)

 D INITL^AGMAN S:$D(AG("INITL")) ^AGPATCH(AGDTS,DUZ(2),DFN)=^AGPATCH(AGDTS,DUZ(2),DFN)_"^^"_AG("INITL")_U_$P(^DPT(DFN,0),U,2)

B2 W !!,"The ",$P(^DPT(DFN,0),U)," file is deleted.",!! H 2

 Q

AGKPAT    ; IHS/ASDS/EFG - DELETE PATIENT ; 

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

NODFN     ;EP - Without Pre-Defined Patient, FROM OTHER SYSTEMS.

 +1        DO ^AGVAR

NODFNA     SET DIC("W")="D ^AGSCANP"

           DO PTLK^AG

 +1        IF '$DATA(DFN)

               QUIT 

 +2        SET AG("NAME")=$PIECE(^DPT(DFN,0),U)

NODFN1     WRITE !!,"You wish to delete """,AG("NAME"),""".",!,"  CORRECT? (Y/N) : "

           DO READ^AG

           IF $DATA(DTOUT)!$DATA(DFOUT)!$DATA(DLOUT)

               GOTO END

           IF $DATA(DUOUT)

               GOTO NODFNA

           IF $DATA(DQOUT)!((Y'["Y")&(Y'["N"))

               DO YN^AG

               GOTO NODFN1

 +1        IF Y["Y"

               GOTO DFN

           GOTO NODFNA

DFN       ;EP - With Pre-Defined Patient.

 +1        IF '$DATA(DFN)

               WRITE !,"No deletion has occurred - undefined patient."

               HANG 4

               QUIT 

 +2        DO WAIT^DICD

A          IF '$DATA(^AUPNPAT(DFN,41))

               GOTO L1

           SET DA=DFN

           SET DR=.02

           SET DIC=9000001.41

           SET AG("DRENT1")=DUZ(2)

           DO ^AGDICLK

           IF $DATA(AG("LKERR"))

               WRITE !!,*7,"Patient not registered at this facility."

               HANG 2

               GOTO END

 +1        SET AG=.01

           FOR 

               SET AG=$ORDER(^DD(2,.01,"DEL",AG))

               IF 'AG

                   QUIT 

               XECUTE ^DD(2,.01,"DEL",AG,0)

               IF $TEST

                   GOTO END

 +2        IF AGDENT=1

               GOTO L1

           SET DA(1)=DFN

           SET DA=DUZ(2)

           SET DIK="^AUPNPAT("_DA(1)_",41,"

           DO ^DIK

           DO Z1

           GOTO END

L1         DO Z1

           SET DA=DFN

           SET DIK="^AUPNPAT("

           DO ^DIK

           SET DA=DFN

           SET DIK="^DPT("

           DO ^DIK

           KILL AG("EDIT")

           SET AG("PTR")=0

 +1        IF '$DATA(^AUPNMCD("B",DFN))

               GOTO END

L4         FOR IEN=0:0

               SET IEN=$ORDER(^AUPNMCD("B",DFN,IEN))

               IF 'IEN

                   QUIT 

               SET DIE="^AUPNMCD("

               SET DA=IEN

               SET DR=".01///@"

               DO ^DIE

END        KILL AG,DA,AGDATE,DFN,DIC,DIE,DR,IEN,AGDTS

 +1        QUIT 

Z1        ;EP - Find and Kill ^AGPATCH entries.

 +1        SET AGDATE=$PIECE(^AUPNPAT(DFN,0),U,2)-1

           FOR AG("Z3")=0:0

               SET AGDATE=$ORDER(^AGPATCH(AGDATE))

               IF +AGDATE=0

                   QUIT 

               KILL ^AGPATCH(AGDATE,DUZ(2),DFN)

B         ;Set DPSC Flags.

 +1        IF Y'=1

               GOTO B2

           IF $DATA(^AUPNPAT(DFN,41))

               DO NOW^%DTC

               SET AGDTS=%

               SET ^AGPATCH(AGDTS,DUZ(2),DFN)=DUZ(2)_U_$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2)

 +2        DO INITL^AGMAN

           IF $DATA(AG("INITL"))

               SET ^AGPATCH(AGDTS,DUZ(2),DFN)=^AGPATCH(AGDTS,DUZ(2),DFN)_"^^"_AG("INITL")_U_$PIECE(^DPT(DFN,0),U,2)

B2         WRITE !!,"The ",$PIECE(^DPT(DFN,0),U)," file is deleted.",!!

           HANG 2

 +1        QUIT