MDPURGE ;HOIFO/NCA - Study Clean-Up process ;6/18/08 10:15
;;1.0;CLINICAL PROCEDURES;**11**;Apr 01, 2004;Build 67
; Reference IA #2263 [Supported] XPAR calls
; Reference IA #3468 [Subscription] Call GMRCCP
EN1 ; Clean up process entry point
N MDARRY,MDFN,MDK,MDLP,MDPRO,MDET,MDLST,MDX,MDY,X,Y,DTOUT,DUOUT
D GETLST^XPAR(.MDLST,"SYS","MD CLINIC ASSOCIATION")
F MDK=0:0 S MDK=$O(MDLST(MDK)) Q:MDK<1 S MDY=$P($G(MDLST(MDK)),"^",2) I +$P(MDY,";",2)>0 S MDPRO=+$P(MDY,";",2) D
.Q:+$$GET1^DIQ(702.01,+MDPRO_",",.06,"I")=2
.Q:+$$GET1^DIQ(702.01,+MDPRO_",",.12,"I")=1
.S MDARRY(+MDPRO)=+MDPRO
S MDLP=0 F S MDLP=$O(^MDD(702,"AS",5,MDLP)) Q:MDLP<1 S MDX=$G(^MDD(702,MDLP,0)) D
.S MDET=$P(MDX,"^",4) Q:$G(MDARRY(MDET))=""
.S MDFN=+$P(MDX,"^")
.S MDCN=$P(MDX,"^",5) Q:'MDCN
.I +$$GETC(MDFN,MDET,+MDCN) D PURG(+MDLP)
.Q
S MDLP=0 F S MDLP=$O(^MDD(702,"AS",0,MDLP)) Q:MDLP<1 S MDX=$G(^MDD(702,MDLP,0)) D
.S MDET=$P(MDX,"^",4) Q:$G(MDARRY(MDET))=""
.S MDFN=+$P(MDX,"^")
.S MDCN=$P(MDX,"^",5) Q:'MDCN
.I +$$GETC(MDFN,MDET,+MDCN) D PURG(+MDLP)
.Q
Q
GETC(MDPAT,MDDA,MDCNS) ; Get consult date
N MDJ,MDCF S MDCF=0 K ^TMP("MDTMP",$J) D CPLIST^GMRCCP(MDPAT,+MDDA,$NA(^TMP("MDTMP",$J)))
S MDJ=0 F S MDJ=$O(^TMP("MDTMP",$J,MDJ)) Q:'MDJ!(+MDCF) D
.I $P($G(^TMP("MDTMP",$J,MDJ)),U,4)="c"&(MDCNS=$P($G(^TMP("MDTMP",$J,MDJ)),U,5)) S MDCF=1 Q
K ^TMP("MDTMP",$J)
Q MDCF
PURG(MDI) ; [Procedure] Delete Study
N MDAST,MDFDA,MDHOLD,MDNOTE,MDRES,MDSIEN,BODY,SUBJECT,DEVIEN
S (MDHOLD,MDSIEN)=+MDI,MDRES=0,MDNOTE=""
;D ALERT^MDHL7U3(MDSIEN) ; Builds the body of the mail message
I $G(^MDD(702,+MDSIEN,0))="" Q
S:+$P(^MDD(702,MDSIEN,0),U,6) MDNOTE=$P(^MDD(702,MDSIEN,0),U,6)
S MDCANR=$$CANCEL^MDHL7B(MDHOLD) I +MDCANR<1 Q
Q:+MDNOTE
S MDAST=$$HL7CHK^MDHL7U3(+MDSIEN) I +MDAST<1 Q
;D NOTICE^MDHL7U3(SUBJECT,.BODY,DEVIEN,DUZ) ; delete message
;S MDFDA(702,DATA_",",.01)=""
; Check for renal study to delete as well
S:$D(^MDK(704.202,+MDI)) MDFDA(704.202,+MDI_",",.01)=""
D FILE^DIE("","MDFDA")
N DA,DIK S DA=+MDSIEN,DIK="^MDD(702," D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDPURGE 2094 printed Apr 09, 2024@20:49:28 Page 2
MDPURGE ;HOIFO/NCA - Study Clean-Up process ;6/18/08 10:15
+1 ;;1.0;CLINICAL PROCEDURES;**11**;Apr 01, 2004;Build 67
+2 ; Reference IA #2263 [Supported] XPAR calls
+3 ; Reference IA #3468 [Subscription] Call GMRCCP
EN1 ; Clean up process entry point
+1 NEW MDARRY,MDFN,MDK,MDLP,MDPRO,MDET,MDLST,MDX,MDY,X,Y,DTOUT,DUOUT
+2 DO GETLST^XPAR(.MDLST,"SYS","MD CLINIC ASSOCIATION")
+3 FOR MDK=0:0
SET MDK=$ORDER(MDLST(MDK))
if MDK<1
QUIT
SET MDY=$PIECE($GET(MDLST(MDK)),"^",2)
IF +$PIECE(MDY,";",2)>0
SET MDPRO=+$PIECE(MDY,";",2)
Begin DoDot:1
+4 if +$$GET1^DIQ(702.01,+MDPRO_",",.06,"I")=2
QUIT
+5 if +$$GET1^DIQ(702.01,+MDPRO_",",.12,"I")=1
QUIT
+6 SET MDARRY(+MDPRO)=+MDPRO
End DoDot:1
+7 SET MDLP=0
FOR
SET MDLP=$ORDER(^MDD(702,"AS",5,MDLP))
if MDLP<1
QUIT
SET MDX=$GET(^MDD(702,MDLP,0))
Begin DoDot:1
+8 SET MDET=$PIECE(MDX,"^",4)
if $GET(MDARRY(MDET))=""
QUIT
+9 SET MDFN=+$PIECE(MDX,"^")
+10 SET MDCN=$PIECE(MDX,"^",5)
if 'MDCN
QUIT
+11 IF +$$GETC(MDFN,MDET,+MDCN)
DO PURG(+MDLP)
+12 QUIT
End DoDot:1
+13 SET MDLP=0
FOR
SET MDLP=$ORDER(^MDD(702,"AS",0,MDLP))
if MDLP<1
QUIT
SET MDX=$GET(^MDD(702,MDLP,0))
Begin DoDot:1
+14 SET MDET=$PIECE(MDX,"^",4)
if $GET(MDARRY(MDET))=""
QUIT
+15 SET MDFN=+$PIECE(MDX,"^")
+16 SET MDCN=$PIECE(MDX,"^",5)
if 'MDCN
QUIT
+17 IF +$$GETC(MDFN,MDET,+MDCN)
DO PURG(+MDLP)
+18 QUIT
End DoDot:1
+19 QUIT
GETC(MDPAT,MDDA,MDCNS) ; Get consult date
+1 NEW MDJ,MDCF
SET MDCF=0
KILL ^TMP("MDTMP",$JOB)
DO CPLIST^GMRCCP(MDPAT,+MDDA,$NAME(^TMP("MDTMP",$JOB)))
+2 SET MDJ=0
FOR
SET MDJ=$ORDER(^TMP("MDTMP",$JOB,MDJ))
if 'MDJ!(+MDCF)
QUIT
Begin DoDot:1
+3 IF $PIECE($GET(^TMP("MDTMP",$JOB,MDJ)),U,4)="c"&(MDCNS=$PIECE($GET(^TMP("MDTMP",$JOB,MDJ)),U,5))
SET MDCF=1
QUIT
End DoDot:1
+4 KILL ^TMP("MDTMP",$JOB)
+5 QUIT MDCF
PURG(MDI) ; [Procedure] Delete Study
+1 NEW MDAST,MDFDA,MDHOLD,MDNOTE,MDRES,MDSIEN,BODY,SUBJECT,DEVIEN
+2 SET (MDHOLD,MDSIEN)=+MDI
SET MDRES=0
SET MDNOTE=""
+3 ;D ALERT^MDHL7U3(MDSIEN) ; Builds the body of the mail message
+4 IF $GET(^MDD(702,+MDSIEN,0))=""
QUIT
+5 if +$PIECE(^MDD(702,MDSIEN,0),U,6)
SET MDNOTE=$PIECE(^MDD(702,MDSIEN,0),U,6)
+6 SET MDCANR=$$CANCEL^MDHL7B(MDHOLD)
IF +MDCANR<1
QUIT
+7 if +MDNOTE
QUIT
+8 SET MDAST=$$HL7CHK^MDHL7U3(+MDSIEN)
IF +MDAST<1
QUIT
+9 ;D NOTICE^MDHL7U3(SUBJECT,.BODY,DEVIEN,DUZ) ; delete message
+10 ;S MDFDA(702,DATA_",",.01)=""
+11 ; Check for renal study to delete as well
+12 if $DATA(^MDK(704.202,+MDI))
SET MDFDA(704.202,+MDI_",",.01)=""
+13 DO FILE^DIE("","MDFDA")
+14 NEW DA,DIK
SET DA=+MDSIEN
SET DIK="^MDD(702,"
DO ^DIK
+15 QUIT
