YTQKIL ;ASF/ALB,HIOFO/FT - MHA3 DELETES ; 11/14/11 2:01pm
;;5.01;MENTAL HEALTH;**85,100,106,240**;Dec 30, 1994;Build 10
;
;
Q
;
;Reference to ^XLFDT APIs supported by DBIA #10103
;
EN ; Called from ^YTKIL - Delete Patient Data [YSMKIL]
N DIR,DIRUT,YS71,YSAD,YSANS,YSGIVEN,YSORD,YSORDID,YSTST,G,N,X,Y,YS,YSGIVEFM
I '$D(^YTT(601.84,"C",YSDFN)) W !,"No MH administration/test data exists for this patient." H 4 Q
K YSDATA
S YS("DFN")=YSDFN,YS("COMPLETE")="Y" D ADMINS^YTQAPI5(.YSDATA,.YS)
S N=2 F S N=$O(YSDATA(N)) Q:N'>0!($G(DIRUT)) D
. S G=YSDATA(N)
. S YSAD=$P(G,U) Q:YSAD'?1N.N ;-->out
. S YSTST=$P(G,U,2)
. S YSGIVEN=$$GET1^DIQ(601.84,YSAD_",",3)
. S YSGIVEFM=$$GET1^DIQ(601.84,YSAD_",",3,"I")
. S YSGIVEFM=$$FMTHL7^XLFDT(YSGIVEFM)
. S YSORD=$$GET1^DIQ(601.84,YSAD_",",5)
. S YSORDID=$$GET1^DIQ(601.84,YSAD_",",5,"I")
. S YS71=$O(^YTT(601.71,"B",YSTST,0))
. W !,YSTST_" on "_YSGIVEN_" by "_YSORD
. S DIR(0)="Y",DIR("A")="Delete",DIR("B")="No" D ^DIR
. D:Y DEL ;ft 11/14/11 removed call to EMAIL. Remove EMAIL & XMIT subroutines, too.
Q
DEL ;delete admin
S DIR(0)="Y",DIR("A")="Are you sure",DIR("B")="No" D ^DIR
Q:'Y
N DA,DIK,YSEVDFN,YSEVTST,YSEVCPLT
S YSEVDFN=+$P($G(^YTT(601.84,+YSAD,0)),U,2)
S YSEVTST=+$P($G(^YTT(601.84,+YSAD,0)),U,3)
S YSEVTST=$P($G(^YTT(601.71,YSEVTST,0)),U)
S YSEVCPLT=($P($G(^YTT(601.84,+YSAD,0)),U,9)="Y")
S DIK="^YTT(601.84,",DA=YSAD D ^DIK
S YSANS=0 F S YSANS=$O(^YTT(601.85,"AD",YSAD,YSANS)) Q:YSANS'>0 D
. S DIK="^YTT(601.85,",DA=YSANS D ^DIK
W " ***Deleted"
; publish delete event for admin if it was completed
I YSEVCPLT D DELETE^YTQEVNT(YSAD,YSEVDFN,YSEVTST,"ptdel")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQKIL 1691 printed Nov 22, 2024@17:28:31 Page 2
YTQKIL ;ASF/ALB,HIOFO/FT - MHA3 DELETES ; 11/14/11 2:01pm
+1 ;;5.01;MENTAL HEALTH;**85,100,106,240**;Dec 30, 1994;Build 10
+2 ;
+3 ;
+4 QUIT
+5 ;
+6 ;Reference to ^XLFDT APIs supported by DBIA #10103
+7 ;
EN ; Called from ^YTKIL - Delete Patient Data [YSMKIL]
+1 NEW DIR,DIRUT,YS71,YSAD,YSANS,YSGIVEN,YSORD,YSORDID,YSTST,G,N,X,Y,YS,YSGIVEFM
+2 IF '$DATA(^YTT(601.84,"C",YSDFN))
WRITE !,"No MH administration/test data exists for this patient."
HANG 4
QUIT
+3 KILL YSDATA
+4 SET YS("DFN")=YSDFN
SET YS("COMPLETE")="Y"
DO ADMINS^YTQAPI5(.YSDATA,.YS)
+5 SET N=2
FOR
SET N=$ORDER(YSDATA(N))
if N'>0!($GET(DIRUT))
QUIT
Begin DoDot:1
+6 SET G=YSDATA(N)
+7 ;-->out
SET YSAD=$PIECE(G,U)
if YSAD'?1N.N
QUIT
+8 SET YSTST=$PIECE(G,U,2)
+9 SET YSGIVEN=$$GET1^DIQ(601.84,YSAD_",",3)
+10 SET YSGIVEFM=$$GET1^DIQ(601.84,YSAD_",",3,"I")
+11 SET YSGIVEFM=$$FMTHL7^XLFDT(YSGIVEFM)
+12 SET YSORD=$$GET1^DIQ(601.84,YSAD_",",5)
+13 SET YSORDID=$$GET1^DIQ(601.84,YSAD_",",5,"I")
+14 SET YS71=$ORDER(^YTT(601.71,"B",YSTST,0))
+15 WRITE !,YSTST_" on "_YSGIVEN_" by "_YSORD
+16 SET DIR(0)="Y"
SET DIR("A")="Delete"
SET DIR("B")="No"
DO ^DIR
+17 ;ft 11/14/11 removed call to EMAIL. Remove EMAIL & XMIT subroutines, too.
if Y
DO DEL
End DoDot:1
+18 QUIT
DEL ;delete admin
+1 SET DIR(0)="Y"
SET DIR("A")="Are you sure"
SET DIR("B")="No"
DO ^DIR
+2 if 'Y
QUIT
+3 NEW DA,DIK,YSEVDFN,YSEVTST,YSEVCPLT
+4 SET YSEVDFN=+$PIECE($GET(^YTT(601.84,+YSAD,0)),U,2)
+5 SET YSEVTST=+$PIECE($GET(^YTT(601.84,+YSAD,0)),U,3)
+6 SET YSEVTST=$PIECE($GET(^YTT(601.71,YSEVTST,0)),U)
+7 SET YSEVCPLT=($PIECE($GET(^YTT(601.84,+YSAD,0)),U,9)="Y")
+8 SET DIK="^YTT(601.84,"
SET DA=YSAD
DO ^DIK
+9 SET YSANS=0
FOR
SET YSANS=$ORDER(^YTT(601.85,"AD",YSAD,YSANS))
if YSANS'>0
QUIT
Begin DoDot:1
+10 SET DIK="^YTT(601.85,"
SET DA=YSANS
DO ^DIK
End DoDot:1
+11 WRITE " ***Deleted"
+12 ; publish delete event for admin if it was completed
+13 IF YSEVCPLT
DO DELETE^YTQEVNT(YSAD,YSEVDFN,YSEVTST,"ptdel")
+14 QUIT
