SDECSTSQ ; ALB/WTC - VISTA SCHEDULING GUI; 21 Aug 2019 7:10 AM ; 13 Nov 2019 9:28 AM
;;5.3;Scheduling;**737**;;Build 13
;;Per VHA Directive 2004-038, this routine should not be modified
Q
;
; Report appointment-encounter-appointment status triples from the patient file (#2), the encounter file (#409.68) and the appointment file (#409.84).
;
; ICR
; ---
; 7030 - #2 patient appointment data
;
FIND ;
;
; Entry point for report only.
;
W !!,"Generate report showing status of patient appointment, encounter or appointment file entries for a single status triple.",! ;
;
N REPORT,POP,IO,%ZIS ;
S REPORT="YES" ;
S %ZIS="Q" D ^%ZIS Q:POP ; Added code to output to printer. wtc 9/17/2019
;
FIND0 ;
;
; Find patient appointment-encounter-appointment file combinations that match selected criteria
;
N %DT,Y,START,X,DIC,PTSTATUS,ENCSTATUS,APPTSTATUS,NAME,DFN,DTTM,PTDATA,ENCOUNTER,ENCDATA,APPTIEN,APPTDATA,FIRST,COUNT,FIELDS,FIELD,I ;
;
; START = Beginning date of appointments in list
; PTSTATUS = Status of appointment in patient file
; ENCSTATUS = Status of encounter
; APPTSTATUS = Status of appointment in appointment file
; NAME = Patient's name
; DFN = Patient pointer (#2)
; DTTM = Appointment date/time (FM format)
; PTDATA = Data record from patient's appointment (ICR #7030)
; ENCOUNTER = Encounter pointer (#409.68)
; ENCDATA = Data record from encounter
; APPTIEN = Appointment pointer (#409.84)
; APPTDATA = Data record from appointment
; FIRST = Flag indicating that the appointment in the appointment file is the first to match the appointment in the patient file
; COUNT = Total number of appointment-encounter-appointment triples found
; FIELDS = Set of codes fields from patient appointment multiple or appointment file used to display help text
; FIELD = Individual set of codes value used to display help text
;
U 0 W !,"Select starting date to check",! ;
S %DT="AX" D ^%DT Q:Y<0 S START=$P(Y,".",1) W ! ;
;
; The user selects the appointment-encounter-appointment triple by identifying the status of the patient appointment (#2), the encounter (#409.68)
; and the appointment file entry (#409.84). The allowable status values come from the status data fields in each of the files plus NULL for all
; 3 files and NONE for the encounter and appointment files.
;
FIND1 ;
R !,"Select patient appointment status: ",X:$S($G(DTIME):DTIME,1:300) Q:'$T Q:X="" Q:X="^" ;
;
I X="?" W !!,"Enter a code from the list below or enter NULL",! D G FIND1 ;
. S FIELDS=$P(^DD(2.98,3,0),U,3) ;
. F I=1:1 S FIELD=$P(FIELDS,";",I) Q:FIELD="" W $P(FIELD,":",1)," - ",$P(FIELD,":",2),! ;
;
I X="NULL" S PTSTATUS=X ;
E I $$SETCODES^SDECSTSR(2.98,3,X)="" W " ???" G FIND1 ;
I X'="NULL" W " - ",$$SETCODES^SDECSTSR(2.98,3,X) S PTSTATUS=X ;
FIND2 ;
R !,"Select encounter status: ",X:$S($G(DTIME):DTIME,1:300) Q:'$T Q:X="" Q:X="^" ;
I X="?" W !!,"Enter a status from the list below or enter NULL or NONE",! D G FIND2 ;
. S X="" F S X=$O(^SD(409.63,"B",X)) Q:X="" W X,! ;
;
I X="NULL"!(X="NONE") S ENCSTATUS=X G FIND3 ;
S DIC=409.63,DIC(0)="EQM" D ^DIC Q:Y<0 S ENCSTATUS=+Y ;
FIND3 ;
R !,"Select appointment file status: ",X:$S($G(DTIME):DTIME,1:300) Q:'$T Q:X="" Q:X="^" ;
I X="?" W !!,"Enter a code from the list below or enter NONE or NULL",! D G FIND3 ;
. S FIELDS=$P(^DD(409.84,.17,0),U,3) ;
. F I=1:1 S FIELD=$P(FIELDS,";",I) Q:FIELD="" W $P(FIELD,":",1)," - ",$P(FIELD,":",2),! ;
;
I X="NULL"!(X="NONE") S APPTSTATUS=X ;
E I $$SETCODES^SDECSTSR(409.84,.17,X)="" W " ???" G FIND3 ;
I X'="NULL",X'="NONE" W " - ",$$SETCODES^SDECSTSR(409.84,.17,X) S APPTSTATUS=X ;
;
; If report is queued, add to Taskman
;
I REPORT="YES",$D(IO("Q")) D Q ;
. S ZTRTN="FIND4^SDECSTSQ",ZTDESC="Appointment-Encounter-Appointment Status Report" ;
. S ZTSAVE("*")="" ;
. D ^%ZTLOAD W $S($D(ZTSK):"...Task queued",1:"...Task cancelled"),! K ZTDESC,ZTRTN,ZTSAVE,ZTSK ;
;
FIND4 ; Entry point for queued report printing
;
; Scan patient file in name order. Only process patient file entries that have appointments after the selected start date.
;
U:REPORT="YES" IO W ! S NAME="",COUNT=0 ;
F S NAME=$O(^DPT("B",NAME)) Q:NAME="" S DFN=0 F S DFN=$O(^DPT("B",NAME,DFN)) Q:'DFN I $O(^DPT(DFN,"S",START))>0 D ;
. ;
. ; Get status from patient file.
. ;
. S DTTM=START F S DTTM=$O(^DPT(DFN,"S",DTTM)) Q:'DTTM S PTDATA=^(DTTM,0) D ; ICR #7030
.. ;
.. ; Skip appointments that do not match the selected status.
.. ;
.. I PTSTATUS="NULL" Q:$P(PTDATA,U,2)'="" ;
.. E I $P(PTDATA,U,2)'=PTSTATUS Q ;
.. ;
.. ; Get status of encounter from file.
.. ;
.. S ENCOUNTER=$P(PTDATA,U,20),ENCDATA=$S(ENCOUNTER:$G(^SCE(ENCOUNTER,0)),1:"") ;
.. ;
.. ; Skip encounters that do not match the selected status.
.. ;
.. I ENCSTATUS="NULL" Q:$P(ENCDATA,U,12)'="" ;
.. I ENCSTATUS="NONE" Q:ENCOUNTER ;
.. I ENCSTATUS'="NULL",ENCSTATUS'="NONE" Q:$P(ENCDATA,U,12)'=ENCSTATUS ;
.. ;
.. ; Scan appointment file for the patient and appointment date/time. Get status from appointment file
.. ;
.. S APPTIEN=0,FIRST=1 F S APPTIEN=$O(^SDEC(409.84,"APTDT",DFN,DTTM,APPTIEN)) Q:'APPTIEN S APPTDATA=$G(^SDEC(409.84,APPTIEN,0)) D ;
... ;
... ; Skip encounters that do not match the selected status.
... ;
... I APPTSTATUS="NULL" Q:$P(APPTDATA,U,17)'="" ;
... I APPTSTATUS'="NULL" Q:$P(APPTDATA,U,17)'=APPTSTATUS ;
... ;
... ; Show patient and encounter data if this is the first matching appointment from the appointment file.
... ;
... I FIRST D LINE,SHOWPAT^SDECSTSR(DFN,DTTM),SHOWENC^SDECSTSR(ENCOUNTER) S FIRST=0 ;
... ;
... ; Show appointment data.
... ;
... D SHOWAPPT^SDECSTSR(APPTIEN) S COUNT=COUNT+1 ;
.. ;
.. ; If no matching appointment was found in the appointment file and NONE was selected for appointments, display patient and encounter data.
.. ;
.. I FIRST,APPTSTATUS="NONE" D Q ;
... D LINE,SHOWPAT^SDECSTSR(DFN,DTTM),SHOWENC^SDECSTSR(ENCOUNTER),SHOWAPPT^SDECSTSR("") S COUNT=COUNT+1 ;
;
I REPORT="YES" D ^%ZISC K ZTDESC,ZTRTN,ZTSAVE,ZTSK ;
;
Q ;
;
LINE ;
;
W "-------------------------------------------------------------------------------",! ;
Q ;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECSTSQ 6424 printed Sep 23, 2025@20:29:10 Page 2
SDECSTSQ ; ALB/WTC - VISTA SCHEDULING GUI; 21 Aug 2019 7:10 AM ; 13 Nov 2019 9:28 AM
+1 ;;5.3;Scheduling;**737**;;Build 13
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
+4 ;
+5 ; Report appointment-encounter-appointment status triples from the patient file (#2), the encounter file (#409.68) and the appointment file (#409.84).
+6 ;
+7 ; ICR
+8 ; ---
+9 ; 7030 - #2 patient appointment data
+10 ;
FIND ;
+1 ;
+2 ; Entry point for report only.
+3 ;
+4 ;
WRITE !!,"Generate report showing status of patient appointment, encounter or appointment file entries for a single status triple.",!
+5 ;
+6 ;
NEW REPORT,POP,IO,%ZIS
+7 ;
SET REPORT="YES"
+8 ; Added code to output to printer. wtc 9/17/2019
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+9 ;
FIND0 ;
+1 ;
+2 ; Find patient appointment-encounter-appointment file combinations that match selected criteria
+3 ;
+4 ;
NEW %DT,Y,START,X,DIC,PTSTATUS,ENCSTATUS,APPTSTATUS,NAME,DFN,DTTM,PTDATA,ENCOUNTER,ENCDATA,APPTIEN,APPTDATA,FIRST,COUNT,FIELDS,FIELD,I
+5 ;
+6 ; START = Beginning date of appointments in list
+7 ; PTSTATUS = Status of appointment in patient file
+8 ; ENCSTATUS = Status of encounter
+9 ; APPTSTATUS = Status of appointment in appointment file
+10 ; NAME = Patient's name
+11 ; DFN = Patient pointer (#2)
+12 ; DTTM = Appointment date/time (FM format)
+13 ; PTDATA = Data record from patient's appointment (ICR #7030)
+14 ; ENCOUNTER = Encounter pointer (#409.68)
+15 ; ENCDATA = Data record from encounter
+16 ; APPTIEN = Appointment pointer (#409.84)
+17 ; APPTDATA = Data record from appointment
+18 ; FIRST = Flag indicating that the appointment in the appointment file is the first to match the appointment in the patient file
+19 ; COUNT = Total number of appointment-encounter-appointment triples found
+20 ; FIELDS = Set of codes fields from patient appointment multiple or appointment file used to display help text
+21 ; FIELD = Individual set of codes value used to display help text
+22 ;
+23 ;
USE 0
WRITE !,"Select starting date to check",!
+24 ;
SET %DT="AX"
DO ^%DT
if Y<0
QUIT
SET START=$PIECE(Y,".",1)
WRITE !
+25 ;
+26 ; The user selects the appointment-encounter-appointment triple by identifying the status of the patient appointment (#2), the encounter (#409.68)
+27 ; and the appointment file entry (#409.84). The allowable status values come from the status data fields in each of the files plus NULL for all
+28 ; 3 files and NONE for the encounter and appointment files.
+29 ;
FIND1 ;
+1 ;
READ !,"Select patient appointment status: ",X:$SELECT($GET(DTIME):DTIME,1:300)
if '$TEST
QUIT
if X=""
QUIT
if X="^"
QUIT
+2 ;
+3 ;
IF X="?"
WRITE !!,"Enter a code from the list below or enter NULL",!
Begin DoDot:1
+4 ;
SET FIELDS=$PIECE(^DD(2.98,3,0),U,3)
+5 ;
FOR I=1:1
SET FIELD=$PIECE(FIELDS,";",I)
if FIELD=""
QUIT
WRITE $PIECE(FIELD,":",1)," - ",$PIECE(FIELD,":",2),!
End DoDot:1
GOTO FIND1
+6 ;
+7 ;
IF X="NULL"
SET PTSTATUS=X
+8 ;
IF '$TEST
IF $$SETCODES^SDECSTSR(2.98,3,X)=""
WRITE " ???"
GOTO FIND1
+9 ;
IF X'="NULL"
WRITE " - ",$$SETCODES^SDECSTSR(2.98,3,X)
SET PTSTATUS=X
FIND2 ;
+1 ;
READ !,"Select encounter status: ",X:$SELECT($GET(DTIME):DTIME,1:300)
if '$TEST
QUIT
if X=""
QUIT
if X="^"
QUIT
+2 ;
IF X="?"
WRITE !!,"Enter a status from the list below or enter NULL or NONE",!
Begin DoDot:1
+3 ;
SET X=""
FOR
SET X=$ORDER(^SD(409.63,"B",X))
if X=""
QUIT
WRITE X,!
End DoDot:1
GOTO FIND2
+4 ;
+5 ;
IF X="NULL"!(X="NONE")
SET ENCSTATUS=X
GOTO FIND3
+6 ;
SET DIC=409.63
SET DIC(0)="EQM"
DO ^DIC
if Y<0
QUIT
SET ENCSTATUS=+Y
FIND3 ;
+1 ;
READ !,"Select appointment file status: ",X:$SELECT($GET(DTIME):DTIME,1:300)
if '$TEST
QUIT
if X=""
QUIT
if X="^"
QUIT
+2 ;
IF X="?"
WRITE !!,"Enter a code from the list below or enter NONE or NULL",!
Begin DoDot:1
+3 ;
SET FIELDS=$PIECE(^DD(409.84,.17,0),U,3)
+4 ;
FOR I=1:1
SET FIELD=$PIECE(FIELDS,";",I)
if FIELD=""
QUIT
WRITE $PIECE(FIELD,":",1)," - ",$PIECE(FIELD,":",2),!
End DoDot:1
GOTO FIND3
+5 ;
+6 ;
IF X="NULL"!(X="NONE")
SET APPTSTATUS=X
+7 ;
IF '$TEST
IF $$SETCODES^SDECSTSR(409.84,.17,X)=""
WRITE " ???"
GOTO FIND3
+8 ;
IF X'="NULL"
IF X'="NONE"
WRITE " - ",$$SETCODES^SDECSTSR(409.84,.17,X)
SET APPTSTATUS=X
+9 ;
+10 ; If report is queued, add to Taskman
+11 ;
+12 ;
IF REPORT="YES"
IF $DATA(IO("Q"))
Begin DoDot:1
+13 ;
SET ZTRTN="FIND4^SDECSTSQ"
SET ZTDESC="Appointment-Encounter-Appointment Status Report"
+14 ;
SET ZTSAVE("*")=""
+15 ;
DO ^%ZTLOAD
WRITE $SELECT($DATA(ZTSK):"...Task queued",1:"...Task cancelled"),!
KILL ZTDESC,ZTRTN,ZTSAVE,ZTSK
End DoDot:1
QUIT
+16 ;
FIND4 ; Entry point for queued report printing
+1 ;
+2 ; Scan patient file in name order. Only process patient file entries that have appointments after the selected start date.
+3 ;
+4 ;
if REPORT="YES"
USE IO
WRITE !
SET NAME=""
SET COUNT=0
+5 ;
FOR
SET NAME=$ORDER(^DPT("B",NAME))
if NAME=""
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^DPT("B",NAME,DFN))
if 'DFN
QUIT
IF $ORDER(^DPT(DFN,"S",START))>0
Begin DoDot:1
+6 ;
+7 ; Get status from patient file.
+8 ;
+9 ; ICR #7030
SET DTTM=START
FOR
SET DTTM=$ORDER(^DPT(DFN,"S",DTTM))
if 'DTTM
QUIT
SET PTDATA=^(DTTM,0)
Begin DoDot:2
+10 ;
+11 ; Skip appointments that do not match the selected status.
+12 ;
+13 ;
IF PTSTATUS="NULL"
if $PIECE(PTDATA,U,2)'=""
QUIT
+14 ;
IF '$TEST
IF $PIECE(PTDATA,U,2)'=PTSTATUS
QUIT
+15 ;
+16 ; Get status of encounter from file.
+17 ;
+18 ;
SET ENCOUNTER=$PIECE(PTDATA,U,20)
SET ENCDATA=$SELECT(ENCOUNTER:$GET(^SCE(ENCOUNTER,0)),1:"")
+19 ;
+20 ; Skip encounters that do not match the selected status.
+21 ;
+22 ;
IF ENCSTATUS="NULL"
if $PIECE(ENCDATA,U,12)'=""
QUIT
+23 ;
IF ENCSTATUS="NONE"
if ENCOUNTER
QUIT
+24 ;
IF ENCSTATUS'="NULL"
IF ENCSTATUS'="NONE"
if $PIECE(ENCDATA,U,12)'=ENCSTATUS
QUIT
+25 ;
+26 ; Scan appointment file for the patient and appointment date/time. Get status from appointment file
+27 ;
+28 ;
SET APPTIEN=0
SET FIRST=1
FOR
SET APPTIEN=$ORDER(^SDEC(409.84,"APTDT",DFN,DTTM,APPTIEN))
if 'APPTIEN
QUIT
SET APPTDATA=$GET(^SDEC(409.84,APPTIEN,0))
Begin DoDot:3
+29 ;
+30 ; Skip encounters that do not match the selected status.
+31 ;
+32 ;
IF APPTSTATUS="NULL"
if $PIECE(APPTDATA,U,17)'=""
QUIT
+33 ;
IF APPTSTATUS'="NULL"
if $PIECE(APPTDATA,U,17)'=APPTSTATUS
QUIT
+34 ;
+35 ; Show patient and encounter data if this is the first matching appointment from the appointment file.
+36 ;
+37 ;
IF FIRST
DO LINE
DO SHOWPAT^SDECSTSR(DFN,DTTM)
DO SHOWENC^SDECSTSR(ENCOUNTER)
SET FIRST=0
+38 ;
+39 ; Show appointment data.
+40 ;
+41 ;
DO SHOWAPPT^SDECSTSR(APPTIEN)
SET COUNT=COUNT+1
End DoDot:3
+42 ;
+43 ; If no matching appointment was found in the appointment file and NONE was selected for appointments, display patient and encounter data.
+44 ;
+45 ;
IF FIRST
IF APPTSTATUS="NONE"
Begin DoDot:3
+46 ;
DO LINE
DO SHOWPAT^SDECSTSR(DFN,DTTM)
DO SHOWENC^SDECSTSR(ENCOUNTER)
DO SHOWAPPT^SDECSTSR("")
SET COUNT=COUNT+1
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+47 ;
+48 ;
IF REPORT="YES"
DO ^%ZISC
KILL ZTDESC,ZTRTN,ZTSAVE,ZTSK
+49 ;
+50 ;
QUIT
+51 ;
LINE ;
+1 ;
+2 ;
WRITE "-------------------------------------------------------------------------------",!
+3 ;
QUIT
+4 ;
