SDECDATA ;ALB/WTC - VISTA SCHEDULING GUI ; 01 May 2019 10:52 AM
;;5.3;Scheduling;**723,731**;;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified
Q
;
; ICR
; ---
; 7030 - #2 Appointment data
; 10035 - #2 Patient demographics
;
REPORT ;
;
; Run report only
;
N AUTO,REPORT,POP,IO,%ZIS ;
S REPORT="YES",AUTO="NO" ;
S %ZIS="Q" D ^%ZIS Q:POP ; Added code to output to printer. wtc 9/12/2019
D APPT1 Q ;
;
AUTO ;
;
; Run correction code non-interactively.
;
N AUTO,REPORT S REPORT="NO",AUTO="YES" D APPT1 Q ;
;
APPT ;
;
; Scan appointment file (#409.84) for entries without resources. Identify correct resource using appointment list in patient file (#2).
;
N AUTO,REPORT S REPORT="NO",AUTO="NO" ;
;
APPT1 ;
;
N DA,APPTDATA,CNT,STARTTIME,DFN,CANCELLED,APPTMADE,MADEBY,PTDATA,FAILED,CLINICSFND,CLINIC,DA1,RESOURCE,MATCHED,RESPONSE,STOP,FIXED,LOCDATA,D2,%DT,PTR44,Y ;
;
; DA = Appointment (#409.84) pointer
; APPTDATA = Zero node of appointment file entry (#409.84)
; CNT = Number of appointments with missing resources found
; STARTTIME = Appointment start time
; DFN = Patient (#2) pointer
; CANCELLED = Appointment cancelled flag (from #409.84)
; APPTMADE = Date appointment was made (from #409.84)
; MADEBY = DUZ of person making appointment (from #409.84)
; PTDATA = Appointment data record from patient file (#2)
; FAILED = Total number of appointment records that could not be matched
; CLINICFND = Array indexed by clinic name of appointment records matched with patient appointments
; CLINIC = Clinic name (.01 field of file #44)
; DA1 = Appointment (#409.84) pointer
; RESOURCE = Resource (#409.831) pointer
; MATCHED = 1 if a second appointment for same patient at same time in the same clinic is found, 0 otherwise
; RESPONSE = User response
; STOP = 1 if user enters ^ to stop processing or time out occurs
; FIXED = Count of number of appointment records updated
; LOCDATA = Appointment data record from the location file (#44)
; D2 = Subscript in appointment multiple in location file (#44)
; PTR44 = Hospital location (pointer to #44)
;
U 0 W !!,"Appointments without resources checker",! ;
;
S CNT=0,FAILED=0,STOP=0,FIXED=0 ;
;
; Scan is in date order starting with the user indicated date.
;
U 0 W !,"Select starting date to check",! ;
S %DT="AX" D ^%DT Q:Y<0 S STARTTIME=$P(Y,".",1) W ! ;
;
; If report is queued, set up variables and call Task Manager then quit
;
I REPORT="YES",$D(IO("Q")) D Q ;
. S ZTRTN="APPT2^SDECDATA",ZTDESC="Appointments missing resources starting from "_$$FMTE^XLFDT(STARTTIME) ;
. S ZTSAVE("*")="" ;
. D ^%ZTLOAD W $S($D(ZTSK):"...Task queued",1:"...Task cancelled"),! ;
;
APPT2 ; Entry point for queued report printing
;
; Scan appointment file in date order.
;
F S STARTTIME=$O(^SDEC(409.84,"B",STARTTIME)) Q:'STARTTIME Q:STOP S DA=0 F S DA=$O(^SDEC(409.84,"B",STARTTIME,DA)) Q:'DA S APPTDATA=^SDEC(409.84,DA,0) I $P(APPTDATA,U,7)="" S CNT=CNT+1 D Q:STOP ;
. ;
. S DFN=$P(APPTDATA,U,5),CANCELLED=$S($P(APPTDATA,U,12)="":0,1:1),APPTMADE=$P(APPTDATA,U,9),MADEBY=$P(APPTDATA,U,8) ;
. U:REPORT="YES" IO W !,CNT,". ",$$FMTE^XLFDT(STARTTIME)," (",DA,") ",$P(^DPT(DFN,0),U,1) ; ICR 10035
. ;
. ; Find appointment in patient file.
. ;
. I '$D(^DPT(DFN,"S",STARTTIME,0)) W " *** No matching appointment in Patient file.",! S FAILED=FAILED+1 Q ;
. S PTDATA=^DPT(DFN,"S",STARTTIME,0),PTR44=$P(PTDATA,U,1),CLINIC=$P(^SC(PTR44,0),U,1) W " ",CLINIC,! ; ICR 7030
. S CLINICSFND(CLINIC)=$G(CLINICSFND(CLINIC))+1 ;
. ;
. ; Find appointment in location file.
. ;
. S D2=0,LOCDATA="" F S D2=$O(^SC(PTR44,"S",STARTTIME,1,D2)) Q:'D2 I $P(^(D2,0),U,1)=DFN D Q:LOCDATA'="" ;
.. S LOCDATA=^SC(PTR44,"S",STARTTIME,1,D2,0) ;
.. I $P(LOCDATA,U,6)'=$P(PTDATA,U,18) S LOCDATA="" Q ; Appointment made by do not match. Continue looking.
.. I $P(LOCDATA,U,7)'=$P(PTDATA,U,19) S LOCDATA="" Q ; Date appointment made do not match. Continue looking.
.. I $P(PTDATA,U,2)="C"!($P(PTDATA,U,2)="PC"),$P(LOCDATA,U,9)="C" Q ; Both appointments are cancelled. Matching appointment found.
.. I $P(PTDATA,U,2)'="C",$P(PTDATA,U,2)'="PC",$P(LOCDATA,U,9)'="C" Q ; Both appointments are not cancelled. Matching appointment found.
.. S LOCDATA="" ; Not a match. Continue looking.
. ;
. W !,"Source",?15,"Status",?30,"Date Made",?45,"Made by",! ;
. W "-----------",?15,"---------",?30,"------------",?45,"-----------------------------",! ;
. W "Patient",?15,$S($P(PTDATA,U,2)="C"!($P(PTDATA,U,2)="PC"):"Cancelled",1:"Active"),?30,$$FMTE^XLFDT($P(PTDATA,U,19)),?45,$$GET1^DIQ(200,$P(PTDATA,U,18)_",",.01),! ;
. I LOCDATA="" W "Location",?15,"NOT IN FILE",! ;
. E W "Location",?15,$S($P(LOCDATA,U,9)="C":"Cancelled",1:"Active"),?30,$$FMTE^XLFDT($P(LOCDATA,U,7)),?45,$$GET1^DIQ(200,$P(LOCDATA,U,6)_",",.01),! ;
. W "Appointment",?15,$S(CANCELLED:"Cancelled",1:"Active"),?30,$$FMTE^XLFDT(APPTMADE),?45,$$GET1^DIQ(200,MADEBY_",",.01),! ;
. ;
. ; Stop if patient appointment is active but no matching appointment in Location file.
. ;
. I $P(PTDATA,U,2)'="C",$P(PTDATA,U,2)'="PC",LOCDATA="" W !,"Active appointment in Patient file not in Location file." S FAILED=FAILED+1 Q ;
. ;
. ; Determine if another appointment file entry is for the same time
. ;
. S DA1=0,MATCHED=0 F S DA1=$O(^SDEC(409.84,"CPAT",DFN,DA1)) Q:'DA1 I DA1'=DA D Q:MATCHED ;
.. ;
.. Q:$P(^SDEC(409.84,DA1,0),U,1)'=STARTTIME W !,"*** Another appointment exists for the patient at the same time.",! S FAILED=FAILED+1,MATCHED=1 ;
.. ;
. Q:MATCHED ;
. ;
. ; If patient appointment and location appointment is cancelled but appointment file entry is NOT cancelled, fix the appointment file entry. 731 wtc 7/25/2019
. ;
. ;I $P(PTDATA,U,2)="C"!($P(PTDATA,U,2)="PC"),$P(LOCDATA,U,9)="C",'CANCELLED S FAILED=FAILED+1 Q ;
. ;
. ; Do not match appointments if not made by same person on same day.
. ; Do not match appointments if patient and location file do not agree or patient file is active but location file does not exist.
. ;
. I $P(PTDATA,U,2)'="C",$P(PTDATA,U,2)'="PC",LOCDATA=""!($P(LOCDATA,U,9)="C") S FAILED=FAILED+1 Q ;
. ;
. ; Do not fail matching due to appointment made by and date appointment made. 731 wtc 8/6/2019
. ;
. ;I $P(PTDATA,U,19)'=$P(APPTMADE,".",1) S FAILED=FAILED+1 Q ;
. ;I $P(PTDATA,U,18)'=MADEBY S FAILED=FAILED+1 Q ;
. ;
. ; OK to correct if patient file is active but appointment file is cancelled.
. ;
. ;I $P(PTDATA,U,2)'="C",$P(PTDATA,U,2)'="PC",CANCELLED S FAILED=FAILED+1 Q ;
. ;
. ; Stop if report only
. ;
. I REPORT="YES" Q ;
. ;
. ; Check resource file for entry matching the clinic name. If one does not exist, notify user but do not process a change for the appointment.
. ;
. S RESOURCE=$O(^SDEC(409.831,"B",CLINIC,0)) ;
. I 'RESOURCE W !,"No resource exists with the name '",CLINIC,"'.",!,"Create the required resource before updating this appointment.",! Q ;
. I $P($G(^SDEC(409.831,RESOURCE,0)),U,4)'=PTR44 W !,"Resource not associated with ",CLINIC,". Correct this before updating this appointment.",! Q ;
. ;
. ; If automatics option selected, update the appointment.
. ;
. ; Added 2 parameters to UPDAPPT call to allow matching if patient file appointment is cancelled but appointment file entry is not. 731 wtc 7/26/2019
. ;
. I AUTO="YES" D UPDAPPT(DA,RESOURCE,$P(PTDATA,U,2),CANCELLED) W "...updated",! S FIXED=FIXED+1 Q ;
. ;
. ; For manual processing, ask user if he/she wants to update Appointment file with resource of same name as clinic.
. ;
. W !,"Make '",CLINIC,"' the resource for this appointment?" R " NO// ",RESPONSE:$S($G(DTIME):DTIME,1:180) I '$T!(RESPONSE="^") S STOP=1 Q ;
. ;
. ; Added 2 parameters to UPDAPPT call to allow matching if patient file appointment is cancelled but appointment file entry is not. 731 wtc 7/26/2019
. ;
. I RESPONSE="YES"!(RESPONSE="Y")!(RESPONSE="yes")!(RESPONSE="y") D UPDAPPT(DA,RESOURCE,$P(PTDATA,U,2),CANCELLED) W "...updated",! S FIXED=FIXED+1 Q ;
. ;
. W "... skipped",! Q ;
;
I 'CNT Q:REPORT="NO" D ^%ZISC K ZTDESC,ZTRTN,ZTSAVE,ZTSK Q ; No bad entries found. Do not output statistics.
;
; Output statistics. Show total found, number fixed and number that could not be fixed.
;
W !,"TOTAL FOUND: ",CNT,!,"FIXES MADE: ",FIXED,!,"FAILED TO MATCH: ",FAILED,!,"MATCHING PERCENTAGE: ",$J(CNT-FAILED/CNT*100,4,1),"%",! ;
W !,"MISSING CLINICS MATCHED TO: " ;
S CLINIC="" F S CLINIC=$O(CLINICSFND(CLINIC)) Q:CLINIC="" W ?30,CLINIC,?62,$J(CLINICSFND(CLINIC),$L(CNT))," = ",$J(CLINICSFND(CLINIC)/CNT*100,4,1),"%",! ;
;
I REPORT="YES" D ^%ZISC K ZTDESC,ZTRTN,ZTSAVE,ZTSK ;
Q ;
;
UPDAPPT(APPT,RESOURCE,PTCANFLG,APPTCAN) ; Added last 2 parameters - 731 wtc 7/25/2019
;
; APPT = Appointment (pointer to #409.84) [REQUIRED]
; RESOURCE = Resource (pointer to #409.831) [REQUIRED]
; PTCANFLG = Patient appointment status (see field #1 in the appointment multiple in the patient file) [REQUIRED]
; APPTCAN = Appointment cancelled (1) or active (2). [REQUIRED]
;
Q:$G(APPT)="" Q:$G(RESOURCE)="" Q:$G(APPTCAN)="" ;
;
N DIE,DA,DR ;
;
; Assign resource to appointment file entry
;
S DIE=409.84,DA=APPT,DR=".07///"_RESOURCE ;
;
; If patient appointment cancelled but appointment entry not cancelled, cancel the appointment entry. 731 wtc 7/26/2019
;
I PTCANFLG="C"!(PTCANFLG="PC"),'APPTCAN D ;
. ;
. ; Get cancellation data from patient appointment and file in appointment file. WTC 9/10/2019
. ;
. N DATA,DFN,DTTM ;
. S DATA=^SDEC(409.84,APPT,0),DFN=$P(DATA,U,5),DTTM=$P(DATA,U,1) ;
. S DATA=^DPT(DFN,"S",DTTM,0) ;
. S DR=DR_";.12///"_$S($P(DATA,U,14):"^S X="_$P(DATA,U,14),1:"NOW")_";.121///^S X="_$S($P(DATA,U,12):$P(DATA,U,12),1:DUZ) ;
. S DR=DR_";.122///^S X="_$S($P(DATA,U,15):$P(DATA,U,15),1:11)_";.17///^S X="_$C(34)_PTCANFLG_$C(34) ;
;
; If patient appointment is active but appointment entry is cancelled, activate the appointment entry. 731 wtc 729/2019
;
I PTCANFLG'="C",PTCANFLG'="PC",APPTCAN S DR=DR_";.12///@;.121///@;.122///@;.17///@" ;
;
D ^DIE ;
Q ;
;
PTAPTINQ ;
;
; Display appointments for a patient and date range
;
N DIC,Y,DFN,START,END,%DT ;
;
S DIC(0)="AEQM",DIC=2 D ^DIC Q:Y<0 S DFN=+Y ;
;
K %DT(0) S %DT="AEP",%DT("A")="Start date: " D ^%DT Q:Y<0 S START=Y ;
S %DT="AEP",%DT("A")="End date: ",%DT(0)=START D ^%DT Q:Y<0 S END=Y+1 ;
;
W !,"Patient: ",$$GET1^DIQ(2,DFN_",",.01)," (",DFN,")",! ;
W "Appt Date/Time",?20,"Location",?50,"Status",!! ;
S STARTTIME=START F S STARTTIME=$O(^DPT(DFN,"S",STARTTIME)) Q:'STARTTIME Q:STARTTIME>END S X=^(STARTTIME,0) D ; ICR 7030
. ;
. W $$FMTE^XLFDT(STARTTIME),?20,$$GET1^DIQ(44,$P(X,U,1)_",",.01),?50,$$SETOFCODES(2.98,3,$P(X,U,2)),! ;
;
Q ;
;
SETOFCODES(FILE,FIELD,VALUE) ;
;
N DD,VALUES,RETURN,I ;
;
S DD=^DD(FILE,FIELD,0),VALUES=$P(DD,U,3),RETURN="" ;
F I=1:1 Q:$P(VALUES,";",I,99)="" I $P($P(VALUES,";",I),":",1)=VALUE S RETURN=$P($P(VALUES,";",I),":",2) Q ;
Q RETURN ;
;
MISMATCH ;
;
; Find encounters whose status does not match with the appointment status.
;
N DFN,D1,ENCOUNTER,APPTDATA,ENCDATA,X,Y,START,NAME,COUNT ;
;
K %DT S %DT="AEP",%DT("A")="Start date: " D ^%DT Q:Y<0 S START=Y W !! ;
;
S NAME="" F S NAME=$O(^DPT("B",NAME)) Q:NAME="" S DFN=0 F S DFN=$O(^DPT("B",NAME,DFN)) Q:'DFN S D1=START-1 F S D1=$O(^DPT(DFN,"S",D1)) Q:'D1 S APPTDATA=^(D1,0),ENCOUNTER=$P(APPTDATA,U,20) I ENCOUNTER'="" D ; ICR 7030
. ;
. ; Compare status
. ;
. S X=$P(APPTDATA,U,2),Y=$$GET1^DIQ(409.68,ENCOUNTER_",",.12,"I") ;
. I X="",Y=1!(Y=2) Q ; Checked in or checked out
. I X="",Y=12 Q ; Non-count
. I X="",Y=14 Q ; Action required
. I X="N",Y=4 Q ; No show
. I X="C",Y=5 Q ; Cancelled by clinic
. I X="NA",Y=6 Q ; No show and auto-rebook
. I X="CA",Y=7 Q ; Cancelled by clinic and auto re-book
. I X="I",Y=8 Q ; Inpatient
. I X="PC",Y=9 Q ; Cancelled by patient
. I X="PCA",Y=10 Q ; Cancelled by patient and auto re-book
. I X="NT",Y=3 Q ; No action taken
. ;W $$GET1^DIQ(2,DFN_",",.01),?30,$$FMTE^XLFDT(D1),?50,"APPT: ",$$SETOFCODES(2.98,3,X),! ;
. W NAME,?30,$$FMTE^XLFDT(D1),?50,"APPT: " W:X'="" $$SETOFCODES(2.98,3,X) W ! ;
. W ?50," ENC: " W:Y'="" $$GET1^DIQ(409.63,Y_",",.01) W !! ;
. I X="" S X="NULL" ;
. I Y="" S Y="NULL" ;
. S COUNT(X,Y)=$G(COUNT(X,Y))+1 ;
;
TOTALS ;
W !!,"APPOINTMENT STATUS",?25,"ENCOUNTER STATUS",?50,"COUNT",! ;
W "------------------",?25,"----------------",?50,"-----",! ;
S X="" F S X=$O(COUNT(X)) Q:X="" W !,$S(X="NULL":X,1:$$SETOFCODES(2.98,3,X)) S Y=0 F S Y=$O(COUNT(X,Y)) Q:'Y W ?25,$$GET1^DIQ(409.63,Y_",",.01),?50,COUNT(X,Y),! ;
Q ;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECDATA 13073 printed Apr 09, 2024@21:59:22 Page 2
SDECDATA ;ALB/WTC - VISTA SCHEDULING GUI ; 01 May 2019 10:52 AM
+1 ;;5.3;Scheduling;**723,731**;;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
+4 ;
+5 ; ICR
+6 ; ---
+7 ; 7030 - #2 Appointment data
+8 ; 10035 - #2 Patient demographics
+9 ;
REPORT ;
+1 ;
+2 ; Run report only
+3 ;
+4 ;
NEW AUTO,REPORT,POP,IO,%ZIS
+5 ;
SET REPORT="YES"
SET AUTO="NO"
+6 ; Added code to output to printer. wtc 9/12/2019
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+7 ;
DO APPT1
QUIT
+8 ;
AUTO ;
+1 ;
+2 ; Run correction code non-interactively.
+3 ;
+4 ;
NEW AUTO,REPORT
SET REPORT="NO"
SET AUTO="YES"
DO APPT1
QUIT
+5 ;
APPT ;
+1 ;
+2 ; Scan appointment file (#409.84) for entries without resources. Identify correct resource using appointment list in patient file (#2).
+3 ;
+4 ;
NEW AUTO,REPORT
SET REPORT="NO"
SET AUTO="NO"
+5 ;
APPT1 ;
+1 ;
+2 ;
NEW DA,APPTDATA,CNT,STARTTIME,DFN,CANCELLED,APPTMADE,MADEBY,PTDATA,FAILED,CLINICSFND,CLINIC,DA1,RESOURCE,MATCHED,RESPONSE,STOP,FIXED,LOCDATA,D2,%DT,PTR44,Y
+3 ;
+4 ; DA = Appointment (#409.84) pointer
+5 ; APPTDATA = Zero node of appointment file entry (#409.84)
+6 ; CNT = Number of appointments with missing resources found
+7 ; STARTTIME = Appointment start time
+8 ; DFN = Patient (#2) pointer
+9 ; CANCELLED = Appointment cancelled flag (from #409.84)
+10 ; APPTMADE = Date appointment was made (from #409.84)
+11 ; MADEBY = DUZ of person making appointment (from #409.84)
+12 ; PTDATA = Appointment data record from patient file (#2)
+13 ; FAILED = Total number of appointment records that could not be matched
+14 ; CLINICFND = Array indexed by clinic name of appointment records matched with patient appointments
+15 ; CLINIC = Clinic name (.01 field of file #44)
+16 ; DA1 = Appointment (#409.84) pointer
+17 ; RESOURCE = Resource (#409.831) pointer
+18 ; MATCHED = 1 if a second appointment for same patient at same time in the same clinic is found, 0 otherwise
+19 ; RESPONSE = User response
+20 ; STOP = 1 if user enters ^ to stop processing or time out occurs
+21 ; FIXED = Count of number of appointment records updated
+22 ; LOCDATA = Appointment data record from the location file (#44)
+23 ; D2 = Subscript in appointment multiple in location file (#44)
+24 ; PTR44 = Hospital location (pointer to #44)
+25 ;
+26 ;
USE 0
WRITE !!,"Appointments without resources checker",!
+27 ;
+28 ;
SET CNT=0
SET FAILED=0
SET STOP=0
SET FIXED=0
+29 ;
+30 ; Scan is in date order starting with the user indicated date.
+31 ;
+32 ;
USE 0
WRITE !,"Select starting date to check",!
+33 ;
SET %DT="AX"
DO ^%DT
if Y<0
QUIT
SET STARTTIME=$PIECE(Y,".",1)
WRITE !
+34 ;
+35 ; If report is queued, set up variables and call Task Manager then quit
+36 ;
+37 ;
IF REPORT="YES"
IF $DATA(IO("Q"))
Begin DoDot:1
+38 ;
SET ZTRTN="APPT2^SDECDATA"
SET ZTDESC="Appointments missing resources starting from "_$$FMTE^XLFDT(STARTTIME)
+39 ;
SET ZTSAVE("*")=""
+40 ;
DO ^%ZTLOAD
WRITE $SELECT($DATA(ZTSK):"...Task queued",1:"...Task cancelled"),!
End DoDot:1
QUIT
+41 ;
APPT2 ; Entry point for queued report printing
+1 ;
+2 ; Scan appointment file in date order.
+3 ;
+4 ;
FOR
SET STARTTIME=$ORDER(^SDEC(409.84,"B",STARTTIME))
if 'STARTTIME
QUIT
if STOP
QUIT
SET DA=0
FOR
SET DA=$ORDER(^SDEC(409.84,"B",STARTTIME,DA))
if 'DA
QUIT
SET APPTDATA=^SDEC(409.84,DA,0)
IF $PIECE(APPTDATA,U,7)=""
SET CNT=CNT+1
Begin DoDot:1
+5 ;
+6 ;
SET DFN=$PIECE(APPTDATA,U,5)
SET CANCELLED=$SELECT($PIECE(APPTDATA,U,12)="":0,1:1)
SET APPTMADE=$PIECE(APPTDATA,U,9)
SET MADEBY=$PIECE(APPTDATA,U,8)
+7 ; ICR 10035
if REPORT="YES"
USE IO
WRITE !,CNT,". ",$$FMTE^XLFDT(STARTTIME)," (",DA,") ",$PIECE(^DPT(DFN,0),U,1)
+8 ;
+9 ; Find appointment in patient file.
+10 ;
+11 ;
IF '$DATA(^DPT(DFN,"S",STARTTIME,0))
WRITE " *** No matching appointment in Patient file.",!
SET FAILED=FAILED+1
QUIT
+12 ; ICR 7030
SET PTDATA=^DPT(DFN,"S",STARTTIME,0)
SET PTR44=$PIECE(PTDATA,U,1)
SET CLINIC=$PIECE(^SC(PTR44,0),U,1)
WRITE " ",CLINIC,!
+13 ;
SET CLINICSFND(CLINIC)=$GET(CLINICSFND(CLINIC))+1
+14 ;
+15 ; Find appointment in location file.
+16 ;
+17 ;
SET D2=0
SET LOCDATA=""
FOR
SET D2=$ORDER(^SC(PTR44,"S",STARTTIME,1,D2))
if 'D2
QUIT
IF $PIECE(^(D2,0),U,1)=DFN
Begin DoDot:2
+18 ;
SET LOCDATA=^SC(PTR44,"S",STARTTIME,1,D2,0)
+19 ; Appointment made by do not match. Continue looking.
IF $PIECE(LOCDATA,U,6)'=$PIECE(PTDATA,U,18)
SET LOCDATA=""
QUIT
+20 ; Date appointment made do not match. Continue looking.
IF $PIECE(LOCDATA,U,7)'=$PIECE(PTDATA,U,19)
SET LOCDATA=""
QUIT
+21 ; Both appointments are cancelled. Matching appointment found.
IF $PIECE(PTDATA,U,2)="C"!($PIECE(PTDATA,U,2)="PC")
IF $PIECE(LOCDATA,U,9)="C"
QUIT
+22 ; Both appointments are not cancelled. Matching appointment found.
IF $PIECE(PTDATA,U,2)'="C"
IF $PIECE(PTDATA,U,2)'="PC"
IF $PIECE(LOCDATA,U,9)'="C"
QUIT
+23 ; Not a match. Continue looking.
SET LOCDATA=""
End DoDot:2
if LOCDATA'=""
QUIT
+24 ;
+25 ;
WRITE !,"Source",?15,"Status",?30,"Date Made",?45,"Made by",!
+26 ;
WRITE "-----------",?15,"---------",?30,"------------",?45,"-----------------------------",!
+27 ;
WRITE "Patient",?15,$SELECT($PIECE(PTDATA,U,2)="C"!($PIECE(PTDATA,U,2)="PC"):"Cancelled",1:"Active"),?30,$$FMTE^XLFDT($PIECE(PTDATA,U,19)),?45,$$GET1^DIQ(200,$PIECE(PTDATA,U,18)_",",.01),!
+28 ;
IF LOCDATA=""
WRITE "Location",?15,"NOT IN FILE",!
+29 ;
IF '$TEST
WRITE "Location",?15,$SELECT($PIECE(LOCDATA,U,9)="C":"Cancelled",1:"Active"),?30,$$FMTE^XLFDT($PIECE(LOCDATA,U,7)),?45,$$GET1^DIQ(200,$PIECE(LOCDATA,U,6)_",",.01),!
+30 ;
WRITE "Appointment",?15,$SELECT(CANCELLED:"Cancelled",1:"Active"),?30,$$FMTE^XLFDT(APPTMADE),?45,$$GET1^DIQ(200,MADEBY_",",.01),!
+31 ;
+32 ; Stop if patient appointment is active but no matching appointment in Location file.
+33 ;
+34 ;
IF $PIECE(PTDATA,U,2)'="C"
IF $PIECE(PTDATA,U,2)'="PC"
IF LOCDATA=""
WRITE !,"Active appointment in Patient file not in Location file."
SET FAILED=FAILED+1
QUIT
+35 ;
+36 ; Determine if another appointment file entry is for the same time
+37 ;
+38 ;
SET DA1=0
SET MATCHED=0
FOR
SET DA1=$ORDER(^SDEC(409.84,"CPAT",DFN,DA1))
if 'DA1
QUIT
IF DA1'=DA
Begin DoDot:2
+39 ;
+40 ;
if $PIECE(^SDEC(409.84,DA1,0),U,1)'=STARTTIME
QUIT
WRITE !,"*** Another appointment exists for the patient at the same time.",!
SET FAILED=FAILED+1
SET MATCHED=1
+41 ;
End DoDot:2
if MATCHED
QUIT
+42 ;
if MATCHED
QUIT
+43 ;
+44 ; If patient appointment and location appointment is cancelled but appointment file entry is NOT cancelled, fix the appointment file entry. 731 wtc 7/25/2019
+45 ;
+46 ;I $P(PTDATA,U,2)="C"!($P(PTDATA,U,2)="PC"),$P(LOCDATA,U,9)="C",'CANCELLED S FAILED=FAILED+1 Q ;
+47 ;
+48 ; Do not match appointments if not made by same person on same day.
+49 ; Do not match appointments if patient and location file do not agree or patient file is active but location file does not exist.
+50 ;
+51 ;
IF $PIECE(PTDATA,U,2)'="C"
IF $PIECE(PTDATA,U,2)'="PC"
IF LOCDATA=""!($PIECE(LOCDATA,U,9)="C")
SET FAILED=FAILED+1
QUIT
+52 ;
+53 ; Do not fail matching due to appointment made by and date appointment made. 731 wtc 8/6/2019
+54 ;
+55 ;I $P(PTDATA,U,19)'=$P(APPTMADE,".",1) S FAILED=FAILED+1 Q ;
+56 ;I $P(PTDATA,U,18)'=MADEBY S FAILED=FAILED+1 Q ;
+57 ;
+58 ; OK to correct if patient file is active but appointment file is cancelled.
+59 ;
+60 ;I $P(PTDATA,U,2)'="C",$P(PTDATA,U,2)'="PC",CANCELLED S FAILED=FAILED+1 Q ;
+61 ;
+62 ; Stop if report only
+63 ;
+64 ;
IF REPORT="YES"
QUIT
+65 ;
+66 ; Check resource file for entry matching the clinic name. If one does not exist, notify user but do not process a change for the appointment.
+67 ;
+68 ;
SET RESOURCE=$ORDER(^SDEC(409.831,"B",CLINIC,0))
+69 ;
IF 'RESOURCE
WRITE !,"No resource exists with the name '",CLINIC,"'.",!,"Create the required resource before updating this appointment.",!
QUIT
+70 ;
IF $PIECE($GET(^SDEC(409.831,RESOURCE,0)),U,4)'=PTR44
WRITE !,"Resource not associated with ",CLINIC,". Correct this before updating this appointment.",!
QUIT
+71 ;
+72 ; If automatics option selected, update the appointment.
+73 ;
+74 ; Added 2 parameters to UPDAPPT call to allow matching if patient file appointment is cancelled but appointment file entry is not. 731 wtc 7/26/2019
+75 ;
+76 ;
IF AUTO="YES"
DO UPDAPPT(DA,RESOURCE,$PIECE(PTDATA,U,2),CANCELLED)
WRITE "...updated",!
SET FIXED=FIXED+1
QUIT
+77 ;
+78 ; For manual processing, ask user if he/she wants to update Appointment file with resource of same name as clinic.
+79 ;
+80 ;
WRITE !,"Make '",CLINIC,"' the resource for this appointment?"
READ " NO// ",RESPONSE:$SELECT($GET(DTIME):DTIME,1:180)
IF '$TEST!(RESPONSE="^")
SET STOP=1
QUIT
+81 ;
+82 ; Added 2 parameters to UPDAPPT call to allow matching if patient file appointment is cancelled but appointment file entry is not. 731 wtc 7/26/2019
+83 ;
+84 ;
IF RESPONSE="YES"!(RESPONSE="Y")!(RESPONSE="yes")!(RESPONSE="y")
DO UPDAPPT(DA,RESOURCE,$PIECE(PTDATA,U,2),CANCELLED)
WRITE "...updated",!
SET FIXED=FIXED+1
QUIT
+85 ;
+86 ;
WRITE "... skipped",!
QUIT
End DoDot:1
if STOP
QUIT
+87 ;
+88 ; No bad entries found. Do not output statistics.
IF 'CNT
if REPORT="NO"
QUIT
DO ^%ZISC
KILL ZTDESC,ZTRTN,ZTSAVE,ZTSK
QUIT
+89 ;
+90 ; Output statistics. Show total found, number fixed and number that could not be fixed.
+91 ;
+92 ;
WRITE !,"TOTAL FOUND: ",CNT,!,"FIXES MADE: ",FIXED,!,"FAILED TO MATCH: ",FAILED,!,"MATCHING PERCENTAGE: ",$JUSTIFY(CNT-FAILED/CNT*100,4,1),"%",!
+93 ;
WRITE !,"MISSING CLINICS MATCHED TO: "
+94 ;
SET CLINIC=""
FOR
SET CLINIC=$ORDER(CLINICSFND(CLINIC))
if CLINIC=""
QUIT
WRITE ?30,CLINIC,?62,$JUSTIFY(CLINICSFND(CLINIC),$LENGTH(CNT))," = ",$JUSTIFY(CLINICSFND(CLINIC)/CNT*100,4,1),"%",!
+95 ;
+96 ;
IF REPORT="YES"
DO ^%ZISC
KILL ZTDESC,ZTRTN,ZTSAVE,ZTSK
+97 ;
QUIT
+98 ;
UPDAPPT(APPT,RESOURCE,PTCANFLG,APPTCAN) ; Added last 2 parameters - 731 wtc 7/25/2019
+1 ;
+2 ; APPT = Appointment (pointer to #409.84) [REQUIRED]
+3 ; RESOURCE = Resource (pointer to #409.831) [REQUIRED]
+4 ; PTCANFLG = Patient appointment status (see field #1 in the appointment multiple in the patient file) [REQUIRED]
+5 ; APPTCAN = Appointment cancelled (1) or active (2). [REQUIRED]
+6 ;
+7 ;
if $GET(APPT)=""
QUIT
if $GET(RESOURCE)=""
QUIT
if $GET(APPTCAN)=""
QUIT
+8 ;
+9 ;
NEW DIE,DA,DR
+10 ;
+11 ; Assign resource to appointment file entry
+12 ;
+13 ;
SET DIE=409.84
SET DA=APPT
SET DR=".07///"_RESOURCE
+14 ;
+15 ; If patient appointment cancelled but appointment entry not cancelled, cancel the appointment entry. 731 wtc 7/26/2019
+16 ;
+17 ;
IF PTCANFLG="C"!(PTCANFLG="PC")
IF 'APPTCAN
Begin DoDot:1
+18 ;
+19 ; Get cancellation data from patient appointment and file in appointment file. WTC 9/10/2019
+20 ;
+21 ;
NEW DATA,DFN,DTTM
+22 ;
SET DATA=^SDEC(409.84,APPT,0)
SET DFN=$PIECE(DATA,U,5)
SET DTTM=$PIECE(DATA,U,1)
+23 ;
SET DATA=^DPT(DFN,"S",DTTM,0)
+24 ;
SET DR=DR_";.12///"_$SELECT($PIECE(DATA,U,14):"^S X="_$PIECE(DATA,U,14),1:"NOW")_";.121///^S X="_$SELECT($PIECE(DATA,U,12):$PIECE(DATA,U,12),1:DUZ)
+25 ;
SET DR=DR_";.122///^S X="_$SELECT($PIECE(DATA,U,15):$PIECE(DATA,U,15),1:11)_";.17///^S X="_$CHAR(34)_PTCANFLG_$CHAR(34)
End DoDot:1
+26 ;
+27 ; If patient appointment is active but appointment entry is cancelled, activate the appointment entry. 731 wtc 729/2019
+28 ;
+29 ;
IF PTCANFLG'="C"
IF PTCANFLG'="PC"
IF APPTCAN
SET DR=DR_";.12///@;.121///@;.122///@;.17///@"
+30 ;
+31 ;
DO ^DIE
+32 ;
QUIT
+33 ;
PTAPTINQ ;
+1 ;
+2 ; Display appointments for a patient and date range
+3 ;
+4 ;
NEW DIC,Y,DFN,START,END,%DT
+5 ;
+6 ;
SET DIC(0)="AEQM"
SET DIC=2
DO ^DIC
if Y<0
QUIT
SET DFN=+Y
+7 ;
+8 ;
KILL %DT(0)
SET %DT="AEP"
SET %DT("A")="Start date: "
DO ^%DT
if Y<0
QUIT
SET START=Y
+9 ;
SET %DT="AEP"
SET %DT("A")="End date: "
SET %DT(0)=START
DO ^%DT
if Y<0
QUIT
SET END=Y+1
+10 ;
+11 ;
WRITE !,"Patient: ",$$GET1^DIQ(2,DFN_",",.01)," (",DFN,")",!
+12 ;
WRITE "Appt Date/Time",?20,"Location",?50,"Status",!!
+13 ; ICR 7030
SET STARTTIME=START
FOR
SET STARTTIME=$ORDER(^DPT(DFN,"S",STARTTIME))
if 'STARTTIME
QUIT
if STARTTIME>END
QUIT
SET X=^(STARTTIME,0)
Begin DoDot:1
+14 ;
+15 ;
WRITE $$FMTE^XLFDT(STARTTIME),?20,$$GET1^DIQ(44,$PIECE(X,U,1)_",",.01),?50,$$SETOFCODES(2.98,3,$PIECE(X,U,2)),!
End DoDot:1
+16 ;
+17 ;
QUIT
+18 ;
SETOFCODES(FILE,FIELD,VALUE) ;
+1 ;
+2 ;
NEW DD,VALUES,RETURN,I
+3 ;
+4 ;
SET DD=^DD(FILE,FIELD,0)
SET VALUES=$PIECE(DD,U,3)
SET RETURN=""
+5 ;
FOR I=1:1
if $PIECE(VALUES,";",I,99)=""
QUIT
IF $PIECE($PIECE(VALUES,";",I),":",1)=VALUE
SET RETURN=$PIECE($PIECE(VALUES,";",I),":",2)
QUIT
+6 ;
QUIT RETURN
+7 ;
MISMATCH ;
+1 ;
+2 ; Find encounters whose status does not match with the appointment status.
+3 ;
+4 ;
NEW DFN,D1,ENCOUNTER,APPTDATA,ENCDATA,X,Y,START,NAME,COUNT
+5 ;
+6 ;
KILL %DT
SET %DT="AEP"
SET %DT("A")="Start date: "
DO ^%DT
if Y<0
QUIT
SET START=Y
WRITE !!
+7 ;
+8 ; ICR 7030
SET NAME=""
FOR
SET NAME=$ORDER(^DPT("B",NAME))
if NAME=""
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^DPT("B",NAME,DFN))
if 'DFN
QUIT
SET D1=START-1
FOR
SET D1=$ORDER(^DPT(DFN,"S",D1))
if 'D1
QUIT
SET APPTDATA=^(D1,0)
SET ENCOUNTER=$PIECE(APPTDATA,U,20)
IF ENCOUNTER'=""
Begin DoDot:1
+9 ;
+10 ; Compare status
+11 ;
+12 ;
SET X=$PIECE(APPTDATA,U,2)
SET Y=$$GET1^DIQ(409.68,ENCOUNTER_",",.12,"I")
+13 ; Checked in or checked out
IF X=""
IF Y=1!(Y=2)
QUIT
+14 ; Non-count
IF X=""
IF Y=12
QUIT
+15 ; Action required
IF X=""
IF Y=14
QUIT
+16 ; No show
IF X="N"
IF Y=4
QUIT
+17 ; Cancelled by clinic
IF X="C"
IF Y=5
QUIT
+18 ; No show and auto-rebook
IF X="NA"
IF Y=6
QUIT
+19 ; Cancelled by clinic and auto re-book
IF X="CA"
IF Y=7
QUIT
+20 ; Inpatient
IF X="I"
IF Y=8
QUIT
+21 ; Cancelled by patient
IF X="PC"
IF Y=9
QUIT
+22 ; Cancelled by patient and auto re-book
IF X="PCA"
IF Y=10
QUIT
+23 ; No action taken
IF X="NT"
IF Y=3
QUIT
+24 ;W $$GET1^DIQ(2,DFN_",",.01),?30,$$FMTE^XLFDT(D1),?50,"APPT: ",$$SETOFCODES(2.98,3,X),! ;
+25 ;
WRITE NAME,?30,$$FMTE^XLFDT(D1),?50,"APPT: "
if X'=""
WRITE $$SETOFCODES(2.98,3,X)
WRITE !
+26 ;
WRITE ?50," ENC: "
if Y'=""
WRITE $$GET1^DIQ(409.63,Y_",",.01)
WRITE !!
+27 ;
IF X=""
SET X="NULL"
+28 ;
IF Y=""
SET Y="NULL"
+29 ;
SET COUNT(X,Y)=$GET(COUNT(X,Y))+1
End DoDot:1
+30 ;
TOTALS ;
+1 ;
WRITE !!,"APPOINTMENT STATUS",?25,"ENCOUNTER STATUS",?50,"COUNT",!
+2 ;
WRITE "------------------",?25,"----------------",?50,"-----",!
+3 ;
SET X=""
FOR
SET X=$ORDER(COUNT(X))
if X=""
QUIT
WRITE !,$SELECT(X="NULL":X,1:$$SETOFCODES(2.98,3,X))
SET Y=0
FOR
SET Y=$ORDER(COUNT(X,Y))
if 'Y
QUIT
WRITE ?25,$$GET1^DIQ(409.63,Y_",",.01),?50,COUNT(X,Y),!
+4 ;
QUIT
+5 ;
