ECDTPD ;ALB/DAN Delete Test Patient Data from file #721 ;1/19/17 12:03
;;2.0;EVENT CAPTURE;**134**;;Build 12
;
Q ;Don't allow processing from the top
;
DEL ;Delete test patient data
N PDT,DFN,ECIEN,PROC,CNT,PRCNM,ECDEL
S CNT=0,ECDEL=1
K ^TMP($J,"ECPAT") ;Delete temp storage for deleted records
S DFN=0 F S DFN=$O(^ECH("APAT",DFN)) Q:'+DFN I $$TESTPAT^VADPT(DFN) D
.S PDT=0 F S PDT=$O(^ECH("APAT",DFN,PDT)) Q:'+PDT S ECIEN=0 F S ECIEN=$O(^ECH("APAT",DFN,PDT,ECIEN)) Q:'+ECIEN D
..S PROC=$P($G(^ECH(ECIEN,0)),U,9) S PRCNM=$S($P(PROC,";",2)[725:$$GET1^DIQ(725,+PROC_",",1),1:"")
..I "^CH103^CH104^CH105^CH106^CH107^CH108^CH109^"'[("^"_PRCNM_"^") D SAVE,FILE^ECEFPAT S CNT=CNT+1 ;If test patient and procedure isn't in the list then delete the record
D MAIL
S $P(^XTMP("ECDELETE","DEL"),U,3)=0 ;Set status to completed
K ^TMP($J,"ECPAT") ;Delete storage as no longer needed
Q
;
SAVE ;Save information from record to be deleted for email message
N DATA,NAMESSN,PIECE
D GETS^DIQ(721,ECIEN_",","1;2;3;6;7;8;9","IE","DATA")
S NAMESSN=DATA(721,ECIEN_",",1,"E")_" ("_$$GET1^DIQ(2,DATA(721,ECIEN_",",1,"I"),.09)_")"
F PIECE=6,3,7,2,8,9 S ^TMP($J,"ECPAT",NAMESSN,ECIEN)=$G(^TMP($J,"ECPAT",NAMESSN,ECIEN))_DATA(721,ECIEN_",",PIECE,"E")_$S(PIECE'=9:"^",1:"")
Q
;Send email with results of processing
MAIL ;
N XMSUB,ECTEXT,XMDUZ,XMY,XMZ,XMTEXT,KIEN,DIFROM,NAME,LINE
K ^TMP($J,"XMTEXT")
S XMDUZ="Event Capture Package"
S XMY($G(DUZ,.5))="" ;Set recipient to installer or postmaster
S KIEN=0 F S KIEN=$O(^XUSEC("ECMGR",KIEN)) Q:'+KIEN S XMY(KIEN)="" ;Holders of ECMGR included in email, XUSEC read allowed by DBIA #10076
S ^TMP($J,"XMTEXT",1)="The deletion of test patient data has completed."
S ^TMP($J,"XMTEXT",2)="Below are the results."
S ^TMP($J,"XMTEXT",3)=""
S ^TMP($J,"XMTEXT",4)=$S('+$G(CNT):"No",1:CNT)_" test patient records were deleted."
S LINE=5 ;start with line 5 to add to message
I $G(CNT) D
.S ^TMP($J,"XMTEXT",LINE)="",LINE=LINE+1
.S ^TMP($J,"XMTEXT",LINE)="Deleted records, by NAME (SSN), are shown below in the following format:",LINE=LINE+1
.S ^TMP($J,"XMTEXT",LINE)="DSS UNIT^LOCATION^CATEGORY^DATE/TIME^PROCEDURE^VOLUME",LINE=LINE+1
.S ^TMP($J,"XMTEXT",LINE)="",LINE=LINE+1
.S NAME="" F S NAME=$O(^TMP($J,"ECPAT",NAME)) Q:NAME="" D
..S ^TMP($J,"XMTEXT",LINE)=NAME,LINE=LINE+1,^TMP($J,"XMTEXT",LINE)=$$REPEAT^XLFSTR("-",$L(NAME)),LINE=LINE+1
..S REC=0 F S REC=$O(^TMP($J,"ECPAT",NAME,REC)) Q:'+REC S ^TMP($J,"XMTEXT",LINE)=^TMP($J,"ECPAT",NAME,REC),LINE=LINE+1
..S ^TMP($J,"XMTEXT",LINE)="",LINE=LINE+1
S XMTEXT="^TMP($J,""XMTEXT"",",XMSUB="Test patient record deletion"
D ^XMD ;Send email
K ^TMP($J,"XMTEXT") ;No longer needed
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECDTPD 2745 printed Apr 09, 2024@21:02:42 Page 2
ECDTPD ;ALB/DAN Delete Test Patient Data from file #721 ;1/19/17 12:03
+1 ;;2.0;EVENT CAPTURE;**134**;;Build 12
+2 ;
+3 ;Don't allow processing from the top
QUIT
+4 ;
DEL ;Delete test patient data
+1 NEW PDT,DFN,ECIEN,PROC,CNT,PRCNM,ECDEL
+2 SET CNT=0
SET ECDEL=1
+3 ;Delete temp storage for deleted records
KILL ^TMP($JOB,"ECPAT")
+4 SET DFN=0
FOR
SET DFN=$ORDER(^ECH("APAT",DFN))
if '+DFN
QUIT
IF $$TESTPAT^VADPT(DFN)
Begin DoDot:1
+5 SET PDT=0
FOR
SET PDT=$ORDER(^ECH("APAT",DFN,PDT))
if '+PDT
QUIT
SET ECIEN=0
FOR
SET ECIEN=$ORDER(^ECH("APAT",DFN,PDT,ECIEN))
if '+ECIEN
QUIT
Begin DoDot:2
+6 SET PROC=$PIECE($GET(^ECH(ECIEN,0)),U,9)
SET PRCNM=$SELECT($PIECE(PROC,";",2)[725:$$GET1^DIQ(725,+PROC_",",1),1:"")
+7 ;If test patient and procedure isn't in the list then delete the record
IF "^CH103^CH104^CH105^CH106^CH107^CH108^CH109^"'[("^"_PRCNM_"^")
DO SAVE
DO FILE^ECEFPAT
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+8 DO MAIL
+9 ;Set status to completed
SET $PIECE(^XTMP("ECDELETE","DEL"),U,3)=0
+10 ;Delete storage as no longer needed
KILL ^TMP($JOB,"ECPAT")
+11 QUIT
+12 ;
SAVE ;Save information from record to be deleted for email message
+1 NEW DATA,NAMESSN,PIECE
+2 DO GETS^DIQ(721,ECIEN_",","1;2;3;6;7;8;9","IE","DATA")
+3 SET NAMESSN=DATA(721,ECIEN_",",1,"E")_" ("_$$GET1^DIQ(2,DATA(721,ECIEN_",",1,"I"),.09)_")"
+4 FOR PIECE=6,3,7,2,8,9
SET ^TMP($JOB,"ECPAT",NAMESSN,ECIEN)=$GET(^TMP($JOB,"ECPAT",NAMESSN,ECIEN))_DATA(721,ECIEN_",",PIECE,"E")_$SELECT(PIECE'=9:"^",1:"")
+5 QUIT
+6 ;Send email with results of processing
MAIL ;
+1 NEW XMSUB,ECTEXT,XMDUZ,XMY,XMZ,XMTEXT,KIEN,DIFROM,NAME,LINE
+2 KILL ^TMP($JOB,"XMTEXT")
+3 SET XMDUZ="Event Capture Package"
+4 ;Set recipient to installer or postmaster
SET XMY($GET(DUZ,.5))=""
+5 ;Holders of ECMGR included in email, XUSEC read allowed by DBIA #10076
SET KIEN=0
FOR
SET KIEN=$ORDER(^XUSEC("ECMGR",KIEN))
if '+KIEN
QUIT
SET XMY(KIEN)=""
+6 SET ^TMP($JOB,"XMTEXT",1)="The deletion of test patient data has completed."
+7 SET ^TMP($JOB,"XMTEXT",2)="Below are the results."
+8 SET ^TMP($JOB,"XMTEXT",3)=""
+9 SET ^TMP($JOB,"XMTEXT",4)=$SELECT('+$GET(CNT):"No",1:CNT)_" test patient records were deleted."
+10 ;start with line 5 to add to message
SET LINE=5
+11 IF $GET(CNT)
Begin DoDot:1
+12 SET ^TMP($JOB,"XMTEXT",LINE)=""
SET LINE=LINE+1
+13 SET ^TMP($JOB,"XMTEXT",LINE)="Deleted records, by NAME (SSN), are shown below in the following format:"
SET LINE=LINE+1
+14 SET ^TMP($JOB,"XMTEXT",LINE)="DSS UNIT^LOCATION^CATEGORY^DATE/TIME^PROCEDURE^VOLUME"
SET LINE=LINE+1
+15 SET ^TMP($JOB,"XMTEXT",LINE)=""
SET LINE=LINE+1
+16 SET NAME=""
FOR
SET NAME=$ORDER(^TMP($JOB,"ECPAT",NAME))
if NAME=""
QUIT
Begin DoDot:2
+17 SET ^TMP($JOB,"XMTEXT",LINE)=NAME
SET LINE=LINE+1
SET ^TMP($JOB,"XMTEXT",LINE)=$$REPEAT^XLFSTR("-",$LENGTH(NAME))
SET LINE=LINE+1
+18 SET REC=0
FOR
SET REC=$ORDER(^TMP($JOB,"ECPAT",NAME,REC))
if '+REC
QUIT
SET ^TMP($JOB,"XMTEXT",LINE)=^TMP($JOB,"ECPAT",NAME,REC)
SET LINE=LINE+1
+19 SET ^TMP($JOB,"XMTEXT",LINE)=""
SET LINE=LINE+1
End DoDot:2
End DoDot:1
+20 SET XMTEXT="^TMP($J,""XMTEXT"","
SET XMSUB="Test patient record deletion"
+21 ;Send email
DO ^XMD
+22 ;No longer needed
KILL ^TMP($JOB,"XMTEXT")
+23 QUIT
