- 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
