Routine: SDECDATA

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

 ;  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  Feb 19, 2025@00:18:19                                                                                                                                                                                                   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       ;

SDECDATA.m