- MDWCAN ;HOIFO/NCA - Process No-Shows and Cancels ;7/29/08 09:50
- ;;1.0;CLINICAL PROCEDURES;**11,21**;Apr 01, 2004;Build 30
- ; Reference IA #2263 [Supported] Call to ^XPAR
- ; #4433 [Supported] Call to SDAPI^SDAMA301
- ; #10103 [Supported] XLFDT call
- EN1 ; Check for No-Shows and Cancels
- N MDARRAY,MDAPAT,MDAPPT,MDCHECK,MDALOC,MDCL,MDCOUNT,MDCLIEN,MDDFN,MDDATE,MDAPPT,MDK,MDLP1,MDLP2,MDLST,MDLIST,MDFIN,MDND,MDSTUDY,MDVST,MDXX,MDY,X1,X2
- S X1=DT,X2=-1 D C^%DTC S MDDATE=X K ^TMP("MDAP",$J),^TMP("MDCAN",$J),^TMP("MDPLST",$J),MDALOC S MDFIN=DT+.24
- D GETLST^XPAR(.MDLIST,"SYS","MD CLINIC ASSOCIATION")
- F MDK=0:0 S MDK=$O(MDLIST(MDK)) Q:MDK<1 S MDND=$P($G(MDLIST(MDK)),"^",2) I +$P(MDND,";",2) S MDCL=+MDND D
- .S:$G(MDALOC(+MDCL))="" MDALOC(+MDCL)=+MDCL
- .S ^TMP("MDPLST",$J,+MDCL,+$P(MDND,";",2))=+$P(MDND,";",2)
- .Q
- S MDLP1=DT F S MDLP1=$O(^MDD(702,"ASD",MDLP1)) Q:MDLP1<1!(MDLP1>MDFIN) F MDLP2=0:0 S MDLP2=$O(^MDD(702,"ASD",MDLP1,MDLP2)) Q:MDLP2<1 D
- .S MDXX=$G(^MDD(702,MDLP2,0))
- .Q:$P(MDXX,"^",9)'=5
- .Q:'+MDXX
- .I $G(^TMP("MDAP",$J,+MDXX))="" S ^TMP("MDAP",$J,+MDXX)=+MDXX
- .Q
- F MDLP1=0:0 S MDLP1=$O(^MDD(702,"AS",0,MDLP1)) Q:MDLP1<1 D
- .S MDXX=$G(^MDD(702,MDLP1,0))
- .Q:$P(MDXX,"^",9)>0
- .Q:'+$P(MDXX,"^",5)!($P(MDXX,"^",6)'="")
- .Q:'+MDXX
- .I $G(^TMP("MDAP",$J,+MDXX))="" S ^TMP("MDAP",$J,+MDXX)=+MDXX
- .I '+$G(^TMP("MDCAN",$J,0,+MDXX,+$P(MDXX,"^",4))) S ^TMP("MDCAN",$J,0,+MDXX,+$P(MDXX,"^",4))=MDLP1
- .Q
- F MDK=0:0 S MDK=$O(^TMP("MDAP",$J,MDK)) Q:MDK<1 D
- .K ^TMP($J,"SDAMA301") S MDXX=MDK,MDARRAY(1)=MDDATE_";"_DT
- .S MDARRAY(2)="MDALOC("
- .S MDARRAY(3)="NS;NSR;CP;CPR;CC;CCR",MDARRAY(4)=+MDXX,MDARRAY("FLDS")="1;3;4;25"
- .S MDCOUNT=$$SDAPI^SDAMA301(.MDARRAY)
- .I MDCOUNT>0 D
- ..S MDCL=0 F S MDCL=$O(^TMP($J,"SDAMA301",+MDXX,MDCL)) Q:MDCL<1 S MDCLIEN=0 F S MDCLIEN=$O(^TMP($J,"SDAMA301",+MDXX,+MDCL,MDCLIEN)) Q:MDCLIEN<1 D
- ...S MDAPPT=$G(^TMP($J,"SDAMA301",+MDXX,+MDCL,MDCLIEN))
- ...Q:$P(MDAPPT,"^",3)=""
- ...Q:+$P(MDAPPT,"^",4)'=+MDXX
- ...Q:$P(MDAPPT,"^",1)=""
- ...S MDSTUDY=$$GSTUDY(+MDXX,$P(MDAPPT,"^",1),+MDCL) Q:'MDSTUDY
- ...I $G(^MDD(702,+MDSTUDY,3))="" K MDFDA S MDFDA(702,+MDSTUDY_",",.14)=$P(MDAPPT,"^",1) D FILE^DIE("","MDFDA") K MDFDA
- ...D PURG(+MDSTUDY) Q
- ..Q
- .Q
- K ^TMP($J,"SDAMA301"),^TMP("MDAP",$J),^TMP("MDCAN",$J),^TMP("MDPLST",$J),MDAPAT,MDALOC
- Q
- GSTUDY(MDPAT,MDDA,MDACL) ;Get study for scheduled date/time
- N MDDONE,MDIN,MDN,MDV,Y1 S (MDDONE,Y1)=0
- F MDIN=0:0 S MDIN=$O(^MDD(702,"ASD",MDDA,MDIN)) Q:MDIN<1!(Y1>0)!(MDDONE=1) D
- .I $P($G(^MDD(702,MDIN,0)),"^")=MDPAT D
- ..S MDN=$G(^MDD(702,MDIN,0)),MDV=$P(MDN,"^",7)
- ..I $P(MDV,";",3)'=""&($P(MDV,";",3)'=MDACL) Q
- ..S:$P(MDN,"^",9)'=6 Y1=MDIN S:$P(MDN,"^",9)=6 MDDONE=1
- ..Q
- I +Y1>0 Q Y1
- I +MDDONE>0 Q Y1
- F MDIN=0:0 S MDIN=$O(^TMP("MDCAN",$J,0,MDPAT,MDIN)) Q:MDIN<1!(Y1>0) D
- .I +$G(^TMP("MDPLST",$J,MDACL,MDIN)) S Y1=+$G(^TMP("MDCAN",$J,0,MDPAT,MDIN))
- Q Y1
- PURG(MDI) ; [Procedure] Delete Study
- N MDAST,MDCANR,MDERR,MDFDA,MDJ,MDHOLD,MDNK,MDNOTE,MDR,MDRES,MDSIEN,BODY,SUBJECT,DEVIEN,MDORD,MDTEMP,REBOOK
- S (MDHOLD,MDSIEN)=+MDI,(MDRES,REBOOK)=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 cancel as well
- I $D(^MDK(704.202,+MDI)) K MDFDA S MDFDA(704.202,+MDI_",",.09)=0 D FILE^DIE("","MDFDA")
- K MDFDA
- S MDFDA(702,+MDI_",",.07)=""
- S MDFDA(702,+MDI_",",.09)=6
- D FILE^DIE("","MDFDA")
- S MDORD=+$P($G(^MDD(702,+MDI,0)),"^",12) I +MDORD K ^MDD(702,"AION",+MDORD,+MDI)
- ;N DA,DIK S DA=+MDSIEN,DIK="^MDD(702," D ^DIK
- D GETLST^XPAR(.MDTEMP,"SYS","MD CLINIC ASSOCIATION")
- F MDJ=0:0 S MDJ=$O(MDTEMP(MDJ)) Q:MDJ<1 S MDNK=$P($G(MDTEMP(MDJ)),"^",2) D
- .I $P(MDNK,";",2)'=$P(^MDD(702,+MDI,0),"^",4) K MDTEMP(MDJ)
- F MDJ=0:0 S MDJ=$O(MDTEMP(MDJ)) Q:MDJ<1!(REBOOK>0) S MDR=$$GETAPPT^MDWOR($P($G(^MDD(702,+MDI,0)),"^"),+$P($G(MDTEMP(MDJ)),"^",2)) D
- .I +MDR&($P(MDR,"^",1)>DT) S REBOOK=1
- Q:'REBOOK
- K MDFDA
- S MDFDA(702,"+1,",.01)=$P($G(^MDD(702,+MDI,0)),"^")
- S MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
- S MDFDA(702,"+1,",.03)=$P($G(^MDD(702,+MDI,0)),"^",3)
- S MDFDA(702,"+1,",.04)=$P($G(^MDD(702,+MDI,0)),"^",4)
- S MDFDA(702,"+1,",.05)=$P($G(^MDD(702,+MDI,0)),"^",5)
- S MDFDA(702,"+1,",.09)=0
- S MDFDA(702,"+1,",.11)=$P($G(^MDD(702,+MDI,0)),"^",11)
- D UPDATE^DIE("","MDFDA","","MDERR") K MDFDA
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDWCAN 4661 printed Feb 18, 2025@23:10:51 Page 2
- MDWCAN ;HOIFO/NCA - Process No-Shows and Cancels ;7/29/08 09:50
- +1 ;;1.0;CLINICAL PROCEDURES;**11,21**;Apr 01, 2004;Build 30
- +2 ; Reference IA #2263 [Supported] Call to ^XPAR
- +3 ; #4433 [Supported] Call to SDAPI^SDAMA301
- +4 ; #10103 [Supported] XLFDT call
- EN1 ; Check for No-Shows and Cancels
- +1 NEW MDARRAY,MDAPAT,MDAPPT,MDCHECK,MDALOC,MDCL,MDCOUNT,MDCLIEN,MDDFN,MDDATE,MDAPPT,MDK,MDLP1,MDLP2,MDLST,MDLIST,MDFIN,MDND,MDSTUDY,MDVST,MDXX,MDY,X1,X2
- +2 SET X1=DT
- SET X2=-1
- DO C^%DTC
- SET MDDATE=X
- KILL ^TMP("MDAP",$JOB),^TMP("MDCAN",$JOB),^TMP("MDPLST",$JOB),MDALOC
- SET MDFIN=DT+.24
- +3 DO GETLST^XPAR(.MDLIST,"SYS","MD CLINIC ASSOCIATION")
- +4 FOR MDK=0:0
- SET MDK=$ORDER(MDLIST(MDK))
- if MDK<1
- QUIT
- SET MDND=$PIECE($GET(MDLIST(MDK)),"^",2)
- IF +$PIECE(MDND,";",2)
- SET MDCL=+MDND
- Begin DoDot:1
- +5 if $GET(MDALOC(+MDCL))=""
- SET MDALOC(+MDCL)=+MDCL
- +6 SET ^TMP("MDPLST",$JOB,+MDCL,+$PIECE(MDND,";",2))=+$PIECE(MDND,";",2)
- +7 QUIT
- End DoDot:1
- +8 SET MDLP1=DT
- FOR
- SET MDLP1=$ORDER(^MDD(702,"ASD",MDLP1))
- if MDLP1<1!(MDLP1>MDFIN)
- QUIT
- FOR MDLP2=0:0
- SET MDLP2=$ORDER(^MDD(702,"ASD",MDLP1,MDLP2))
- if MDLP2<1
- QUIT
- Begin DoDot:1
- +9 SET MDXX=$GET(^MDD(702,MDLP2,0))
- +10 if $PIECE(MDXX,"^",9)'=5
- QUIT
- +11 if '+MDXX
- QUIT
- +12 IF $GET(^TMP("MDAP",$JOB,+MDXX))=""
- SET ^TMP("MDAP",$JOB,+MDXX)=+MDXX
- +13 QUIT
- End DoDot:1
- +14 FOR MDLP1=0:0
- SET MDLP1=$ORDER(^MDD(702,"AS",0,MDLP1))
- if MDLP1<1
- QUIT
- Begin DoDot:1
- +15 SET MDXX=$GET(^MDD(702,MDLP1,0))
- +16 if $PIECE(MDXX,"^",9)>0
- QUIT
- +17 if '+$PIECE(MDXX,"^",5)!($PIECE(MDXX,"^",6)'="")
- QUIT
- +18 if '+MDXX
- QUIT
- +19 IF $GET(^TMP("MDAP",$JOB,+MDXX))=""
- SET ^TMP("MDAP",$JOB,+MDXX)=+MDXX
- +20 IF '+$GET(^TMP("MDCAN",$JOB,0,+MDXX,+$PIECE(MDXX,"^",4)))
- SET ^TMP("MDCAN",$JOB,0,+MDXX,+$PIECE(MDXX,"^",4))=MDLP1
- +21 QUIT
- End DoDot:1
- +22 FOR MDK=0:0
- SET MDK=$ORDER(^TMP("MDAP",$JOB,MDK))
- if MDK<1
- QUIT
- Begin DoDot:1
- +23 KILL ^TMP($JOB,"SDAMA301")
- SET MDXX=MDK
- SET MDARRAY(1)=MDDATE_";"_DT
- +24 SET MDARRAY(2)="MDALOC("
- +25 SET MDARRAY(3)="NS;NSR;CP;CPR;CC;CCR"
- SET MDARRAY(4)=+MDXX
- SET MDARRAY("FLDS")="1;3;4;25"
- +26 SET MDCOUNT=$$SDAPI^SDAMA301(.MDARRAY)
- +27 IF MDCOUNT>0
- Begin DoDot:2
- +28 SET MDCL=0
- FOR
- SET MDCL=$ORDER(^TMP($JOB,"SDAMA301",+MDXX,MDCL))
- if MDCL<1
- QUIT
- SET MDCLIEN=0
- FOR
- SET MDCLIEN=$ORDER(^TMP($JOB,"SDAMA301",+MDXX,+MDCL,MDCLIEN))
- if MDCLIEN<1
- QUIT
- Begin DoDot:3
- +29 SET MDAPPT=$GET(^TMP($JOB,"SDAMA301",+MDXX,+MDCL,MDCLIEN))
- +30 if $PIECE(MDAPPT,"^",3)=""
- QUIT
- +31 if +$PIECE(MDAPPT,"^",4)'=+MDXX
- QUIT
- +32 if $PIECE(MDAPPT,"^",1)=""
- QUIT
- +33 SET MDSTUDY=$$GSTUDY(+MDXX,$PIECE(MDAPPT,"^",1),+MDCL)
- if 'MDSTUDY
- QUIT
- +34 IF $GET(^MDD(702,+MDSTUDY,3))=""
- KILL MDFDA
- SET MDFDA(702,+MDSTUDY_",",.14)=$PIECE(MDAPPT,"^",1)
- DO FILE^DIE("","MDFDA")
- KILL MDFDA
- +35 DO PURG(+MDSTUDY)
- QUIT
- End DoDot:3
- +36 QUIT
- End DoDot:2
- +37 QUIT
- End DoDot:1
- +38 KILL ^TMP($JOB,"SDAMA301"),^TMP("MDAP",$JOB),^TMP("MDCAN",$JOB),^TMP("MDPLST",$JOB),MDAPAT,MDALOC
- +39 QUIT
- GSTUDY(MDPAT,MDDA,MDACL) ;Get study for scheduled date/time
- +1 NEW MDDONE,MDIN,MDN,MDV,Y1
- SET (MDDONE,Y1)=0
- +2 FOR MDIN=0:0
- SET MDIN=$ORDER(^MDD(702,"ASD",MDDA,MDIN))
- if MDIN<1!(Y1>0)!(MDDONE=1)
- QUIT
- Begin DoDot:1
- +3 IF $PIECE($GET(^MDD(702,MDIN,0)),"^")=MDPAT
- Begin DoDot:2
- +4 SET MDN=$GET(^MDD(702,MDIN,0))
- SET MDV=$PIECE(MDN,"^",7)
- +5 IF $PIECE(MDV,";",3)'=""&($PIECE(MDV,";",3)'=MDACL)
- QUIT
- +6 if $PIECE(MDN,"^",9)'=6
- SET Y1=MDIN
- if $PIECE(MDN,"^",9)=6
- SET MDDONE=1
- +7 QUIT
- End DoDot:2
- End DoDot:1
- +8 IF +Y1>0
- QUIT Y1
- +9 IF +MDDONE>0
- QUIT Y1
- +10 FOR MDIN=0:0
- SET MDIN=$ORDER(^TMP("MDCAN",$JOB,0,MDPAT,MDIN))
- if MDIN<1!(Y1>0)
- QUIT
- Begin DoDot:1
- +11 IF +$GET(^TMP("MDPLST",$JOB,MDACL,MDIN))
- SET Y1=+$GET(^TMP("MDCAN",$JOB,0,MDPAT,MDIN))
- End DoDot:1
- +12 QUIT Y1
- PURG(MDI) ; [Procedure] Delete Study
- +1 NEW MDAST,MDCANR,MDERR,MDFDA,MDJ,MDHOLD,MDNK,MDNOTE,MDR,MDRES,MDSIEN,BODY,SUBJECT,DEVIEN,MDORD,MDTEMP,REBOOK
- +2 SET (MDHOLD,MDSIEN)=+MDI
- SET (MDRES,REBOOK)=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 cancel as well
- +12 IF $DATA(^MDK(704.202,+MDI))
- KILL MDFDA
- SET MDFDA(704.202,+MDI_",",.09)=0
- DO FILE^DIE("","MDFDA")
- +13 KILL MDFDA
- +14 SET MDFDA(702,+MDI_",",.07)=""
- +15 SET MDFDA(702,+MDI_",",.09)=6
- +16 DO FILE^DIE("","MDFDA")
- +17 SET MDORD=+$PIECE($GET(^MDD(702,+MDI,0)),"^",12)
- IF +MDORD
- KILL ^MDD(702,"AION",+MDORD,+MDI)
- +18 ;N DA,DIK S DA=+MDSIEN,DIK="^MDD(702," D ^DIK
- +19 DO GETLST^XPAR(.MDTEMP,"SYS","MD CLINIC ASSOCIATION")
- +20 FOR MDJ=0:0
- SET MDJ=$ORDER(MDTEMP(MDJ))
- if MDJ<1
- QUIT
- SET MDNK=$PIECE($GET(MDTEMP(MDJ)),"^",2)
- Begin DoDot:1
- +21 IF $PIECE(MDNK,";",2)'=$PIECE(^MDD(702,+MDI,0),"^",4)
- KILL MDTEMP(MDJ)
- End DoDot:1
- +22 FOR MDJ=0:0
- SET MDJ=$ORDER(MDTEMP(MDJ))
- if MDJ<1!(REBOOK>0)
- QUIT
- SET MDR=$$GETAPPT^MDWOR($PIECE($GET(^MDD(702,+MDI,0)),"^"),+$PIECE($GET(MDTEMP(MDJ)),"^",2))
- Begin DoDot:1
- +23 IF +MDR&($PIECE(MDR,"^",1)>DT)
- SET REBOOK=1
- End DoDot:1
- +24 if 'REBOOK
- QUIT
- +25 KILL MDFDA
- +26 SET MDFDA(702,"+1,",.01)=$PIECE($GET(^MDD(702,+MDI,0)),"^")
- +27 SET MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
- +28 SET MDFDA(702,"+1,",.03)=$PIECE($GET(^MDD(702,+MDI,0)),"^",3)
- +29 SET MDFDA(702,"+1,",.04)=$PIECE($GET(^MDD(702,+MDI,0)),"^",4)
- +30 SET MDFDA(702,"+1,",.05)=$PIECE($GET(^MDD(702,+MDI,0)),"^",5)
- +31 SET MDFDA(702,"+1,",.09)=0
- +32 SET MDFDA(702,"+1,",.11)=$PIECE($GET(^MDD(702,+MDI,0)),"^",11)
- +33 DO UPDATE^DIE("","MDFDA","","MDERR")
- KILL MDFDA
- +34 QUIT
