- 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 Mar 13, 2025@21:23:20 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
