Routine: ECDTPD

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

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:"")

 ;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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECDTPD   2745     printed  Mar 13, 2025@21:01:57                                                                                                                                                                                                      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

ECDTPD.m