SDECRRCLEANUP ;ALB/BLB/DMR SDEC RECALL REMINDERS CLEANUP ;June 9, 2021@11:35
;;5.3;Scheduling;**785**;;Build 14
;;
N %DT,BDATE,EDATE,Y,%ZIS
S %DT="AEX"
S (DEFAULTDATE,DDATETXT)=""
S DEFAULTDATE=$$GETDEFAULTDT(DEFAULTDATE)
S DDATETXT=$$FMTONET^SDECDATE(DEFAULTDATE,"N")
W !!,"Beginning date cannot be less than "_DDATETXT
W !
S %DT("A")="Enter the beginning date: "
D ^%DT
I $G(Y)=U Q
S BDATE=$G(Y)
I BDATE<DEFAULTDATE D
.W !!,"Beginning date set to default: "_DDATETXT
.S BDATE=DEFAULTDATE
W !
S %DT="AEX"
S %DT("A")="Enter the ending date: "
D ^%DT
I $G(Y)=U Q
S EDATE=$G(Y)
W !
I $G(Y)=U Q
;
PRINT ;
S %ZIS="Q" D ^%ZIS G:POP END
I $D(IO("Q")) S ZTRTN="RRRDATELOOP^SDECRRCLEANUP",ZTSAVE("*")="" D ^%ZTLOAD K ZTRTN,ZTSAVE G END
;I $D(IO("Q")) S ZTRTN="DRIVER^SDECRRCLEANUP",ZTSAVE("*")="" D ^%ZTLOAD K ZTRTN,ZTSAVE G END
I '$D(IO("Q")) U IO
D RRRDATELOOP
D END
Q
;
GETDEFAULTDT(DEFAULTDATE) ;
S (FIRSTARIEN,DEFAULTBDATE)=0
F S FIRSTARIEN=$O(^SDEC(409.85,FIRSTARIEN)) Q:DEFAULTBDATE'=0 D
.S DEFAULTBDATE=$P(^SDEC(409.85,FIRSTARIEN,0),"^",16)
Q DEFAULTBDATE
;
WRITE ;
N REC,CC,CCC S CCC=""
W !,"Recall Removed IEN ^ Patient Name^ Provider ^ Recall Date ^ Recall Clinic ^ Recall Type ^ Recall Appointment Date ^ Clinic ^ Comment"
S REC="" F S REC=$O(^TMP("CLEANUP",$J,REC)) Q:REC="" D
.S CC="" F S CC=$O(^TMP("CLEANUP",$J,REC,CC)) Q:CC="" D
..W !,^TMP("CLEANUP",$J,REC,CC)
..S CCC=CCC+1
W !,"Counter: "_CCC
G END
Q
END ;
D ^%ZISC
K ^TMP("CLEANUP",$J)
K APPTCLINIC,ARIEN,CANCELLED,COUNTER,DDATETXT,DEFAULTBDATE,FIRSTARIEN,IEN40984
K OPENAR,OPENCOMPAPPT,POP,RRIEN,RRRSTOPCODEN,SAMECLINIC,SAMESTOPCODE,SAVED,SDECAPPTIEN
K STATUS,WITHINRANGE,X1,X2,OPENRECALL
Q
RRRDATELOOP ;
N DELREAS,DFN,RRRCLINIC,RRRSTOPCODE,RRRCLINIC,ARRESOURCE,ARCLINIC,ARSTOPCODENUM
N ARSTOPCODE,RRCLINIC,RRSTOPCODENUM,RRSTOPCODE,DAYSETTING,APPTDATE
S FIRSTARIEN=0
W "THIS CAN TAKE A LONG TIME, PLEASE WAIT...",!
S COUNTER=1
I EDATE=-1 S EDATE=$P($$NOW^XLFDT,".",1)
F S BDATE=$O(^SD(403.56,"C",BDATE)) Q:BDATE>$G(EDATE) D
.S RRREMOVEDIEN=0
.F S RRREMOVEDIEN=$O(^SD(403.56,"C",BDATE,RRREMOVEDIEN)) Q:'RRREMOVEDIEN D
..Q:$$HASDELREASON(RRREMOVEDIEN)'=1
..S DFN=$$GET1^DIQ(403.56,RRREMOVEDIEN,.01,"I")
..S RRRCLINIC=$$GET1^DIQ(403.56,RRREMOVEDIEN,4.5,"I")
..S APPTCLINIC=$$GET1^DIQ(403.56,RRREMOVEDIEN,102,"I")
..S RRRSTOPCODEN=$$GET1^DIQ(44,RRRCLINIC,8,"I")
..S RRRSTOPCODE=$$GET1^DIQ(40.7,RRRSTOPCODEN,1,"I") ; amis stop code - 40.7, field 1
..Q:$$HASOPENAR(DFN)=1
..Q:$$HASOPENRECALL(DFN)=1
..Q:$$HASOPENCOMPAPT(DFN)=1
..Q:$$ALREADYSAVED(DFN)=1
..D SAVETOTMP
D WRITE
Q
;
HASDELREASON(RRREMOVEDIEN) ; CHECK RECALL REMINDER REMOVED DELETED REASON IS 6 (OTHER) OR 7 (SCHEDULED)
S DELREAS=0
S DELREAS=$$GET1^DIQ(403.56,RRREMOVEDIEN,203,"I")
I DELREAS=6!(DELREAS=7) D
.S DELREAS=1
Q DELREAS
;
GETRRRFIELDS(RRREMOVEDIEN) ; GET 403.56 (RECALL REMINDER REMOVED) FIELDS NEEDED
S DFN=$$GET1^DIQ(403.56,RRREMOVEDIEN,.01,"I")
S RRRCLINIC=$$GET1^DIQ(403.56,RRREMOVEDIEN,4.5,"I")
S RRRSTOPCODEN=$$GET1^DIQ(44,RRRCLINIC,8,"I")
S RRRSTOPCODE=$$GET1^DIQ(40.7,RRRSTOPCODEN,1,"I") ; amis stop code - 40.7, field 1
Q
;
;CHECK FOR AN OPEN 409.85 (SDEC APPT REQUEST) ENTRY AFTER RECALL DATE FROM 403.56 (RECALL REMINDER REMOVED) ENTRY
HASOPENAR(DFN) ;
N ARRESOURCE,ARCLINICIEN,ARSTOPCODENUM,ARSTOPCODE
S (OPENAR,ARIEN)=0
F S ARIEN=$O(^SDEC(409.85,"B",DFN,ARIEN)) Q:'ARIEN!(OPENAR=1) D
.I $$GET1^DIQ(409.85,ARIEN,23,"I")'="O" Q
.S ARCLINICIEN=$$GET1^DIQ(409.85,ARIEN,8,"I") ;Appointment resource/clinic
.I ARCLINICIEN'="" D
..S ARSTOPCODENUM=$$GET1^DIQ(44,ARCLINICIEN,8,"I")
..S ARSTOPCODE=$$GET1^DIQ(40.7,ARSTOPCODENUM,1,"I")
..I ARCLINICIEN=RRRCLINIC!(RRRSTOPCODE=ARSTOPCODE) D ;CHECKING TO SEE IF CLINIC OR STOP CODE MATCH FOR CLINIC SPECIFIC REQUEST
...S OPENAR=1
.I ARCLINICIEN="" D
..S ARSTOPCODENUM=$$GET1^DIQ(409.85,ARIEN,8.5,"I")
..S ARSTOPCODE=$$GET1^DIQ(40.7,ARSTOPCODENUM,1,"I")
..I ARSTOPCODE=RRRSTOPCODE D ;CHECK TO SEE IF STOP CODE MATCH FOR SERVICE REQUEST
...S OPENAR=1
Q OPENAR
;
HASOPENRECALL(DFN) ;
N RRCLINIC,RRSTOPCODENUM,RRSTOPCODE
S (OPENRECALL,RRIEN)=0
F S RRIEN=$O(^SD(403.5,"B",DFN,RRIEN)) Q:'RRIEN!(OPENRECALL=1) D
.S RRCLINIC=$$GET1^DIQ(403.5,RRIEN,4.5,"I")
.I RRRCLINIC=RRCLINIC S OPENRECALL=1 ; CHECKING FOR OPEN RECALL REMINDER FOR SAME CLINIC
.S RRSTOPCODENUM=$$GET1^DIQ(44,RRCLINIC,8,"I")
.S RRSTOPCODE=$$GET1^DIQ(40.7,RRSTOPCODENUM,1,"I")
.I RRRSTOPCODE=RRSTOPCODE S OPENRECALL=1 ; CHECKING FOR OPEN RECALL REMINDER FOR SAME STOPCODE
Q OPENRECALL
;
HASOPENCOMPAPT(DFN) ;
N STARTDATE
S STARTDATE=$$GETSTARTDATE(DFN)
S (OPENCOMPAPPT,SDECAPPTIEN)=0
F S SDECAPPTIEN=$O(^SDEC(409.84,"CPAT",DFN,SDECAPPTIEN)) Q:'SDECAPPTIEN D
.Q:$$ISCANCELLED(DFN)=1
.Q:$$ISDATEINRANGE(DFN)'=1
.Q:$$ISSAMESTOPCODE(DFN)'=1&($$ISSAMECLINIC(DFN)'=1)
.S OPENCOMPAPPT=1
Q OPENCOMPAPPT
;
GETSTARTDATE(DFN) ;
S DAYSETTING=45
S X1=BDATE,X2=-DAYSETTING D C^%DTC
S STARTDATE=X K X
S STARTDATE=STARTDATE-.5
Q STARTDATE
;
ISCANCELLED(DFN) ;
S CANCELLED=0
S STATUS=$$GET1^DIQ(409.84,SDECAPPTIEN,.17,"I")
I STATUS="C"!(STATUS="PC") S CANCELLED=1
Q CANCELLED
;
ISDATEINRANGE(DFN) ;
N APPTDATE
S WITHINRANGE=0
S APPTDATE=$$GET1^DIQ(409.84,SDECAPPTIEN,.01,"I")
I APPTDATE>STARTDATE S WITHINRANGE=1
Q WITHINRANGE
;
ISSAMESTOPCODE(DFN) ;
N APPTRESOURCE,APPTCLINICIEN,APPTSTOPCODEN,APPTSTOPCODE
S SAMESTOPCODE=0
S APPTRESOURCE=$$GET1^DIQ(409.84,SDECAPPTIEN,.07,"I")
S APPTCLINICIEN=$$GET1^DIQ(409.831,APPTRESOURCE,.04,"I")
S APPTSTOPCODEN=$$GET1^DIQ(44,APPTCLINICIEN,8,"I")
S APPTSTOPCODE=$$GET1^DIQ(40.7,APPTSTOPCODEN,1)
I APPTSTOPCODE=RRRSTOPCODE S SAMESTOPCODE=1
Q SAMESTOPCODE
;
ISSAMECLINIC(DFN) ;
N APPTRESOURCE,APPTCLINICIEN
S SAMECLINIC=0
S APPTRESOURCE=$$GET1^DIQ(409.84,SDECAPPTIEN,.07,"I")
S APPTCLINICIEN=$$GET1^DIQ(409.831,APPTRESOURCE,.04,"I")
I RRRCLINIC=APPTCLINICIEN!(APPTCLINIC=APPTCLINICIEN) S SAMECLINIC=1
Q SAMECLINIC
;
ALREADYSAVED(DFN) ;
S SAVED=0
I $D(^TMP("CLEANUP",$J,RRREMOVEDIEN)) S SAVED=1
Q SAVED
;
SAVETOTMP ;
N PROVIDER,RECALLCLINIC,RECALLDATE,TYPE,RECALLAPPTDT,COMMENT,CLINIC
S PROVIDER=$$GET1^DIQ(403.56,RRREMOVEDIEN,4,"E")
S RECALLCLINIC=$$GET1^DIQ(403.56,RRREMOVEDIEN,4.5,"E")
S RECALLDATE=$$GET1^DIQ(403.56,RRREMOVEDIEN,5,"E")
S TYPE=$$GET1^DIQ(403.56,RRREMOVEDIEN,3,"E")
S RECALLAPPTDT=$$GET1^DIQ(403.56,RRREMOVEDIEN,101,"E")
S COMMENT=$$GET1^DIQ(403.56,RRREMOVEDIEN,2.5,"E")
S APPTCLINIC=$$GET1^DIQ(403.56,RRREMOVEDIEN,102,"E")
S ^TMP("CLEANUP",$J,RRREMOVEDIEN,COUNTER)=RRREMOVEDIEN_"^"_$$GET1^DIQ(2,DFN,.01,"E")_"^"_PROVIDER_"^"_RECALLDATE_"^"_RECALLCLINIC_"^"_TYPE_"^"_RECALLAPPTDT_"^"_APPTCLINIC_"^"_COMMENT
S COUNTER=COUNTER+1
Q
;
FINDMISMATCH ;
K ^TMP("MISMATCH")
N REC40984,RESOURCE,CLINIC1,DFN,APPTDATETIME,APPTDT44,REC44APPT0,IEN44PATIENT
S STARTDATE=3170418
S (IEN40984,CC)=0
S CCC=1
F S IEN40984=$O(^SDEC(409.84,IEN40984)) Q:'IEN40984 D
.Q:$$GET1^DIQ(409.84,IEN40984,.17,"I")'="C"
.S REC40984=^SDEC(409.84,IEN40984,0)
.S RESOURCE=$P(REC40984,"^",7)
.S CLINIC1=""
.S CLINIC1=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
.S DFN=$$GET1^DIQ(409.84,IEN40984,.05,"I")
.S APPTDATETIME=$P(REC40984,"^",1)
.S APPTDT44=APPTDATETIME
.F S CC=$O(^SC(CLINIC1,"S",APPTDT44,1,CC)) Q:'CC D
..S REC44APPT0=^SC(CLINIC1,"S",APPTDT44,1,CC,0)
..S IEN44PATIENT=$P(REC44APPT0,"^",1)
..Q:IEN44PATIENT'=DFN
..Q:APPTDT44'=APPTDATETIME
..Q:$P(REC44APPT0,"^",9)="C"
..S ^TMP("MISMATCH",$J,CCC)=IEN40984_"^"_IEN44PATIENT_"^"_APPTDATETIME_"^"_CLINIC1
..S CCC=CCC+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECRRCLEANUP 7750 printed Oct 16, 2024@18:53:09 Page 2
SDECRRCLEANUP ;ALB/BLB/DMR SDEC RECALL REMINDERS CLEANUP ;June 9, 2021@11:35
+1 ;;5.3;Scheduling;**785**;;Build 14
+2 ;;
+3 NEW %DT,BDATE,EDATE,Y,%ZIS
+4 SET %DT="AEX"
+5 SET (DEFAULTDATE,DDATETXT)=""
+6 SET DEFAULTDATE=$$GETDEFAULTDT(DEFAULTDATE)
+7 SET DDATETXT=$$FMTONET^SDECDATE(DEFAULTDATE,"N")
+8 WRITE !!,"Beginning date cannot be less than "_DDATETXT
+9 WRITE !
+10 SET %DT("A")="Enter the beginning date: "
+11 DO ^%DT
+12 IF $GET(Y)=U
QUIT
+13 SET BDATE=$GET(Y)
+14 IF BDATE<DEFAULTDATE
Begin DoDot:1
+15 WRITE !!,"Beginning date set to default: "_DDATETXT
+16 SET BDATE=DEFAULTDATE
End DoDot:1
+17 WRITE !
+18 SET %DT="AEX"
+19 SET %DT("A")="Enter the ending date: "
+20 DO ^%DT
+21 IF $GET(Y)=U
QUIT
+22 SET EDATE=$GET(Y)
+23 WRITE !
+24 IF $GET(Y)=U
QUIT
+25 ;
PRINT ;
+1 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO END
+2 IF $DATA(IO("Q"))
SET ZTRTN="RRRDATELOOP^SDECRRCLEANUP"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
KILL ZTRTN,ZTSAVE
GOTO END
+3 ;I $D(IO("Q")) S ZTRTN="DRIVER^SDECRRCLEANUP",ZTSAVE("*")="" D ^%ZTLOAD K ZTRTN,ZTSAVE G END
+4 IF '$DATA(IO("Q"))
USE IO
+5 DO RRRDATELOOP
+6 DO END
+7 QUIT
+8 ;
GETDEFAULTDT(DEFAULTDATE) ;
+1 SET (FIRSTARIEN,DEFAULTBDATE)=0
+2 FOR
SET FIRSTARIEN=$ORDER(^SDEC(409.85,FIRSTARIEN))
if DEFAULTBDATE'=0
QUIT
Begin DoDot:1
+3 SET DEFAULTBDATE=$PIECE(^SDEC(409.85,FIRSTARIEN,0),"^",16)
End DoDot:1
+4 QUIT DEFAULTBDATE
+5 ;
WRITE ;
+1 NEW REC,CC,CCC
SET CCC=""
+2 WRITE !,"Recall Removed IEN ^ Patient Name^ Provider ^ Recall Date ^ Recall Clinic ^ Recall Type ^ Recall Appointment Date ^ Clinic ^ Comment"
+3 SET REC=""
FOR
SET REC=$ORDER(^TMP("CLEANUP",$JOB,REC))
if REC=""
QUIT
Begin DoDot:1
+4 SET CC=""
FOR
SET CC=$ORDER(^TMP("CLEANUP",$JOB,REC,CC))
if CC=""
QUIT
Begin DoDot:2
+5 WRITE !,^TMP("CLEANUP",$JOB,REC,CC)
+6 SET CCC=CCC+1
End DoDot:2
End DoDot:1
+7 WRITE !,"Counter: "_CCC
+8 GOTO END
+9 QUIT
END ;
+1 DO ^%ZISC
+2 KILL ^TMP("CLEANUP",$JOB)
+3 KILL APPTCLINIC,ARIEN,CANCELLED,COUNTER,DDATETXT,DEFAULTBDATE,FIRSTARIEN,IEN40984
+4 KILL OPENAR,OPENCOMPAPPT,POP,RRIEN,RRRSTOPCODEN,SAMECLINIC,SAMESTOPCODE,SAVED,SDECAPPTIEN
+5 KILL STATUS,WITHINRANGE,X1,X2,OPENRECALL
+6 QUIT
RRRDATELOOP ;
+1 NEW DELREAS,DFN,RRRCLINIC,RRRSTOPCODE,RRRCLINIC,ARRESOURCE,ARCLINIC,ARSTOPCODENUM
+2 NEW ARSTOPCODE,RRCLINIC,RRSTOPCODENUM,RRSTOPCODE,DAYSETTING,APPTDATE
+3 SET FIRSTARIEN=0
+4 WRITE "THIS CAN TAKE A LONG TIME, PLEASE WAIT...",!
+5 SET COUNTER=1
+6 IF EDATE=-1
SET EDATE=$PIECE($$NOW^XLFDT,".",1)
+7 FOR
SET BDATE=$ORDER(^SD(403.56,"C",BDATE))
if BDATE>$GET(EDATE)
QUIT
Begin DoDot:1
+8 SET RRREMOVEDIEN=0
+9 FOR
SET RRREMOVEDIEN=$ORDER(^SD(403.56,"C",BDATE,RRREMOVEDIEN))
if 'RRREMOVEDIEN
QUIT
Begin DoDot:2
+10 if $$HASDELREASON(RRREMOVEDIEN)'=1
QUIT
+11 SET DFN=$$GET1^DIQ(403.56,RRREMOVEDIEN,.01,"I")
+12 SET RRRCLINIC=$$GET1^DIQ(403.56,RRREMOVEDIEN,4.5,"I")
+13 SET APPTCLINIC=$$GET1^DIQ(403.56,RRREMOVEDIEN,102,"I")
+14 SET RRRSTOPCODEN=$$GET1^DIQ(44,RRRCLINIC,8,"I")
+15 ; amis stop code - 40.7, field 1
SET RRRSTOPCODE=$$GET1^DIQ(40.7,RRRSTOPCODEN,1,"I")
+16 if $$HASOPENAR(DFN)=1
QUIT
+17 if $$HASOPENRECALL(DFN)=1
QUIT
+18 if $$HASOPENCOMPAPT(DFN)=1
QUIT
+19 if $$ALREADYSAVED(DFN)=1
QUIT
+20 DO SAVETOTMP
End DoDot:2
End DoDot:1
+21 DO WRITE
+22 QUIT
+23 ;
HASDELREASON(RRREMOVEDIEN) ; CHECK RECALL REMINDER REMOVED DELETED REASON IS 6 (OTHER) OR 7 (SCHEDULED)
+1 SET DELREAS=0
+2 SET DELREAS=$$GET1^DIQ(403.56,RRREMOVEDIEN,203,"I")
+3 IF DELREAS=6!(DELREAS=7)
Begin DoDot:1
+4 SET DELREAS=1
End DoDot:1
+5 QUIT DELREAS
+6 ;
GETRRRFIELDS(RRREMOVEDIEN) ; GET 403.56 (RECALL REMINDER REMOVED) FIELDS NEEDED
+1 SET DFN=$$GET1^DIQ(403.56,RRREMOVEDIEN,.01,"I")
+2 SET RRRCLINIC=$$GET1^DIQ(403.56,RRREMOVEDIEN,4.5,"I")
+3 SET RRRSTOPCODEN=$$GET1^DIQ(44,RRRCLINIC,8,"I")
+4 ; amis stop code - 40.7, field 1
SET RRRSTOPCODE=$$GET1^DIQ(40.7,RRRSTOPCODEN,1,"I")
+5 QUIT
+6 ;
+7 ;CHECK FOR AN OPEN 409.85 (SDEC APPT REQUEST) ENTRY AFTER RECALL DATE FROM 403.56 (RECALL REMINDER REMOVED) ENTRY
HASOPENAR(DFN) ;
+1 NEW ARRESOURCE,ARCLINICIEN,ARSTOPCODENUM,ARSTOPCODE
+2 SET (OPENAR,ARIEN)=0
+3 FOR
SET ARIEN=$ORDER(^SDEC(409.85,"B",DFN,ARIEN))
if 'ARIEN!(OPENAR=1)
QUIT
Begin DoDot:1
+4 IF $$GET1^DIQ(409.85,ARIEN,23,"I")'="O"
QUIT
+5 ;Appointment resource/clinic
SET ARCLINICIEN=$$GET1^DIQ(409.85,ARIEN,8,"I")
+6 IF ARCLINICIEN'=""
Begin DoDot:2
+7 SET ARSTOPCODENUM=$$GET1^DIQ(44,ARCLINICIEN,8,"I")
+8 SET ARSTOPCODE=$$GET1^DIQ(40.7,ARSTOPCODENUM,1,"I")
+9 ;CHECKING TO SEE IF CLINIC OR STOP CODE MATCH FOR CLINIC SPECIFIC REQUEST
IF ARCLINICIEN=RRRCLINIC!(RRRSTOPCODE=ARSTOPCODE)
Begin DoDot:3
+10 SET OPENAR=1
End DoDot:3
End DoDot:2
+11 IF ARCLINICIEN=""
Begin DoDot:2
+12 SET ARSTOPCODENUM=$$GET1^DIQ(409.85,ARIEN,8.5,"I")
+13 SET ARSTOPCODE=$$GET1^DIQ(40.7,ARSTOPCODENUM,1,"I")
+14 ;CHECK TO SEE IF STOP CODE MATCH FOR SERVICE REQUEST
IF ARSTOPCODE=RRRSTOPCODE
Begin DoDot:3
+15 SET OPENAR=1
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT OPENAR
+17 ;
HASOPENRECALL(DFN) ;
+1 NEW RRCLINIC,RRSTOPCODENUM,RRSTOPCODE
+2 SET (OPENRECALL,RRIEN)=0
+3 FOR
SET RRIEN=$ORDER(^SD(403.5,"B",DFN,RRIEN))
if 'RRIEN!(OPENRECALL=1)
QUIT
Begin DoDot:1
+4 SET RRCLINIC=$$GET1^DIQ(403.5,RRIEN,4.5,"I")
+5 ; CHECKING FOR OPEN RECALL REMINDER FOR SAME CLINIC
IF RRRCLINIC=RRCLINIC
SET OPENRECALL=1
+6 SET RRSTOPCODENUM=$$GET1^DIQ(44,RRCLINIC,8,"I")
+7 SET RRSTOPCODE=$$GET1^DIQ(40.7,RRSTOPCODENUM,1,"I")
+8 ; CHECKING FOR OPEN RECALL REMINDER FOR SAME STOPCODE
IF RRRSTOPCODE=RRSTOPCODE
SET OPENRECALL=1
End DoDot:1
+9 QUIT OPENRECALL
+10 ;
HASOPENCOMPAPT(DFN) ;
+1 NEW STARTDATE
+2 SET STARTDATE=$$GETSTARTDATE(DFN)
+3 SET (OPENCOMPAPPT,SDECAPPTIEN)=0
+4 FOR
SET SDECAPPTIEN=$ORDER(^SDEC(409.84,"CPAT",DFN,SDECAPPTIEN))
if 'SDECAPPTIEN
QUIT
Begin DoDot:1
+5 if $$ISCANCELLED(DFN)=1
QUIT
+6 if $$ISDATEINRANGE(DFN)'=1
QUIT
+7 if $$ISSAMESTOPCODE(DFN)'=1&($$ISSAMECLINIC(DFN)'=1)
QUIT
+8 SET OPENCOMPAPPT=1
End DoDot:1
+9 QUIT OPENCOMPAPPT
+10 ;
GETSTARTDATE(DFN) ;
+1 SET DAYSETTING=45
+2 SET X1=BDATE
SET X2=-DAYSETTING
DO C^%DTC
+3 SET STARTDATE=X
KILL X
+4 SET STARTDATE=STARTDATE-.5
+5 QUIT STARTDATE
+6 ;
ISCANCELLED(DFN) ;
+1 SET CANCELLED=0
+2 SET STATUS=$$GET1^DIQ(409.84,SDECAPPTIEN,.17,"I")
+3 IF STATUS="C"!(STATUS="PC")
SET CANCELLED=1
+4 QUIT CANCELLED
+5 ;
ISDATEINRANGE(DFN) ;
+1 NEW APPTDATE
+2 SET WITHINRANGE=0
+3 SET APPTDATE=$$GET1^DIQ(409.84,SDECAPPTIEN,.01,"I")
+4 IF APPTDATE>STARTDATE
SET WITHINRANGE=1
+5 QUIT WITHINRANGE
+6 ;
ISSAMESTOPCODE(DFN) ;
+1 NEW APPTRESOURCE,APPTCLINICIEN,APPTSTOPCODEN,APPTSTOPCODE
+2 SET SAMESTOPCODE=0
+3 SET APPTRESOURCE=$$GET1^DIQ(409.84,SDECAPPTIEN,.07,"I")
+4 SET APPTCLINICIEN=$$GET1^DIQ(409.831,APPTRESOURCE,.04,"I")
+5 SET APPTSTOPCODEN=$$GET1^DIQ(44,APPTCLINICIEN,8,"I")
+6 SET APPTSTOPCODE=$$GET1^DIQ(40.7,APPTSTOPCODEN,1)
+7 IF APPTSTOPCODE=RRRSTOPCODE
SET SAMESTOPCODE=1
+8 QUIT SAMESTOPCODE
+9 ;
ISSAMECLINIC(DFN) ;
+1 NEW APPTRESOURCE,APPTCLINICIEN
+2 SET SAMECLINIC=0
+3 SET APPTRESOURCE=$$GET1^DIQ(409.84,SDECAPPTIEN,.07,"I")
+4 SET APPTCLINICIEN=$$GET1^DIQ(409.831,APPTRESOURCE,.04,"I")
+5 IF RRRCLINIC=APPTCLINICIEN!(APPTCLINIC=APPTCLINICIEN)
SET SAMECLINIC=1
+6 QUIT SAMECLINIC
+7 ;
ALREADYSAVED(DFN) ;
+1 SET SAVED=0
+2 IF $DATA(^TMP("CLEANUP",$JOB,RRREMOVEDIEN))
SET SAVED=1
+3 QUIT SAVED
+4 ;
SAVETOTMP ;
+1 NEW PROVIDER,RECALLCLINIC,RECALLDATE,TYPE,RECALLAPPTDT,COMMENT,CLINIC
+2 SET PROVIDER=$$GET1^DIQ(403.56,RRREMOVEDIEN,4,"E")
+3 SET RECALLCLINIC=$$GET1^DIQ(403.56,RRREMOVEDIEN,4.5,"E")
+4 SET RECALLDATE=$$GET1^DIQ(403.56,RRREMOVEDIEN,5,"E")
+5 SET TYPE=$$GET1^DIQ(403.56,RRREMOVEDIEN,3,"E")
+6 SET RECALLAPPTDT=$$GET1^DIQ(403.56,RRREMOVEDIEN,101,"E")
+7 SET COMMENT=$$GET1^DIQ(403.56,RRREMOVEDIEN,2.5,"E")
+8 SET APPTCLINIC=$$GET1^DIQ(403.56,RRREMOVEDIEN,102,"E")
+9 SET ^TMP("CLEANUP",$JOB,RRREMOVEDIEN,COUNTER)=RRREMOVEDIEN_"^"_$$GET1^DIQ(2,DFN,.01,"E")_"^"_PROVIDER_"^"_RECALLDATE_"^"_RECALLCLINIC_"^"_TYPE_"^"_RECALLAPPTDT_"^"_APPTCLINIC_"^"_COMMENT
+10 SET COUNTER=COUNTER+1
+11 QUIT
+12 ;
FINDMISMATCH ;
+1 KILL ^TMP("MISMATCH")
+2 NEW REC40984,RESOURCE,CLINIC1,DFN,APPTDATETIME,APPTDT44,REC44APPT0,IEN44PATIENT
+3 SET STARTDATE=3170418
+4 SET (IEN40984,CC)=0
+5 SET CCC=1
+6 FOR
SET IEN40984=$ORDER(^SDEC(409.84,IEN40984))
if 'IEN40984
QUIT
Begin DoDot:1
+7 if $$GET1^DIQ(409.84,IEN40984,.17,"I")'="C"
QUIT
+8 SET REC40984=^SDEC(409.84,IEN40984,0)
+9 SET RESOURCE=$PIECE(REC40984,"^",7)
+10 SET CLINIC1=""
+11 SET CLINIC1=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
+12 SET DFN=$$GET1^DIQ(409.84,IEN40984,.05,"I")
+13 SET APPTDATETIME=$PIECE(REC40984,"^",1)
+14 SET APPTDT44=APPTDATETIME
+15 FOR
SET CC=$ORDER(^SC(CLINIC1,"S",APPTDT44,1,CC))
if 'CC
QUIT
Begin DoDot:2
+16 SET REC44APPT0=^SC(CLINIC1,"S",APPTDT44,1,CC,0)
+17 SET IEN44PATIENT=$PIECE(REC44APPT0,"^",1)
+18 if IEN44PATIENT'=DFN
QUIT
+19 if APPTDT44'=APPTDATETIME
QUIT
+20 if $PIECE(REC44APPT0,"^",9)="C"
QUIT
+21 SET ^TMP("MISMATCH",$JOB,CCC)=IEN40984_"^"_IEN44PATIENT_"^"_APPTDATETIME_"^"_CLINIC1
+22 SET CCC=CCC+1
End DoDot:2
End DoDot:1
+23 QUIT
