EHMAPPTZ ;ALB/WTC - EHRM APPOINTMENT MAINTENANCE; Jun 05, 2025@14:52:28
;;1.0;ELECTRONIC HEALTH MODERNIZATION;**13**;Apr 19, 2021;Build 27
;
; Clone of EHMAPPT but reports show Encounter IEN.
;
Q ;
;
CNVSELCT(RPTYPE,CONVDATE,SORTORDR,CLINFLTR,CLINICS,FILTER,NONCOUNT) ;
;
; Select parameters for list or summary.
;
; RPTYPE = Report type (LIST, SUMMARY, CLEANUP, OTHER) [REQUIRED]
; CONVDATE = Date of conversion [RETURNED]
; SORTORDR = Sort order (1,2,3) [RETURNED]
; CLINFLTR = Clinic filter (A or S^clinic IEN)
; CLINICS = Clinics to include/exclude [RETURNED]
; FILTER = Encounter filter (ALL, WITH or WITHOUT) [RETURNED]
; NONCOUNT = Include/exclude non-count clinics [RETURNED]
;
I $G(RPTYPE)="" Q ;
;
S (CONVDATE,FILTER)="" ;
;
; Conversion date
;
S CONVDATE=$$CONVDATE^EHM13UTIL() Q:CONVDATE="" ;
;
; Sort Order
;
I $G(SORTORDR)="" S SORTORDR=$$SORTORDR^EHM13UTIL() Q:SORTORDR="" ;
;
; Include/exclude noncount clinics
;
S NONCOUNT=$$NONCOUNT^EHM13UTIL() Q:NONCOUNT="" ;
;
; All clinics, All except some clinics, selected clinics.
;
S CLINFLTR=$$CLINICS^EHM13UTIL(.CLINICS) Q:CLINFLTR="" ;
;
; All appointments or with/without encounters only
;
S FILTER="" I RPTYPE="LIST" S FILTER=$$FILTER^EHM13UTIL() Q:FILTER="" ;
;
Q ;
;
CNVTDAPT(RPTYPE,CONVDATE,SORTORDR,CLINFLTR,CLINICS,FILTER,NONCOUNT,QUEUED,INCLCANC,ACTREQ) ;
;
; RPTYPE = Report type (LIST, SUMMARY, CLEANUP, OTHER) [REQUIRED]
; CONVDATE = Date of conversion [REQUIRED]
; SORTORDR = Sort order (1,2,3) [REQUIRED]
; CLINFLTR = Clinic filter (A or S^clinic IEN) [REQUIRED]
; FILTER = Encounter filter (ALL, WITH or WITHOUT) [REQUIRED]
; QUEUED = 1 if report queued, 0 otherwise
; INCLCANC = 1 if cancelled appointments included, 0 otherwise
; ACTREQ = 1 if only ACTION REQUIRED encounters included, 0 otherwise
;
; See CNVSELCT for remaining parameter definitions
;
; Converted appointment list. Select appointments with dates after converted date. Include only active appointments made less than 2 years before converted date.
; Returns list in ^TMP($J).
;
; ^TMP($J)=SORT ORDER (1,2,3)
; ^TMP($J,sorted values,409.84)=pointer to #409.84 ^ 0 node from file #409.84
; ^TMP($J,sorted values,2)=0 node from appointment multiple in file #2
; ^TMP($J,sorted values,44)=ien of appointment multiple in file #44 ^ 0 node from appointment in file #44
;
; sorted values are made up of: appointment date/time in FileMan format (e.g., 3230701.1209)
; patient as LAST NAME,FIRST NAME ^ DFN (e.g., SMITH,JOHN A^12345)
; clinic as NAME ^ IEN in file #44. (e.g., MEDICAL CLINIC^12345)
;
N IEN,CTR,APPTDTTM,IEN2,X,DFN,CNCLDTTM,DATENTRD,PTAPPT,ENCNTR,SDECIEN,SDECAPPT ;
;
K ^TMP($J) ;
I 'QUEUED U 0 W !,"Scanning ",$P(^DIC(44,0),U,1)," file.",! ;
;
;S IEN=$S($P(CLINFLTR,U,1)="A":0,1:$P(CLINFLTR,U,2)-.000001),CTR=0 ;
S IEN=0,CTR=0 ;
;F S IEN=$O(^SC(IEN)) Q:'IEN Q:$P(CLINFLTR,U,1)="S"&(IEN>$P(CLINFLTR,U,2)) I $$GET1^DIQ(44,IEN,2)="CLINIC",'$D(^EHRM(1610,"B",IEN)) D ;
F S IEN=$O(^SC(IEN)) Q:'IEN I $$GET1^DIQ(44,IEN,2)="CLINIC",'$D(^EHRM(1610,"B",IEN)) D ;
. ;
. I NONCOUNT="E",$$GET1^DIQ(44,IEN,2502)="YES" Q ; Exclude non-count clinic
. I CLINFLTR="X",$D(CLINICS(IEN)) Q:CLINICS(IEN)="EXCLUDE" ;
. I CLINFLTR="S" Q:'$D(CLINICS(IEN)) ;
. ;
. S APPTDTTM=CONVDATE-.000001 F S APPTDTTM=$O(^SC(IEN,"S",APPTDTTM)) Q:'APPTDTTM S IEN2=0 F S IEN2=$O(^SC(IEN,"S",APPTDTTM,1,IEN2)) Q:'IEN2 S X=^(IEN2,0) D ;
.. ;
.. S DFN=$P(X,U,1) Q:'DFN ; Skip if bad data.
.. I '$G(INCLCANC) Q:$P(X,U,9)="C" ; Exclude cancelled appointments - wtc 5/15/2024
.. S DATENTRD=$P(X,U,7) I DATENTRD'="" Q:DATENTRD<$$FMADD^XLFDT(CONVDATE,-2*365) Q:DATENTRD>CONVDATE ; Skip if entered more than 2 years before conversion date or after conversion date
.. ;
.. ; Find record in Patient file and in SDEC Appointment file (if present)
.. ;
.. S PTAPPT=$G(^DPT(DFN,"S",APPTDTTM,0)),ENCNTR=$P(PTAPPT,U,20) ;
.. I PTAPPT'="" Q:$P(PTAPPT,U,2)="CNV" ; Skip if already converted.
.. ;
.. S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.84,"B",APPTDTTM,SDECIEN)) Q:'SDECIEN S SDECAPPT=$G(^SDEC(409.84,SDECIEN,0)) I $P(SDECAPPT,U,5)=DFN,$P(SDECAPPT,U,12)="" Q ;
.. I 'SDECIEN S SDECAPPT="" ;
.. I SDECAPPT'="" Q:$P(SDECAPPT,U,17)="CNV" ; Skip if already converted.
.. ;
.. ; Filter report
.. ;
.. I RPTYPE="LIST",FILTER=2,ENCNTR="" Q ; Appointments with encounters
.. I RPTYPE="LIST",FILTER=3,ENCNTR'="" Q ; Appointment without encounters
.. I RPTYPE="LIST",FILTER=4,ENCNTR'="",$$ENCTRSTS^EHM13UTIL(ENCNTR)="ACTION REQUIRED",'$$MPTYNCTR^EHM13UTIL(ENCNTR) Q ; Appointments without ACTION REQUIRED encounters
.. ;
.. ; ACTION REQUIRED Encounters only
.. ;
.. I $G(ACTREQ) Q:ENCNTR="" Q:$$ENCTRSTS^EHM13UTIL(ENCNTR)'="ACTION REQUIRED" Q:$$MPTYNCTR^EHM13UTIL(ENCNTR) ;
.. ;
.. S CTR=CTR+1 I CTR#100=0,'QUEUED D PROGRESS^EHM13UTIL(CTR) ;
.. ;
.. ; Build ^TMP($J) in sort order
.. ;
.. I SORTORDR=1 D Q ;
... S ^TMP($J,APPTDTTM,$$GET1^DIQ(2,DFN,.01)_U_DFN,$$GET1^DIQ(44,IEN,.01)_U_IEN,44)=IEN2_U_X ;
... I PTAPPT'="" S ^TMP($J,APPTDTTM,$$GET1^DIQ(2,DFN,.01)_U_DFN,$$GET1^DIQ(44,IEN,.01)_U_IEN,2)=PTAPPT ;
... I SDECIEN S ^TMP($J,APPTDTTM,$$GET1^DIQ(2,DFN,.01)_U_DFN,$$GET1^DIQ(44,IEN,.01)_U_IEN,409.84)=SDECIEN_U_SDECAPPT ;
.. ;
.. I SORTORDR=2 D Q ;
... S ^TMP($J,$$GET1^DIQ(44,IEN,.01)_U_IEN,APPTDTTM,$$GET1^DIQ(2,DFN,.01)_U_DFN,44)=IEN2_U_X ;
... I PTAPPT'="" S ^TMP($J,$$GET1^DIQ(44,IEN,.01)_U_IEN,APPTDTTM,$$GET1^DIQ(2,DFN,.01)_U_DFN,2)=PTAPPT ;
... I SDECIEN S ^TMP($J,$$GET1^DIQ(44,IEN,.01)_U_IEN,APPTDTTM,$$GET1^DIQ(2,DFN,.01)_U_DFN,409.84)=SDECIEN_U_SDECAPPT ;
.. ;
.. I SORTORDR=3 D Q ;
... S ^TMP($J,$$GET1^DIQ(2,DFN,.01)_U_DFN,APPTDTTM,$$GET1^DIQ(44,IEN,.01)_U_IEN,44)=IEN2_U_X ;
... I PTAPPT'="" S ^TMP($J,$$GET1^DIQ(2,DFN,.01)_U_DFN,APPTDTTM,$$GET1^DIQ(44,IEN,.01)_U_IEN,2)=PTAPPT ;
... I SDECIEN S ^TMP($J,$$GET1^DIQ(2,DFN,.01)_U_DFN,APPTDTTM,$$GET1^DIQ(44,IEN,.01)_U_IEN,409.84)=SDECIEN_U_SDECAPPT ;
;
Q ;
;
CNVTDLST ;
;
; List converted appointments.
;
N RPTYPE,CONVDATE,SORTORDR,DFN,APPTDTTM,CLINIC,X1,X2,X3,LASTFI,SORT1,SORT2,SORT3,OUTPTFMT,Y,POP,%ZIS,DIRUT,QUEUED,OUTPTFMT,TITLE ;
;
S RPTYPE="LIST" D CNVSELCT(RPTYPE,.CONVDATE,.SORTORDR,.CLINFLTR,.CLINICS,.FILTER,.NONCOUNT) Q:$D(DIRUT) Q:CONVDATE="" Q:SORTORDR="" Q:CLINFLTR="" Q:FILTER="" Q:NONCOUNT="" ;
;
; Output format
;
S OUTPTFMT=$$RPTFMT^EHM13UTIL() Q:OUTPTFMT="" ;
;
S %ZIS="Q" D ^%ZIS I POP K ^TMP($J) Q ;
;
; If report is queued, add to Taskman
;
S QUEUED=0 I $D(IO("Q")) S QUEUED=1 D Q ;
. N ZTDESC,ZTRTN,ZTSAVE,ZTSK ;
. S ZTRTN="CNVTDLS1^EHMAPPTZ",ZTDESC="Converted Appointment List" ;
. S ZTSAVE("*")="" ;
. D ^%ZTLOAD W $S($D(ZTSK):"...Task queued",1:"...Task cancelled"),! ;
;
CNVTDLS1 ; TaskMan start point
;
; Build list of converted appointments.
;
U IO D CNVTDAPT(RPTYPE,CONVDATE,SORTORDR,CLINFLTR,.CLINICS,FILTER,NONCOUNT,QUEUED,0,0) ; Build list of converted appointments.
;
; List appointments
;
S TITLE="Converted Appointment List ("_$P("All Appointments^Appointments With Encounters^Appointments Without Encounters^Appointments Without ACTION REQUIRED Encounters",U,FILTER)_")" ;
I OUTPTFMT="F" D APPTLSTF(TITLE,CONVDATE,SORTORDR,1,QUEUED) ; Formatted report
I OUTPTFMT="C" D APPTLSTC(TITLE,SORTORDR,1) ; Comma-delimited file
;
D ^%ZISC ;
K ^TMP($J) ;
Q ;
;
;
; TITLE = Report title
; CONVDATE = Conversion date (FM format)
; SORTORDR = Sort order (1,2,3)
; LISTFMT = 1 for 5 data fields: Appointment Date/Time, Patient, Clinic, Status, Encounter (DEFAULT)
; LISTFMT = 2 for 7 data fields: All from LISTFMT=1 plus Date Appointment Made and Made By
;
W @IOF,$$CENTER^EHM13UTIL(TITLE,IOM),?IOM-3-$L(PAGE),"p. ",PAGE,! W:$G(CONVDATE)'="" $$CENTER^EHM13UTIL("Conversion Date: "_$$FMTE^XLFDT(CONVDATE),IOM),! W ! ;
;
I SORTORDR=1 D ;
. W "Appointment",?80,"Appt",?88,"[-------------Encounter------------]" W:$G(LISTFMT)=2 ?125,"Appointment" W ! ;
. W "Date/Time",?16,"Patient",?48,"Clinic",?80,"Status",?88,"Status",?111,"Unique ID/IEN" W:$G(LISTFMT)=2 ?125,"Made/Made By" W ! ;
. W $$DASHES^EHM13UTIL(14),?16,$$DASHES^EHM13UTIL(30),?48,$$DASHES^EHM13UTIL(30),?80,$$DASHES^EHM13UTIL(6),?88,$$DASHES^EHM13UTIL(21),?111,$$DASHES^EHM13UTIL(13) ;
. W:$G(LISTFMT)=2 ?125,$$DASHES^EHM13UTIL(20) W ! ;
;
I SORTORDR=2 D ;
. W ?32,"Appointment",?80,"Appt",?88,"[-------------Encounter------------]" W:$G(LISTFMT)=2 ?125,"Appointment" W ! ;
. W "Clinic",?32,"Date/Time",?48,"Patient",?80,"Status",?88,"Status",?111,"Unique ID/IEN" W:$G(LISTFMT)=2 ?125,"Made/Made By" W ! ;
. W $$DASHES^EHM13UTIL(30),?32,$$DASHES^EHM13UTIL(14),?48,$$DASHES^EHM13UTIL(30),?80,$$DASHES^EHM13UTIL(6),?88,$$DASHES^EHM13UTIL(21),?111,$$DASHES^EHM13UTIL(13) ;
. W:$G(LISTFMT)=2 ?125,$$DASHES^EHM13UTIL(20) W ! ;
;
I SORTORDR=3 D ;
. W ?32,"Appointment",?80,"Appt",?88,"[-------------Encounter------------]" W:$G(LISTFMT)=2 ?125,"Appointment" W ! ;
. W "Patient",?32,"Date/Time",?48,"Clinic",?80,"Status",?88,"Status",?111,"Unique ID/IEN" W:$G(LISTFMT)=2 ?125,"Made/Made By" W ! ;
. W $$DASHES^EHM13UTIL(30),?32,$$DASHES^EHM13UTIL(14),?48,$$DASHES^EHM13UTIL(30),?80,$$DASHES^EHM13UTIL(6),?88,$$DASHES^EHM13UTIL(21),?111,$$DASHES^EHM13UTIL(13) ;
. W:$G(LISTFMT)=2 ?125,$$DASHES^EHM13UTIL(20) W ! ;
;
Q ;
;
APPTLSTF(TITLE,CONVDATE,SORTORDR,LISTFMT,QUEUED) ; Formatted Report
;
N LINES,QUIT,SDECIEN,SDECAPPT,PTAPPT,SCAPPT,SORT1,SORT2,SORT3,APPTDTTM,DFN,CLINIC,RECRDCT,ENCNTR,FMTDTTM,ENCTRSTS,VADM,APPTSTS,UNIQUEID,PAGE ;
;
S LINES=0,QUIT=0,RECRDCT=0,PAGE=1 ;
U IO D HEADER(TITLE,CONVDATE,SORTORDR,LISTFMT,PAGE) ;
;
; Scan sorted data in ^TMP($J)
;
S SORT1="" F S SORT1=$O(^TMP($J,SORT1)) Q:SORT1="" D Q:QUIT ;
. S SORT2="" F S SORT2=$O(^TMP($J,SORT1,SORT2)) Q:SORT2="" D Q:QUIT ;
.. S SORT3="" F S SORT3=$O(^TMP($J,SORT1,SORT2,SORT3)) Q:SORT3="" D Q:QUIT ;
... I SORTORDR=1 S APPTDTTM=SORT1,DFN=$P(SORT2,U,2),CLINIC=$P(SORT3,U,2) ;
... I SORTORDR=2 S CLINIC=$P(SORT1,U,2),APPTDTTM=SORT2,DFN=$P(SORT3,U,2) ;
... I SORTORDR=3 S DFN=$P(SORT1,U,2),APPTDTTM=SORT2,CLINIC=$P(SORT3,U,2) ;
... ;
... S SDECAPPT=$G(^TMP($J,SORT1,SORT2,SORT3,409.84)),SDECIEN=$P(SDECAPPT,U,1),SDECAPPT=$P(SDECAPPT,U,2,999) ;
... S PTAPPT=$G(^TMP($J,SORT1,SORT2,SORT3,2)),ENCNTR=$P(PTAPPT,U,20) ;
... S SCAPPT=$G(^TMP($J,SORT1,SORT2,SORT3,44)) ;
... K VADM D DEM^VADPT ;
... ;
... ; If report displayed on screen, stop when screen full and prompt user to continue or stop.
... ;
... I 'QUEUED D Q:QUIT ;
.... U 0 ;
.... I IO=$I Q:LINES<(IOSL-7) S QUIT=$$CONTINUE^EHM13UTIL()=0,PAGE=PAGE+1 Q:QUIT U IO D HEADER(TITLE,CONVDATE,SORTORDR,LISTFMT,PAGE) S LINES=1 Q ;
.... ;
.... ; New page header for printed report
.... ;
.... I LINES'<IOSL S PAGE=PAGE+1 U IO D HEADER(TITLE,CONVDATE,SORTORDR,LISTFMT,PAGE) S LINES=1 ;
... ;
... S FMTDTTM=$$FMTDTTM^EHM13UTIL(APPTDTTM),ENCTRSTS=$S(ENCNTR'="":$$ENCTRSTS^EHM13UTIL(ENCNTR),1:"") ;
... I ENCTRSTS="ACTION REQUIRED",$$MPTYNCTR^EHM13UTIL(ENCNTR) S ENCTRSTS="EMPTY" ;
... I ENCNTR'="",ENCTRSTS="" S ENCTRSTS="blank" ; Encounter present but status is null.
... I ENCNTR="" S ENCTRSTS="none" ; Encounter is not present.
... S APPTSTS=$$GET1^DIQ(2.98,APPTDTTM_","_DFN,3,"I") I APPTSTS="" S APPTSTS="blank" ; Appointment status is null.
... S UNIQUEID="" I ENCNTR'="" S UNIQUEID=$$GET1^DIQ(409.68,ENCNTR,.2) ;
... ;
... I SORTORDR=1 D ;
.... U IO W FMTDTTM,?16,$$LASTFI^EHM13UTIL(,VADM(1))," (",$P($P(VADM(2),U,2),"-",3),")",?48,$$GET1^DIQ(44,CLINIC,.01),?80,APPTSTS,?88,ENCTRSTS,?111,UNIQUEID ;
.... I $G(LISTFMT)=2 W ?125,$$FMTE^XLFDT($P($P(PTAPPT,U,19),".",1),2) ;
.... W !?111,ENCNTR ;
.... I $G(LISTFMT)=2 W ?125,$$LASTFI^EHM13UTIL(,$$GET1^DIQ(200,$P(PTAPPT,U,18),.01)) ;
.... W ! ;
... I SORTORDR=2 D ;
.... U IO W $$GET1^DIQ(44,CLINIC,.01),?32,FMTDTTM,?48,$$LASTFI^EHM13UTIL(,VADM(1))," (",$P($P(VADM(2),U,2),"-",3),")",?80,APPTSTS,?88,ENCTRSTS,?111,UNIQUEID ;
.... I $G(LISTFMT)=2 W ?125,$$FMTE^XLFDT($P($P(PTAPPT,U,19),".",1),2) ;
.... W !?111,ENCNTR ;
.... I $G(LISTFMT)=2 W ?125,$$LASTFI^EHM13UTIL(,$$GET1^DIQ(200,$P(PTAPPT,U,18),.01)) ;
.... W ! ;
... I SORTORDR=3 D ;
.... U IO W $$LASTFI^EHM13UTIL(,VADM(1))," (",$P($P(VADM(2),U,2),"-",3),")",?32,FMTDTTM,?48,$$GET1^DIQ(44,CLINIC,.01),?80,APPTSTS,?88,ENCTRSTS,?111,UNIQUEID ;
.... I $G(LISTFMT)=2 W ?125,$$FMTE^XLFDT($P($P(PTAPPT,U,19),".",1),2) ;
.... W !?111,ENCNTR ;
.... I $G(LISTFMT)=2 W ?125,$$LASTFI^EHM13UTIL(,$$GET1^DIQ(200,$P(PTAPPT,U,18),.01)) ;
.... W ! ;
... S LINES=LINES+2,RECRDCT=RECRDCT+1 ;
W !,"TOTAL RECORDS = ",RECRDCT,! ;
;
U 0 I 'QUEUED,IO=$I R !,"Press [RETURN] to continue",X:$G(DTIME,300) ;
;
Q ;
;
APPTLSTC(TITLE,SORTORDR,LISTFMT) ; Comma-delimited file
;
N SORT1,SORT2,SORT3,APPTDTTM,DFN,CLINIC,SDECIEN,SDECAPPT,PTAPPT,SCAPPT,ENCNTR,FMTDTTM,ENCTRSTS,VADM,APPTSTS,UNIQUEID ;
;
U IO ;
;
; Output first row - list of data fields
;
I SORTORDR=1 D ;
. I $G(LISTFMT)'=2 W $$COMMAOUT^EHM13UTIL(8,"Appt Date/Time","Patient","SSN","Clinic","Appt Status","Encounter Status","Encounter ID","Encounter IEN"),! ;
. E W $$COMMAOUT^EHM13UTIL(10,"Appt Date/Time","Patient","SSN","Clinic","Status","Encounter Status","Encounter ID","Encounter IEN","Appt Made","Made By"),! ;
I SORTORDR=2 D ;
. I $G(LISTFMT)'=2 W $$COMMAOUT^EHM13UTIL(8,"Clinic","Appt Date/Time","Patient","SSN","Appt Status","Encounter Status","Encounter ID","Encounter IEN",),! ;
. E W $$COMMAOUT^EHM13UTIL(10,"Clinic","Appt Date/Time","Patient","SSN","Appt Status","Encounter Status","Encounter ID","Encounter IEN","Appt Made","Made By"),! ;
I SORTORDR=3 D ;
. I $G(LISTFMT)'=2 W $$COMMAOUT^EHM13UTIL(8,"Patient","SSN","Appt Date/Time","Clinic","Appt Status","Encounter Status","Encounter ID","Encounter IEN"),! ;
. E W $$COMMAOUT^EHM13UTIL(10,"Patient","SSN","Appt Date/Time","Clinic","Appt Status","Encounter Status","Encounter ID","Encounter IEN","Appt Made","Made By"),! ;
;
; Scan sorted data in ^TMP($J)
;
S SORT1="" F S SORT1=$O(^TMP($J,SORT1)) Q:SORT1="" D ;
. S SORT2="" F S SORT2=$O(^TMP($J,SORT1,SORT2)) Q:SORT2="" D ;
.. S SORT3="" F S SORT3=$O(^TMP($J,SORT1,SORT2,SORT3)) Q:SORT3="" D ;
... I SORTORDR=1 S APPTDTTM=SORT1,DFN=$P(SORT2,U,2),CLINIC=$P(SORT3,U,2) ;
... I SORTORDR=2 S CLINIC=$P(SORT1,U,2),APPTDTTM=SORT2,DFN=$P(SORT3,U,2) ;
... I SORTORDR=3 S DFN=$P(SORT1,U,2),APPTDTTM=SORT2,CLINIC=$P(SORT3,U,2) ;
... ;
... S SDECAPPT=$G(^TMP($J,SORT1,SORT2,SORT3,409.84)),SDECIEN=$P(SDECAPPT,U,1),SDECAPPT=$P(SDECAPPT,U,2,999) ;
... S PTAPPT=$G(^TMP($J,SORT1,SORT2,SORT3,2)),ENCNTR=$P(PTAPPT,U,20) ;
... S SCAPPT=$G(^TMP($J,SORT1,SORT2,SORT3,44)) ;
... K VADM D DEM^VADPT ;
... ;
... S FMTDTTM=$$FMTDTTM^EHM13UTIL(APPTDTTM),ENCTRSTS=$S(ENCNTR'="":$$ENCTRSTS^EHM13UTIL(ENCNTR),1:"") ;
... I ENCTRSTS="ACTION REQUIRED",$$MPTYNCTR^EHM13UTIL(ENCNTR) S ENCTRSTS="EMPTY" ;
... I ENCNTR'="",ENCTRSTS="" S ENCTRSTS="blank" ; Encounter present but status is null.
... I ENCNTR="" S ENCTRSTS="none" ; Encounter is not present.
... S APPTSTS=$$GET1^DIQ(2.98,APPTDTTM_","_DFN,3) I APPTSTS="" S APPTSTS="blank" ; Appointment status is null.
... S UNIQUEID="" I ENCNTR'="" S UNIQUEID=$$GET1^DIQ(409.68,ENCNTR,.2) ;
... ;
... I SORTORDR=1 D ;
.... I $G(LISTFMT)'=2 W $$COMMAOUT^EHM13UTIL(8,FMTDTTM,VADM(1),$P($P(VADM(2),U,2),"-",3),$$GET1^DIQ(44,CLINIC,.01),APPTSTS,ENCTRSTS,UNIQUEID,ENCNTR),! ;
.... E W $$COMMAOUT^EHM13UTIL(10,FMTDTTM,VADM(1),$P($P(VADM(2),U,2),"-",3),$$GET1^DIQ(44,CLINIC,.01),APPTSTS,ENCTRSTS,UNIQUEID,ENCNTR,$$FMTE^XLFDT($P($P(PTAPPT,U,19),".",1),2),$$GET1^DIQ(200,$P(PTAPPT,U,18),.01)),! ;
... I SORTORDR=2 D ;
.... I $G(LISTFMT)'=2 W $$COMMAOUT^EHM13UTIL(8,$$GET1^DIQ(44,CLINIC,.01),FMTDTTM,VADM(1),$P($P(VADM(2),U,2),"-",3),APPTSTS,ENCTRSTS,UNIQUEID,ENCNTR),! ;
.... E W $$COMMAOUT^EHM13UTIL(10,$$GET1^DIQ(44,CLINIC,.01),FMTDTTM,VADM(1),$P($P(VADM(2),U,2),"-",3),APPTSTS,ENCTRSTS,UNIQUEID,ENCNTR,$$FMTE^XLFDT($P($P(PTAPPT,U,19),".",1),2),$$GET1^DIQ(200,$P(PTAPPT,U,18),.01)),! ;
... I SORTORDR=3 D ;
.... I $G(LISTFMT)'=2 W $$COMMAOUT^EHM13UTIL(8,VADM(1),$P($P(VADM(2),U,2),"-",3),FMTDTTM,$$GET1^DIQ(44,CLINIC,.01),APPTSTS,ENCTRSTS,UNIQUEID,ENCNTR),! ;
.... E W $$COMMAOUT^EHM13UTIL(10,VADM(1),$P($P(VADM(2),U,2),"-",3),FMTDTTM,$$GET1^DIQ(44,CLINIC,.01),APPTSTS,ENCTRSTS,UNIQUEID,ENCNTR,$$FMTE^XLFDT($P($P(PTAPPT,U,19),".",1),2),$$GET1^DIQ(200,$P(PTAPPT,U,18),.01)),! ;
;
Q ;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEHMAPPTZ 16918 printed Apr 22, 2026@13:48:22 Page 2
EHMAPPTZ ;ALB/WTC - EHRM APPOINTMENT MAINTENANCE; Jun 05, 2025@14:52:28
+1 ;;1.0;ELECTRONIC HEALTH MODERNIZATION;**13**;Apr 19, 2021;Build 27
+2 ;
+3 ; Clone of EHMAPPT but reports show Encounter IEN.
+4 ;
+5 ;
QUIT
+6 ;
CNVSELCT(RPTYPE,CONVDATE,SORTORDR,CLINFLTR,CLINICS,FILTER,NONCOUNT) ;
+1 ;
+2 ; Select parameters for list or summary.
+3 ;
+4 ; RPTYPE = Report type (LIST, SUMMARY, CLEANUP, OTHER) [REQUIRED]
+5 ; CONVDATE = Date of conversion [RETURNED]
+6 ; SORTORDR = Sort order (1,2,3) [RETURNED]
+7 ; CLINFLTR = Clinic filter (A or S^clinic IEN)
+8 ; CLINICS = Clinics to include/exclude [RETURNED]
+9 ; FILTER = Encounter filter (ALL, WITH or WITHOUT) [RETURNED]
+10 ; NONCOUNT = Include/exclude non-count clinics [RETURNED]
+11 ;
+12 ;
IF $GET(RPTYPE)=""
QUIT
+13 ;
+14 ;
SET (CONVDATE,FILTER)=""
+15 ;
+16 ; Conversion date
+17 ;
+18 ;
SET CONVDATE=$$CONVDATE^EHM13UTIL()
if CONVDATE=""
QUIT
+19 ;
+20 ; Sort Order
+21 ;
+22 ;
IF $GET(SORTORDR)=""
SET SORTORDR=$$SORTORDR^EHM13UTIL()
if SORTORDR=""
QUIT
+23 ;
+24 ; Include/exclude noncount clinics
+25 ;
+26 ;
SET NONCOUNT=$$NONCOUNT^EHM13UTIL()
if NONCOUNT=""
QUIT
+27 ;
+28 ; All clinics, All except some clinics, selected clinics.
+29 ;
+30 ;
SET CLINFLTR=$$CLINICS^EHM13UTIL(.CLINICS)
if CLINFLTR=""
QUIT
+31 ;
+32 ; All appointments or with/without encounters only
+33 ;
+34 ;
SET FILTER=""
IF RPTYPE="LIST"
SET FILTER=$$FILTER^EHM13UTIL()
if FILTER=""
QUIT
+35 ;
+36 ;
QUIT
+37 ;
CNVTDAPT(RPTYPE,CONVDATE,SORTORDR,CLINFLTR,CLINICS,FILTER,NONCOUNT,QUEUED,INCLCANC,ACTREQ) ;
+1 ;
+2 ; RPTYPE = Report type (LIST, SUMMARY, CLEANUP, OTHER) [REQUIRED]
+3 ; CONVDATE = Date of conversion [REQUIRED]
+4 ; SORTORDR = Sort order (1,2,3) [REQUIRED]
+5 ; CLINFLTR = Clinic filter (A or S^clinic IEN) [REQUIRED]
+6 ; FILTER = Encounter filter (ALL, WITH or WITHOUT) [REQUIRED]
+7 ; QUEUED = 1 if report queued, 0 otherwise
+8 ; INCLCANC = 1 if cancelled appointments included, 0 otherwise
+9 ; ACTREQ = 1 if only ACTION REQUIRED encounters included, 0 otherwise
+10 ;
+11 ; See CNVSELCT for remaining parameter definitions
+12 ;
+13 ; Converted appointment list. Select appointments with dates after converted date. Include only active appointments made less than 2 years before converted date.
+14 ; Returns list in ^TMP($J).
+15 ;
+16 ; ^TMP($J)=SORT ORDER (1,2,3)
+17 ; ^TMP($J,sorted values,409.84)=pointer to #409.84 ^ 0 node from file #409.84
+18 ; ^TMP($J,sorted values,2)=0 node from appointment multiple in file #2
+19 ; ^TMP($J,sorted values,44)=ien of appointment multiple in file #44 ^ 0 node from appointment in file #44
+20 ;
+21 ; sorted values are made up of: appointment date/time in FileMan format (e.g., 3230701.1209)
+22 ; patient as LAST NAME,FIRST NAME ^ DFN (e.g., SMITH,JOHN A^12345)
+23 ; clinic as NAME ^ IEN in file #44. (e.g., MEDICAL CLINIC^12345)
+24 ;
+25 ;
NEW IEN,CTR,APPTDTTM,IEN2,X,DFN,CNCLDTTM,DATENTRD,PTAPPT,ENCNTR,SDECIEN,SDECAPPT
+26 ;
+27 ;
KILL ^TMP($JOB)
+28 ;
IF 'QUEUED
USE 0
WRITE !,"Scanning ",$PIECE(^DIC(44,0),U,1)," file.",!
+29 ;
+30 ;S IEN=$S($P(CLINFLTR,U,1)="A":0,1:$P(CLINFLTR,U,2)-.000001),CTR=0 ;
+31 ;
SET IEN=0
SET CTR=0
+32 ;F S IEN=$O(^SC(IEN)) Q:'IEN Q:$P(CLINFLTR,U,1)="S"&(IEN>$P(CLINFLTR,U,2)) I $$GET1^DIQ(44,IEN,2)="CLINIC",'$D(^EHRM(1610,"B",IEN)) D ;
+33 ;
FOR
SET IEN=$ORDER(^SC(IEN))
if 'IEN
QUIT
IF $$GET1^DIQ(44,IEN,2)="CLINIC"
IF '$DATA(^EHRM(1610,"B",IEN))
Begin DoDot:1
+34 ;
+35 ; Exclude non-count clinic
IF NONCOUNT="E"
IF $$GET1^DIQ(44,IEN,2502)="YES"
QUIT
+36 ;
IF CLINFLTR="X"
IF $DATA(CLINICS(IEN))
if CLINICS(IEN)="EXCLUDE"
QUIT
+37 ;
IF CLINFLTR="S"
if '$DATA(CLINICS(IEN))
QUIT
+38 ;
+39 ;
SET APPTDTTM=CONVDATE-.000001
FOR
SET APPTDTTM=$ORDER(^SC(IEN,"S",APPTDTTM))
if 'APPTDTTM
QUIT
SET IEN2=0
FOR
SET IEN2=$ORDER(^SC(IEN,"S",APPTDTTM,1,IEN2))
if 'IEN2
QUIT
SET X=^(IEN2,0)
Begin DoDot:2
+40 ;
+41 ; Skip if bad data.
SET DFN=$PIECE(X,U,1)
if 'DFN
QUIT
+42 ; Exclude cancelled appointments - wtc 5/15/2024
IF '$GET(INCLCANC)
if $PIECE(X,U,9)="C"
QUIT
+43 ; Skip if entered more than 2 years before conversion date or after conversion date
SET DATENTRD=$PIECE(X,U,7)
IF DATENTRD'=""
if DATENTRD<$$FMADD^XLFDT(CONVDATE,-2*365)
QUIT
if DATENTRD>CONVDATE
QUIT
+44 ;
+45 ; Find record in Patient file and in SDEC Appointment file (if present)
+46 ;
+47 ;
SET PTAPPT=$GET(^DPT(DFN,"S",APPTDTTM,0))
SET ENCNTR=$PIECE(PTAPPT,U,20)
+48 ; Skip if already converted.
IF PTAPPT'=""
if $PIECE(PTAPPT,U,2)="CNV"
QUIT
+49 ;
+50 ;
SET SDECIEN=0
FOR
SET SDECIEN=$ORDER(^SDEC(409.84,"B",APPTDTTM,SDECIEN))
if 'SDECIEN
QUIT
SET SDECAPPT=$GET(^SDEC(409.84,SDECIEN,0))
IF $PIECE(SDECAPPT,U,5)=DFN
IF $PIECE(SDECAPPT,U,12)=""
QUIT
+51 ;
IF 'SDECIEN
SET SDECAPPT=""
+52 ; Skip if already converted.
IF SDECAPPT'=""
if $PIECE(SDECAPPT,U,17)="CNV"
QUIT
+53 ;
+54 ; Filter report
+55 ;
+56 ; Appointments with encounters
IF RPTYPE="LIST"
IF FILTER=2
IF ENCNTR=""
QUIT
+57 ; Appointment without encounters
IF RPTYPE="LIST"
IF FILTER=3
IF ENCNTR'=""
QUIT
+58 ; Appointments without ACTION REQUIRED encounters
IF RPTYPE="LIST"
IF FILTER=4
IF ENCNTR'=""
IF $$ENCTRSTS^EHM13UTIL(ENCNTR)="ACTION REQUIRED"
IF '$$MPTYNCTR^EHM13UTIL(ENCNTR)
QUIT
+59 ;
+60 ; ACTION REQUIRED Encounters only
+61 ;
+62 ;
IF $GET(ACTREQ)
if ENCNTR=""
QUIT
if $$ENCTRSTS^EHM13UTIL(ENCNTR)'="ACTION REQUIRED"
QUIT
if $$MPTYNCTR^EHM13UTIL(ENCNTR)
QUIT
+63 ;
+64 ;
SET CTR=CTR+1
IF CTR#100=0
IF 'QUEUED
DO PROGRESS^EHM13UTIL(CTR)
+65 ;
+66 ; Build ^TMP($J) in sort order
+67 ;
+68 ;
IF SORTORDR=1
Begin DoDot:3
+69 ;
SET ^TMP($JOB,APPTDTTM,$$GET1^DIQ(2,DFN,.01)_U_DFN,$$GET1^DIQ(44,IEN,.01)_U_IEN,44)=IEN2_U_X
+70 ;
IF PTAPPT'=""
SET ^TMP($JOB,APPTDTTM,$$GET1^DIQ(2,DFN,.01)_U_DFN,$$GET1^DIQ(44,IEN,.01)_U_IEN,2)=PTAPPT
+71 ;
IF SDECIEN
SET ^TMP($JOB,APPTDTTM,$$GET1^DIQ(2,DFN,.01)_U_DFN,$$GET1^DIQ(44,IEN,.01)_U_IEN,409.84)=SDECIEN_U_SDECAPPT
End DoDot:3
QUIT
+72 ;
+73 ;
IF SORTORDR=2
Begin DoDot:3
+74 ;
SET ^TMP($JOB,$$GET1^DIQ(44,IEN,.01)_U_IEN,APPTDTTM,$$GET1^DIQ(2,DFN,.01)_U_DFN,44)=IEN2_U_X
+75 ;
IF PTAPPT'=""
SET ^TMP($JOB,$$GET1^DIQ(44,IEN,.01)_U_IEN,APPTDTTM,$$GET1^DIQ(2,DFN,.01)_U_DFN,2)=PTAPPT
+76 ;
IF SDECIEN
SET ^TMP($JOB,$$GET1^DIQ(44,IEN,.01)_U_IEN,APPTDTTM,$$GET1^DIQ(2,DFN,.01)_U_DFN,409.84)=SDECIEN_U_SDECAPPT
End DoDot:3
QUIT
+77 ;
+78 ;
IF SORTORDR=3
Begin DoDot:3
+79 ;
SET ^TMP($JOB,$$GET1^DIQ(2,DFN,.01)_U_DFN,APPTDTTM,$$GET1^DIQ(44,IEN,.01)_U_IEN,44)=IEN2_U_X
+80 ;
IF PTAPPT'=""
SET ^TMP($JOB,$$GET1^DIQ(2,DFN,.01)_U_DFN,APPTDTTM,$$GET1^DIQ(44,IEN,.01)_U_IEN,2)=PTAPPT
+81 ;
IF SDECIEN
SET ^TMP($JOB,$$GET1^DIQ(2,DFN,.01)_U_DFN,APPTDTTM,$$GET1^DIQ(44,IEN,.01)_U_IEN,409.84)=SDECIEN_U_SDECAPPT
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+82 ;
+83 ;
QUIT
+84 ;
CNVTDLST ;
+1 ;
+2 ; List converted appointments.
+3 ;
+4 ;
NEW RPTYPE,CONVDATE,SORTORDR,DFN,APPTDTTM,CLINIC,X1,X2,X3,LASTFI,SORT1,SORT2,SORT3,OUTPTFMT,Y,POP,%ZIS,DIRUT,QUEUED,OUTPTFMT,TITLE
+5 ;
+6 ;
SET RPTYPE="LIST"
DO CNVSELCT(RPTYPE,.CONVDATE,.SORTORDR,.CLINFLTR,.CLINICS,.FILTER,.NONCOUNT)
if $DATA(DIRUT)
QUIT
if CONVDATE=""
QUIT
if SORTORDR=""
QUIT
if CLINFLTR=""
QUIT
if FILTER=""
QUIT
if NONCOUNT=""
QUIT
+7 ;
+8 ; Output format
+9 ;
+10 ;
SET OUTPTFMT=$$RPTFMT^EHM13UTIL()
if OUTPTFMT=""
QUIT
+11 ;
+12 ;
SET %ZIS="Q"
DO ^%ZIS
IF POP
KILL ^TMP($JOB)
QUIT
+13 ;
+14 ; If report is queued, add to Taskman
+15 ;
+16 ;
SET QUEUED=0
IF $DATA(IO("Q"))
SET QUEUED=1
Begin DoDot:1
+17 ;
NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+18 ;
SET ZTRTN="CNVTDLS1^EHMAPPTZ"
SET ZTDESC="Converted Appointment List"
+19 ;
SET ZTSAVE("*")=""
+20 ;
DO ^%ZTLOAD
WRITE $SELECT($DATA(ZTSK):"...Task queued",1:"...Task cancelled"),!
End DoDot:1
QUIT
+21 ;
CNVTDLS1 ; TaskMan start point
+1 ;
+2 ; Build list of converted appointments.
+3 ;
+4 ; Build list of converted appointments.
USE IO
DO CNVTDAPT(RPTYPE,CONVDATE,SORTORDR,CLINFLTR,.CLINICS,FILTER,NONCOUNT,QUEUED,0,0)
+5 ;
+6 ; List appointments
+7 ;
+8 ;
SET TITLE="Converted Appointment List ("_$PIECE("All Appointments^Appointments With Encounters^Appointments Without Encounters^Appointments Without ACTION REQUIRED Encounters",U,FILTER)_")"
+9 ; Formatted report
IF OUTPTFMT="F"
DO APPTLSTF(TITLE,CONVDATE,SORTORDR,1,QUEUED)
+10 ; Comma-delimited file
IF OUTPTFMT="C"
DO APPTLSTC(TITLE,SORTORDR,1)
+11 ;
+12 ;
DO ^%ZISC
+13 ;
KILL ^TMP($JOB)
+14 ;
QUIT
+15 ;
+1 ;
+2 ; TITLE = Report title
+3 ; CONVDATE = Conversion date (FM format)
+4 ; SORTORDR = Sort order (1,2,3)
+5 ; LISTFMT = 1 for 5 data fields: Appointment Date/Time, Patient, Clinic, Status, Encounter (DEFAULT)
+6 ; LISTFMT = 2 for 7 data fields: All from LISTFMT=1 plus Date Appointment Made and Made By
+7 ;
+8 ;
WRITE @IOF,$$CENTER^EHM13UTIL(TITLE,IOM),?IOM-3-$LENGTH(PAGE),"p. ",PAGE,!
if $GET(CONVDATE)'=""
WRITE $$CENTER^EHM13UTIL("Conversion Date: "_$$FMTE^XLFDT(CONVDATE),IOM),!
WRITE !
+9 ;
+10 ;
IF SORTORDR=1
Begin DoDot:1
+11 ;
WRITE "Appointment",?80,"Appt",?88,"[-------------Encounter------------]"
if $GET(LISTFMT)=2
WRITE ?125,"Appointment"
WRITE !
+12 ;
WRITE "Date/Time",?16,"Patient",?48,"Clinic",?80,"Status",?88,"Status",?111,"Unique ID/IEN"
if $GET(LISTFMT)=2
WRITE ?125,"Made/Made By"
WRITE !
+13 ;
WRITE $$DASHES^EHM13UTIL(14),?16,$$DASHES^EHM13UTIL(30),?48,$$DASHES^EHM13UTIL(30),?80,$$DASHES^EHM13UTIL(6),?88,$$DASHES^EHM13UTIL(21),?111,$$DASHES^EHM13UTIL(13)
+14 ;
if $GET(LISTFMT)=2
WRITE ?125,$$DASHES^EHM13UTIL(20)
WRITE !
End DoDot:1
+15 ;
+16 ;
IF SORTORDR=2
Begin DoDot:1
+17 ;
WRITE ?32,"Appointment",?80,"Appt",?88,"[-------------Encounter------------]"
if $GET(LISTFMT)=2
WRITE ?125,"Appointment"
WRITE !
+18 ;
WRITE "Clinic",?32,"Date/Time",?48,"Patient",?80,"Status",?88,"Status",?111,"Unique ID/IEN"
if $GET(LISTFMT)=2
WRITE ?125,"Made/Made By"
WRITE !
+19 ;
WRITE $$DASHES^EHM13UTIL(30),?32,$$DASHES^EHM13UTIL(14),?48,$$DASHES^EHM13UTIL(30),?80,$$DASHES^EHM13UTIL(6),?88,$$DASHES^EHM13UTIL(21),?111,$$DASHES^EHM13UTIL(13)
+20 ;
if $GET(LISTFMT)=2
WRITE ?125,$$DASHES^EHM13UTIL(20)
WRITE !
End DoDot:1
+21 ;
+22 ;
IF SORTORDR=3
Begin DoDot:1
+23 ;
WRITE ?32,"Appointment",?80,"Appt",?88,"[-------------Encounter------------]"
if $GET(LISTFMT)=2
WRITE ?125,"Appointment"
WRITE !
+24 ;
WRITE "Patient",?32,"Date/Time",?48,"Clinic",?80,"Status",?88,"Status",?111,"Unique ID/IEN"
if $GET(LISTFMT)=2
WRITE ?125,"Made/Made By"
WRITE !
+25 ;
WRITE $$DASHES^EHM13UTIL(30),?32,$$DASHES^EHM13UTIL(14),?48,$$DASHES^EHM13UTIL(30),?80,$$DASHES^EHM13UTIL(6),?88,$$DASHES^EHM13UTIL(21),?111,$$DASHES^EHM13UTIL(13)
+26 ;
if $GET(LISTFMT)=2
WRITE ?125,$$DASHES^EHM13UTIL(20)
WRITE !
End DoDot:1
+27 ;
+28 ;
QUIT
+29 ;
APPTLSTF(TITLE,CONVDATE,SORTORDR,LISTFMT,QUEUED) ; Formatted Report
+1 ;
+2 ;
NEW LINES,QUIT,SDECIEN,SDECAPPT,PTAPPT,SCAPPT,SORT1,SORT2,SORT3,APPTDTTM,DFN,CLINIC,RECRDCT,ENCNTR,FMTDTTM,ENCTRSTS,VADM,APPTSTS,UNIQUEID,PAGE
+3 ;
+4 ;
SET LINES=0
SET QUIT=0
SET RECRDCT=0
SET PAGE=1
+5 ;
USE IO
DO HEADER(TITLE,CONVDATE,SORTORDR,LISTFMT,PAGE)
+6 ;
+7 ; Scan sorted data in ^TMP($J)
+8 ;
+9 ;
SET SORT1=""
FOR
SET SORT1=$ORDER(^TMP($JOB,SORT1))
if SORT1=""
QUIT
Begin DoDot:1
+10 ;
SET SORT2=""
FOR
SET SORT2=$ORDER(^TMP($JOB,SORT1,SORT2))
if SORT2=""
QUIT
Begin DoDot:2
+11 ;
SET SORT3=""
FOR
SET SORT3=$ORDER(^TMP($JOB,SORT1,SORT2,SORT3))
if SORT3=""
QUIT
Begin DoDot:3
+12 ;
IF SORTORDR=1
SET APPTDTTM=SORT1
SET DFN=$PIECE(SORT2,U,2)
SET CLINIC=$PIECE(SORT3,U,2)
+13 ;
IF SORTORDR=2
SET CLINIC=$PIECE(SORT1,U,2)
SET APPTDTTM=SORT2
SET DFN=$PIECE(SORT3,U,2)
+14 ;
IF SORTORDR=3
SET DFN=$PIECE(SORT1,U,2)
SET APPTDTTM=SORT2
SET CLINIC=$PIECE(SORT3,U,2)
+15 ;
+16 ;
SET SDECAPPT=$GET(^TMP($JOB,SORT1,SORT2,SORT3,409.84))
SET SDECIEN=$PIECE(SDECAPPT,U,1)
SET SDECAPPT=$PIECE(SDECAPPT,U,2,999)
+17 ;
SET PTAPPT=$GET(^TMP($JOB,SORT1,SORT2,SORT3,2))
SET ENCNTR=$PIECE(PTAPPT,U,20)
+18 ;
SET SCAPPT=$GET(^TMP($JOB,SORT1,SORT2,SORT3,44))
+19 ;
KILL VADM
DO DEM^VADPT
+20 ;
+21 ; If report displayed on screen, stop when screen full and prompt user to continue or stop.
+22 ;
+23 ;
IF 'QUEUED
Begin DoDot:4
+24 ;
USE 0
+25 ;
IF IO=$IO
if LINES<(IOSL-7)
QUIT
SET QUIT=$$CONTINUE^EHM13UTIL()=0
SET PAGE=PAGE+1
if QUIT
QUIT
USE IO
DO HEADER(TITLE,CONVDATE,SORTORDR,LISTFMT,PAGE)
SET LINES=1
QUIT
+26 ;
+27 ; New page header for printed report
+28 ;
+29 ;
IF LINES'<IOSL
SET PAGE=PAGE+1
USE IO
DO HEADER(TITLE,CONVDATE,SORTORDR,LISTFMT,PAGE)
SET LINES=1
End DoDot:4
if QUIT
QUIT
+30 ;
+31 ;
SET FMTDTTM=$$FMTDTTM^EHM13UTIL(APPTDTTM)
SET ENCTRSTS=$SELECT(ENCNTR'="":$$ENCTRSTS^EHM13UTIL(ENCNTR),1:"")
+32 ;
IF ENCTRSTS="ACTION REQUIRED"
IF $$MPTYNCTR^EHM13UTIL(ENCNTR)
SET ENCTRSTS="EMPTY"
+33 ; Encounter present but status is null.
IF ENCNTR'=""
IF ENCTRSTS=""
SET ENCTRSTS="blank"
+34 ; Encounter is not present.
IF ENCNTR=""
SET ENCTRSTS="none"
+35 ; Appointment status is null.
SET APPTSTS=$$GET1^DIQ(2.98,APPTDTTM_","_DFN,3,"I")
IF APPTSTS=""
SET APPTSTS="blank"
+36 ;
SET UNIQUEID=""
IF ENCNTR'=""
SET UNIQUEID=$$GET1^DIQ(409.68,ENCNTR,.2)
+37 ;
+38 ;
IF SORTORDR=1
Begin DoDot:4
+39 ;
USE IO
WRITE FMTDTTM,?16,$$LASTFI^EHM13UTIL(,VADM(1))," (",$PIECE($PIECE(VADM(2),U,2),"-",3),")",?48,$$GET1^DIQ(44,CLINIC,.01),?80,APPTSTS,?88,ENCTRSTS,?111,UNIQUEID
+40 ;
IF $GET(LISTFMT)=2
WRITE ?125,$$FMTE^XLFDT($PIECE($PIECE(PTAPPT,U,19),".",1),2)
+41 ;
WRITE !?111,ENCNTR
+42 ;
IF $GET(LISTFMT)=2
WRITE ?125,$$LASTFI^EHM13UTIL(,$$GET1^DIQ(200,$PIECE(PTAPPT,U,18),.01))
+43 ;
WRITE !
End DoDot:4
+44 ;
IF SORTORDR=2
Begin DoDot:4
+45 ;
USE IO
WRITE $$GET1^DIQ(44,CLINIC,.01),?32,FMTDTTM,?48,$$LASTFI^EHM13UTIL(,VADM(1))," (",$PIECE($PIECE(VADM(2),U,2),"-",3),")",?80,APPTSTS,?88,ENCTRSTS,?111,UNIQUEID
+46 ;
IF $GET(LISTFMT)=2
WRITE ?125,$$FMTE^XLFDT($PIECE($PIECE(PTAPPT,U,19),".",1),2)
+47 ;
WRITE !?111,ENCNTR
+48 ;
IF $GET(LISTFMT)=2
WRITE ?125,$$LASTFI^EHM13UTIL(,$$GET1^DIQ(200,$PIECE(PTAPPT,U,18),.01))
+49 ;
WRITE !
End DoDot:4
+50 ;
IF SORTORDR=3
Begin DoDot:4
+51 ;
USE IO
WRITE $$LASTFI^EHM13UTIL(,VADM(1))," (",$PIECE($PIECE(VADM(2),U,2),"-",3),")",?32,FMTDTTM,?48,$$GET1^DIQ(44,CLINIC,.01),?80,APPTSTS,?88,ENCTRSTS,?111,UNIQUEID
+52 ;
IF $GET(LISTFMT)=2
WRITE ?125,$$FMTE^XLFDT($PIECE($PIECE(PTAPPT,U,19),".",1),2)
+53 ;
WRITE !?111,ENCNTR
+54 ;
IF $GET(LISTFMT)=2
WRITE ?125,$$LASTFI^EHM13UTIL(,$$GET1^DIQ(200,$PIECE(PTAPPT,U,18),.01))
+55 ;
WRITE !
End DoDot:4
+56 ;
SET LINES=LINES+2
SET RECRDCT=RECRDCT+1
End DoDot:3
if QUIT
QUIT
End DoDot:2
if QUIT
QUIT
End DoDot:1
if QUIT
QUIT
+57 ;
WRITE !,"TOTAL RECORDS = ",RECRDCT,!
+58 ;
+59 ;
USE 0
IF 'QUEUED
IF IO=$IO
READ !,"Press [RETURN] to continue",X:$GET(DTIME,300)
+60 ;
+61 ;
QUIT
+62 ;
APPTLSTC(TITLE,SORTORDR,LISTFMT) ; Comma-delimited file
+1 ;
+2 ;
NEW SORT1,SORT2,SORT3,APPTDTTM,DFN,CLINIC,SDECIEN,SDECAPPT,PTAPPT,SCAPPT,ENCNTR,FMTDTTM,ENCTRSTS,VADM,APPTSTS,UNIQUEID
+3 ;
+4 ;
USE IO
+5 ;
+6 ; Output first row - list of data fields
+7 ;
+8 ;
IF SORTORDR=1
Begin DoDot:1
+9 ;
IF $GET(LISTFMT)'=2
WRITE $$COMMAOUT^EHM13UTIL(8,"Appt Date/Time","Patient","SSN","Clinic","Appt Status","Encounter Status","Encounter ID","Encounter IEN"),!
+10 ;
IF '$TEST
WRITE $$COMMAOUT^EHM13UTIL(10,"Appt Date/Time","Patient","SSN","Clinic","Status","Encounter Status","Encounter ID","Encounter IEN","Appt Made","Made By"),!
End DoDot:1
+11 ;
IF SORTORDR=2
Begin DoDot:1
+12 ;
IF $GET(LISTFMT)'=2
WRITE $$COMMAOUT^EHM13UTIL(8,"Clinic","Appt Date/Time","Patient","SSN","Appt Status","Encounter Status","Encounter ID","Encounter IEN",),!
+13 ;
IF '$TEST
WRITE $$COMMAOUT^EHM13UTIL(10,"Clinic","Appt Date/Time","Patient","SSN","Appt Status","Encounter Status","Encounter ID","Encounter IEN","Appt Made","Made By"),!
End DoDot:1
+14 ;
IF SORTORDR=3
Begin DoDot:1
+15 ;
IF $GET(LISTFMT)'=2
WRITE $$COMMAOUT^EHM13UTIL(8,"Patient","SSN","Appt Date/Time","Clinic","Appt Status","Encounter Status","Encounter ID","Encounter IEN"),!
+16 ;
IF '$TEST
WRITE $$COMMAOUT^EHM13UTIL(10,"Patient","SSN","Appt Date/Time","Clinic","Appt Status","Encounter Status","Encounter ID","Encounter IEN","Appt Made","Made By"),!
End DoDot:1
+17 ;
+18 ; Scan sorted data in ^TMP($J)
+19 ;
+20 ;
SET SORT1=""
FOR
SET SORT1=$ORDER(^TMP($JOB,SORT1))
if SORT1=""
QUIT
Begin DoDot:1
+21 ;
SET SORT2=""
FOR
SET SORT2=$ORDER(^TMP($JOB,SORT1,SORT2))
if SORT2=""
QUIT
Begin DoDot:2
+22 ;
SET SORT3=""
FOR
SET SORT3=$ORDER(^TMP($JOB,SORT1,SORT2,SORT3))
if SORT3=""
QUIT
Begin DoDot:3
+23 ;
IF SORTORDR=1
SET APPTDTTM=SORT1
SET DFN=$PIECE(SORT2,U,2)
SET CLINIC=$PIECE(SORT3,U,2)
+24 ;
IF SORTORDR=2
SET CLINIC=$PIECE(SORT1,U,2)
SET APPTDTTM=SORT2
SET DFN=$PIECE(SORT3,U,2)
+25 ;
IF SORTORDR=3
SET DFN=$PIECE(SORT1,U,2)
SET APPTDTTM=SORT2
SET CLINIC=$PIECE(SORT3,U,2)
+26 ;
+27 ;
SET SDECAPPT=$GET(^TMP($JOB,SORT1,SORT2,SORT3,409.84))
SET SDECIEN=$PIECE(SDECAPPT,U,1)
SET SDECAPPT=$PIECE(SDECAPPT,U,2,999)
+28 ;
SET PTAPPT=$GET(^TMP($JOB,SORT1,SORT2,SORT3,2))
SET ENCNTR=$PIECE(PTAPPT,U,20)
+29 ;
SET SCAPPT=$GET(^TMP($JOB,SORT1,SORT2,SORT3,44))
+30 ;
KILL VADM
DO DEM^VADPT
+31 ;
+32 ;
SET FMTDTTM=$$FMTDTTM^EHM13UTIL(APPTDTTM)
SET ENCTRSTS=$SELECT(ENCNTR'="":$$ENCTRSTS^EHM13UTIL(ENCNTR),1:"")
+33 ;
IF ENCTRSTS="ACTION REQUIRED"
IF $$MPTYNCTR^EHM13UTIL(ENCNTR)
SET ENCTRSTS="EMPTY"
+34 ; Encounter present but status is null.
IF ENCNTR'=""
IF ENCTRSTS=""
SET ENCTRSTS="blank"
+35 ; Encounter is not present.
IF ENCNTR=""
SET ENCTRSTS="none"
+36 ; Appointment status is null.
SET APPTSTS=$$GET1^DIQ(2.98,APPTDTTM_","_DFN,3)
IF APPTSTS=""
SET APPTSTS="blank"
+37 ;
SET UNIQUEID=""
IF ENCNTR'=""
SET UNIQUEID=$$GET1^DIQ(409.68,ENCNTR,.2)
+38 ;
+39 ;
IF SORTORDR=1
Begin DoDot:4
+40 ;
IF $GET(LISTFMT)'=2
WRITE $$COMMAOUT^EHM13UTIL(8,FMTDTTM,VADM(1),$PIECE($PIECE(VADM(2),U,2),"-",3),$$GET1^DIQ(44,CLINIC,.01),APPTSTS,ENCTRSTS,UNIQUEID,ENCNTR),!
+41 ;
IF '$TEST
WRITE $$COMMAOUT^EHM13UTIL(10,FMTDTTM,VADM(1),$PIECE($PIECE(VADM(2),U,2),"-",3),$$GET1^DIQ(44,CLINIC,.01),APPTSTS,ENCTRSTS,UNIQUEID,ENCNTR,$$FMTE^XLFDT($PIECE($PIECE(PTAPPT,U,19),".",1),2),$$GET1^DIQ(200,$PIE
CE(PTAPPT,U,18),.01)),!
End DoDot:4
+42 ;
IF SORTORDR=2
Begin DoDot:4
+43 ;
IF $GET(LISTFMT)'=2
WRITE $$COMMAOUT^EHM13UTIL(8,$$GET1^DIQ(44,CLINIC,.01),FMTDTTM,VADM(1),$PIECE($PIECE(VADM(2),U,2),"-",3),APPTSTS,ENCTRSTS,UNIQUEID,ENCNTR),!
+44 ;
IF '$TEST
WRITE $$COMMAOUT^EHM13UTIL(10,$$GET1^DIQ(44,CLINIC,.01),FMTDTTM,VADM(1),$PIECE($PIECE(VADM(2),U,2),"-",3),APPTSTS,ENCTRSTS,UNIQUEID,ENCNTR,$$FMTE^XLFDT($PIECE($PIECE(PTAPPT,U,19),".",1),2),$$GET1^DIQ(200,$PIE
CE(PTAPPT,U,18),.01)),!
End DoDot:4
+45 ;
IF SORTORDR=3
Begin DoDot:4
+46 ;
IF $GET(LISTFMT)'=2
WRITE $$COMMAOUT^EHM13UTIL(8,VADM(1),$PIECE($PIECE(VADM(2),U,2),"-",3),FMTDTTM,$$GET1^DIQ(44,CLINIC,.01),APPTSTS,ENCTRSTS,UNIQUEID,ENCNTR),!
+47 ;
IF '$TEST
WRITE $$COMMAOUT^EHM13UTIL(10,VADM(1),$PIECE($PIECE(VADM(2),U,2),"-",3),FMTDTTM,$$GET1^DIQ(44,CLINIC,.01),APPTSTS,ENCTRSTS,UNIQUEID,ENCNTR,$$FMTE^XLFDT($PIECE($PIECE(PTAPPT,U,19),".",1),2),$$GET1^DIQ(200,$PIE
CE(PTAPPT,U,18),.01)),!
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+48 ;
+49 ;
QUIT
+50 ;
