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 Oct 16, 2024@17:45:18 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
