- 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 Feb 18, 2025@23:10:22 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
