YTQKIL.m

YTQKIL ;ASF/ALB,HIOFO/FT - MHA3 DELETES ; 11/14/11 2:01pm

 ;;5.01;MENTAL HEALTH;**85,100,106**;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

 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"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---YTQKIL   1350     printed  Apr 09, 2024@21:23:01                                                                                                                                                                                                      Page 2

YTQKIL    ;ASF/ALB,HIOFO/FT - MHA3 DELETES ; 11/14/11 2:01pm

 +1       ;;5.01;MENTAL HEALTH;**85,100,106**;Dec 30, 1994;Build 10

 +2        QUIT 

 +3       ;

 +4       ;Reference to ^XLFDT APIs supported by DBIA #10103

 +5       ;

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

 +4        SET DIK="^YTT(601.84,"

           SET DA=YSAD

           DO ^DIK

 +5        SET YSANS=0

           FOR 

               SET YSANS=$ORDER(^YTT(601.85,"AD",YSAD,YSANS))

               if YSANS'>0

                   QUIT 

               Begin DoDot:1

 +6                SET DIK="^YTT(601.85,"

                   SET DA=YSANS

                   DO ^DIK

               End DoDot:1

 +7        WRITE "  ***Deleted"

 +8        QUIT