EHMAPTRQ ;ALB/WTC - EHRM APPOINTMENT REQUEST MAINTENANCE; Jun 06, 2025@11:46:51
;;1.0;ELECTRONIC HEALTH MODERNIZATION;**13**;Apr 19, 2021;Build 27
;
;
Q ;
;
OPENRQST(SORTORDR,PROGRESS,SOURCE) ;
;
; SORTORDR = Sort order (1,2,3 - see below). [OPTIONAL - set by cleanup routines only]
; PROGRESS = Show progress scanning files (1=YES, 0=NO) [OPTIONAL, DEFAULT=1]
; SOURCE = Request source (ALL, REQ, WAIT, RECALL) [OPTIONAL, DEFAULT=ALL]
;
; Open appointment request list. Select active appointment requests. Returns list in ^TMP($J).
;
; ^TMP($J)=SORT ORDER (1,2,3)
; ^TMP($J,sorted values,409.85)=pointer to #409.85 ^ 0 node from file #409.85
;
; sorted values are made up of: appointment request 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 DIR,DFN,RQSTDATE,CLINIC,CLINNAME,IEN,X,Y,I ;
K ^TMP($J) S ^TMP($J)=SORTORDR,SOURCE=$G(SOURCE,"ALL") ;
;
S PROGRESS=$S($G(PROGRESS)="":1,1:PROGRESS) ;
;
; Scan SDEC Appointment Request file (#409.85)
;
I SOURCE="ALL"!(SOURCE="REQ") D ;
. ;
. I PROGRESS W !,"Scanning ",$P(^DIC(409.85,0),U,1)," file.",! ;
. ;
. S IEN=0,I=0 ;
. F S IEN=$O(^SDEC(409.85,IEN)) Q:'IEN S X=$G(^(IEN,0)) I X'="",$P(X,U,17)'="C" S RQSTDATE=$P(X,U,16) I RQSTDATE'="" D ;
.. S I=I+1 D:I#100=0&PROGRESS PROGRESS^EHM13UTIL(I) ;
.. ;
.. S DFN=$P(X,U,1),CLINIC=$P(X,U,9),CLINNAME=$S(CLINIC'="":$$GET1^DIQ(44,CLINIC,.01),1:"NOT SPECIFIED") ;
.. ;
.. ; Build ^TMP($J) in sort order
.. ;
.. I SORTORDR=1 D Q ;
... S ^TMP($J,RQSTDATE,$$GET1^DIQ(2,DFN,.01)_U_DFN,CLINNAME_U_CLINIC,409.85)=IEN_U_X ;
.. ;
.. I SORTORDR=2 D Q ;
... S ^TMP($J,CLINNAME_U_CLINIC,RQSTDATE,$$GET1^DIQ(2,DFN,.01)_U_DFN,409.85)=IEN_U_X ;
.. ;
.. I SORTORDR=3 D Q ;
... S ^TMP($J,$$GET1^DIQ(2,DFN,.01)_U_DFN,RQSTDATE,CLINNAME_U_CLINIC,409.85)=IEN_U_X ;
;
;
; Scan SD Wait List file (#409.3)
;
I SOURCE="ALL"!(SOURCE="WAIT") D ;
. ;
. I PROGRESS W !,"Scanning ",$P(^DIC(409.3,0),U,1)," file.",! ;
. ;
. S IEN=0,I=0 ;
. F S IEN=$O(^SDWL(409.3,IEN)) Q:'IEN S X=$G(^(IEN,0)) I X'="",$P(X,U,17)'="C" S RQSTDATE=$P(X,U,2) I RQSTDATE'="" D ;
.. S I=I+1 D:I#100=0&PROGRESS PROGRESS^EHM13UTIL(I) ;
.. ;
.. S DFN=$P(X,U,1),CLINIC=$P(X,U,9),CLINNAME=$S(CLINIC'="":$$GET1^DIQ(44,CLINIC,.01),1:"NOT SPECIFIED") ;
.. ;
.. ; Build ^TMP($J) in sort order
.. ;
.. I SORTORDR=1 D Q ;
... S ^TMP($J,RQSTDATE,$$GET1^DIQ(2,DFN,.01)_U_DFN,CLINNAME_U_CLINIC,409.3)=IEN_U_X ;
.. ;
.. I SORTORDR=2 D Q ;
... S ^TMP($J,CLINNAME_U_CLINIC,RQSTDATE,$$GET1^DIQ(2,DFN,.01)_U_DFN,409.3)=IEN_U_X ;
.. ;
.. I SORTORDR=3 D Q ;
... S ^TMP($J,$$GET1^DIQ(2,DFN,.01)_U_DFN,RQSTDATE,CLINNAME_U_CLINIC,409.3)=IEN_U_X ;
;
;
; Scan Recall Reminders file (#403.5)
;
I SOURCE="ALL"!(SOURCE="RECALL") D ;
. ;
. I PROGRESS W !,"Scanning ",$P(^DIC(403.5,0),U,1)," file.",! ;
. ;
. S IEN=0,I=0 ;
. F S IEN=$O(^SD(403.5,IEN)) Q:'IEN S X=$G(^(IEN,0)) I X'="" S RQSTDATE=$P(X,U,6) I RQSTDATE'="" D ;
.. S I=I+1 D:I#100=0&PROGRESS PROGRESS^EHM13UTIL(I) ;
.. ;
.. S DFN=$P(X,U,1),CLINIC=$P(X,U,2),CLINNAME=$S(CLINIC'="":$$GET1^DIQ(44,CLINIC,.01),1:"NOT SPECIFIED") ;
.. ;
.. ; Build ^TMP($J) in sort order
.. ;
.. I SORTORDR=1 D Q ;
... S ^TMP($J,RQSTDATE,$$GET1^DIQ(2,DFN,.01)_U_DFN,CLINNAME_U_CLINIC,403.5)=IEN_U_X ;
.. ;
.. I SORTORDR=2 D Q ;
... S ^TMP($J,CLINNAME_U_CLINIC,RQSTDATE,$$GET1^DIQ(2,DFN,.01)_U_DFN,403.5)=IEN_U_X ;
.. ;
.. I SORTORDR=3 D Q ;
... S ^TMP($J,$$GET1^DIQ(2,DFN,.01)_U_DFN,RQSTDATE,CLINNAME_U_CLINIC,403.5)=IEN_U_X ;
;
Q ;
;
RQSTLIST ;
;
; List appointment requests.
;
N SORTORDR,DFN,RQSTDATE,CLINIC,CLINNAME,X1,X2,X3,SORT1,SORT2,SORT3,DIR,OUTPTFMT,Y,POP,%ZIS,DIRUT,QUEUED,SOURCE ;
;
; Source selection
;
K DIR S DIR(0)="SO^ALL:All Sources;REQ:Appointment Requests;WAIT:Wait List;RECALL:Recall Reminders",DIR("A")="Source",DIR("B")="All Sources" D ^DIR Q:$D(DIRUT) S SOURCE=Y ;
;
; Sort Order
;
I $G(SORTORDR)="" D Q:$D(DIRUT) ;
. S DIR(0)="S^1:Requested Date of Appointment, Patient, Requested Clinic;2:Requested Clinic, Requested Date of Appointment, Patient;3:Patient, Requested Date of Appointment, Requested Clinic",DIR("A")="Sort Order",DIR("B")=1 ;
. D ^DIR Q:$D(DIRUT) S SORTORDR=Y ;
;
; Output format
;
K DIR S DIR(0)="SO^F:Formatted Report;C:Comma-Delimited",DIR("A")="Output Format",DIR("B")="Formatted Report" D ^DIR Q:$D(DIRUT) S OUTPTFMT=Y ;
;
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="RQSTLST1^EHMAPTRQ",ZTDESC="Appointment Request List" ;
. S ZTSAVE("*")="" ;
. D ^%ZTLOAD W $S($D(ZTSK):"...Task queued",1:"...Task cancelled"),! ;
;
RQSTLST1 ; TaskMan start point
;
; Create appointment request list.
;
D OPENRQST(SORTORDR,1,SOURCE) ;
;
; List appointment requests
;
I OUTPTFMT="F" D APPTLSTF("Open Appointment Request List",SORTORDR,QUEUED) ; Formatted report
I OUTPTFMT="C" D APPTLSTC("Open Appointment Request List",SORTORDR) ; Comma-delimited file
;
U 0 I 'QUEUED,IO=$I R !,"Press [RETURN] to continue",X:$G(DTIME,300) ;
;
D ^%ZISC ;
K ^TMP($J) ;
Q ;
;
;
; TITLE = Report title
; SORTORDR = Sort order (1,2,3)
;
W @IOF,$$CENTER^EHM13UTIL(TITLE_" - Station "_$P($$SITE^VASITE(),U,3),IOM),!! ;
;
I SORTORDR=1 D ;
. W "CID/Preferred",!,"Date of Appt",?16,"Patient",?48,"Clinic",?80,"Source",?97,"Req IEN",! ;
. W $$DASHES^EHM13UTIL(14),?16,$$DASHES^EHM13UTIL(30),?48,$$DASHES^EHM13UTIL(30),?80,$$DASHES^EHM13UTIL(15),?97,$$DASHES^EHM13UTIL(9),! ;
;
I SORTORDR=2 D ;
. W ?32,"CID/Preferred",!,"Clinic",?32,"Date of Appt",?48,"Patient",?80,"Source",?97,"Req IEN",! ;
. W $$DASHES^EHM13UTIL(30),?32,$$DASHES^EHM13UTIL(14),?48,$$DASHES^EHM13UTIL(30),?80,$$DASHES^EHM13UTIL(15),?97,$$DASHES^EHM13UTIL(9),! ;
;
I SORTORDR=3 D ;
. W ?32,"CID/Preferred",!,"Patient",?32,"Date of Appt",?48,"Clinic",?80,"Source",?97,"Req IEN",! ;
. W $$DASHES^EHM13UTIL(30),?32,$$DASHES^EHM13UTIL(14),?48,$$DASHES^EHM13UTIL(30),?80,$$DASHES^EHM13UTIL(15),?97,$$DASHES^EHM13UTIL(9),! ;
;
Q ;
;
APPTLSTF(TITLE,SORTORDR,QUEUED) ; Formatted Report
;
N LINES,QUIT,SORT1,SORT2,SORT3,RQSTDATE,DFN,CLINNAME,RECRDCT,SOURCE,VADM,IEN40985 ;
;
U IO D HEADER(TITLE,SORTORDR) ;
S LINES=0,QUIT=0,RECRDCT=0 ;
;
; 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 RQSTDATE=SORT1,DFN=$P(SORT2,U,2),CLINIC=$P(SORT3,U,2) ;
... I SORTORDR=2 S CLINIC=$P(SORT1,U,2),RQSTDATE=SORT2,DFN=$P(SORT3,U,2) ;
... I SORTORDR=3 S DFN=$P(SORT1,U,2),RQSTDATE=SORT2,CLINIC=$P(SORT3,U,2) ;
... K VADM D DEM^VADPT ;
... ;
... S SOURCE=$S($D(^TMP($J,SORT1,SORT2,SORT3,409.85)):"APPT REQ",$D(^TMP($J,SORT1,SORT2,SORT3,409.3)):"WAIT LIST",$D(^TMP($J,SORT1,SORT2,SORT3,403.5)):"RECALL",1:"") ;
... S IEN40985="" ;
... I SOURCE="APPT REQ" S REQTYPE=$P(^TMP($J,SORT1,SORT2,SORT3,409.85),U,6),IEN40985=$P(^(409.85),U,1),SOURCE=SOURCE_"-"_$S(REQTYPE="APPT":"APPT",REQTYPE="RTC":"RTC",1:"OTHER") ;
... ;
... ; 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 Q:QUIT U IO D HEADER(TITLE,SORTORDR) S LINES=1 Q ;
.... ;
.... ; New page header for printed report
.... ;
.... I LINES'<IOSL U IO D HEADER(TITLE,SORTORDR) S LINES=1 ;
... ;
... U IO ;
... I SORTORDR=1 D ;
.... W $$FMTE^XLFDT(RQSTDATE),?16,$$LASTFI^EHM13UTIL(,VADM(1))," (",$P($P(VADM(2),U,2),"-",3),")",?48,$$GET1^DIQ(44,CLINIC,.01),?80,SOURCE,?97,$J(IEN40985,9),! ;
... I SORTORDR=2 D ;
.... W $$GET1^DIQ(44,CLINIC,.01),?32,$$FMTE^XLFDT(RQSTDATE),?48,$$LASTFI^EHM13UTIL(,VADM(1))," (",$P($P(VADM(2),U,2),"-",3),")",?80,SOURCE,?97,$J(IEN40985,9),! ;
... I SORTORDR=3 D ;
.... W $$LASTFI^EHM13UTIL(,VADM(1))," (",$P($P(VADM(2),U,2),"-",3),")",?32,$$FMTE^XLFDT(RQSTDATE),?48,$$GET1^DIQ(44,CLINIC,.01),?80,SOURCE,?97,$J(IEN40985,9),! ;
... S LINES=LINES+1,RECRDCT=RECRDCT+1 ;
W !,"TOTAL RECORDS = ",RECRDCT,! ;
;
Q ;
;
APPTLSTC(TITLE,SORTORDR) ; Comma-delimited file
;
N SORT1,SORT2,SORT3,RQSTDATE,DFN,CLINIC,SOURCE ;
;
U IO ;
;
; Output first row - list of data fields
;
I SORTORDR=1 W $$COMMAOUT^EHM13UTIL(5,"CID/Preferred Date of Appt","Patient","Clinic","Source","Req IEN"),! ;
I SORTORDR=2 W $$COMMAOUT^EHM13UTIL(5,"Clinic","CID/Preferred Date of Appt","Patient","Source","Req IEN"),! ;
I SORTORDR=3 W $$COMMAOUT^EHM13UTIL(5,"Patient","CID/Preferred Date of Appt","Clinic","Source","Req IEN"),! ;
;
; 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 RQSTDATE=SORT1,DFN=$P(SORT2,U,2),CLINIC=$P(SORT3,U,2) ;
... I SORTORDR=2 S CLINIC=$P(SORT1,U,2),RQSTDATE=SORT2,DFN=$P(SORT3,U,2) ;
... I SORTORDR=3 S DFN=$P(SORT1,U,2),RQSTDATE=SORT2,CLINIC=$P(SORT3,U,2) ;
... ;
... S SOURCE=$S($D(^TMP($J,SORT1,SORT2,SORT3,409.85)):"APPT REQ",$D(^TMP($J,SORT1,SORT2,SORT3,409.3)):"WAIT LIST",$D(^TMP($J,SORT1,SORT2,SORT3,403.5)):"RECALL",1:"") ;
... S IEN40985="" ;
... I SOURCE="APPT REQ" S IEN40985=$P(^TMP($J,SORT1,SORT2,SORT3,409.85),U,1) ;
... ;
... I SORTORDR=1 D ;
.... W $$COMMAOUT^EHM13UTIL(5,$$FMTE^XLFDT(RQSTDATE),$$GET1^DIQ(2,DFN,.01),$$GET1^DIQ(44,CLINIC,.01),SOURCE,IEN40985),! ;
... I SORTORDR=2 D ;
.... W $$COMMAOUT^EHM13UTIL(5,$$GET1^DIQ(44,CLINIC,.01),$$FMTE^XLFDT(RQSTDATE),$$GET1^DIQ(2,DFN,.01),SOURCE,IEN40985),! ;
... I SORTORDR=3 D ;
.... W $$COMMAOUT^EHM13UTIL(5,$$GET1^DIQ(2,DFN,.01),$$FMTE^XLFDT(RQSTDATE),$$GET1^DIQ(44,CLINIC,.01),SOURCE,IEN40985),! ;
;
Q ;
;
SUMMARY ;
;
; Generate summary of appointment requests
;
N RQSTDATE,CLINNAME,SORT1,SORT2,SORT3,YYYYMM,SOURCE,COUNT,TOTAL,QUEUED,SOURCE ;
;
; Source selection
;
K DIR S DIR(0)="SO^ALL:All Sources;REQ:Appointment Requests;WAIT:Wait List;RECALL:Recall Reminders",DIR("A")="Source",DIR("B")="ALL Sources" D ^DIR Q:$D(DIRUT) S SOURCE=Y ;
;
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="SUMMARY1^EHMAPTRQ",ZTDESC="Appointment Request Summary" ;
. S ZTSAVE("*")="" ;
. D ^%ZTLOAD W $S($D(ZTSK):"...Task queued",1:"...Task cancelled"),! ;
;
SUMMARY1 ; TaskMan entry point
;
; Output summary report.
;
N TITLE,LINES,QUIT,REQTYPE ;
;
; Create appointment request list.
;
I QUEUED D OPENRQST(1,0,SOURCE) ;
I 'QUEUED D OPENRQST(1,1,SOURCE) ;
;
; Scan sorted data in ^TMP($J) and summarize data.
;
K ^TMP("EHMAPTRQ",$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 ;
... S RQSTDATE=SORT1,CLINNAME=$P(SORT3,U,1),YYYYMM=($E(RQSTDATE,1,3)+1700)_"/"_$E(RQSTDATE,4,5) ;
... ;
... S SOURCE=$S($D(^TMP($J,SORT1,SORT2,SORT3,409.85)):"APPT REQ",$D(^TMP($J,SORT1,SORT2,SORT3,409.3)):"WAIT LIST",$D(^TMP($J,SORT1,SORT2,SORT3,403.5)):"RECALL",1:"") ;
... I SOURCE="APPT REQ" S REQTYPE=$P(^TMP($J,SORT1,SORT2,SORT3,409.85),U,6),SOURCE=SOURCE_"-"_$S(REQTYPE="APPT":"APPT",REQTYPE="RTC":"RTC",1:"OTHER") ;
... ;
... S ^(SOURCE)=$G(^TMP("EHMAPTRQ",$J,"SOURCE",SOURCE))+1 ;
... S ^(YYYYMM)=$G(^TMP("EHMAPTRQ",$J,"DATE",YYYYMM))+1 ;
... S ^(CLINNAME)=$G(^TMP("EHMAPTRQ",$J,"CLINIC",CLINNAME))+1 ;
;
U IO D SUMHDR("SOURCE",18) ;
S TOTAL=0,QUIT=0 F SOURCE="APPT REQ-APPT","APPT REQ-RTC","APPT REQ-OTHER","RECALL","WAIT LIST" S COUNT=+$G(^TMP("EHMAPTRQ",$J,"SOURCE",SOURCE)) W SOURCE,?20,$J(COUNT,8),! S TOTAL=TOTAL+COUNT ;
W $$DASHES^EHM13UTIL(15),?20,$$DASHES^EHM13UTIL(8),!,"TOTAL",?20,$J(TOTAL,8),! ;
I 'QUEUED S QUIT=$$CONTINUE^EHM13UTIL()=0 I QUIT K ^TMP($J),^TMP("EHMAPTRQ",$J) D ^%ZISC Q ;
;
D SUMHDR("DATE",10) ;
S TOTAL=0,YYYYMM=0,LINES=0,QUIT=0 ;
F S YYYYMM=$O(^TMP("EHMAPTRQ",$J,"DATE",YYYYMM)) Q:'YYYYMM S COUNT=^(YYYYMM) D Q:QUIT ;
. ;
. ; 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 Q:QUIT U IO D SUMHDR("CLINIC",10) S LINES=1 Q ;
.. ;
.. ; New page header for printed report
.. ;
.. I LINES'<IOSL U IO D SUMHDR("CLINIC",10) S LINES=1 ;
. ;
. U IO W $P(YYYYMM,"/",2),"/",$P(YYYYMM,"/",1),?12,$J(COUNT,8),! S TOTAL=TOTAL+COUNT,LINES=LINES+1 ;
I 'QUIT W $$DASHES^EHM13UTIL(9),?12,$$DASHES^EHM13UTIL(8),!,"TOTAL",?12,$J(TOTAL,8),! ;
I QUIT K ^TMP($J),^TMP("EHMAPTRQ",$J) D ^%ZISC Q ;
I 'QUEUED,'QUIT S QUIT=$$CONTINUE^EHM13UTIL()=0 Q:QUIT ;
;
D SUMHDR("CLINIC",30) ;
S TOTAL=0,CLINNAME="",LINES=0,QUIT=0 ;
F S CLINNAME=$O(^TMP("EHMAPTRQ",$J,"CLINIC",CLINNAME)) Q:CLINNAME="" S COUNT=^(CLINNAME) D Q:QUIT ;
. ;
. ; 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 Q:QUIT U IO D SUMHDR("CLINIC",30) S LINES=1 Q ;
.. ;
.. ; New page header for printed report
.. ;
.. I LINES'<IOSL U IO D SUMHDR("CLINIC",30) S LINES=1 ;
. ;
. U IO W CLINNAME,?32,$J(COUNT,8),! S TOTAL=TOTAL+COUNT,LINES=LINES+1 ;
I 'QUIT W $$DASHES^EHM13UTIL(30),?32,$$DASHES^EHM13UTIL(8),!,"TOTAL",?32,$J(TOTAL,8),! ;
;
U 0 I 'QUEUED,IO=$I R !,"Press [RETURN] to continue",X:$G(DTIME,300) ;
;
K ^TMP($J),^TMP("EHMAPTRQ",$J) D ^%ZISC ;
Q ;
;
SUMHDR(COLUMN1,WIDTH1) ;
;
W @IOF,$$CENTER^EHM13UTIL("Appointment Request Summary",IOM),! ;
W !,COLUMN1,?WIDTH1+2,"COUNT",!,$$DASHES^EHM13UTIL(WIDTH1),?WIDTH1+2,$$DASHES^EHM13UTIL(8),! ;
Q ;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEHMAPTRQ 14591 printed Apr 22, 2026@13:48:24 Page 2
EHMAPTRQ ;ALB/WTC - EHRM APPOINTMENT REQUEST MAINTENANCE; Jun 06, 2025@11:46:51
+1 ;;1.0;ELECTRONIC HEALTH MODERNIZATION;**13**;Apr 19, 2021;Build 27
+2 ;
+3 ;
+4 ;
QUIT
+5 ;
OPENRQST(SORTORDR,PROGRESS,SOURCE) ;
+1 ;
+2 ; SORTORDR = Sort order (1,2,3 - see below). [OPTIONAL - set by cleanup routines only]
+3 ; PROGRESS = Show progress scanning files (1=YES, 0=NO) [OPTIONAL, DEFAULT=1]
+4 ; SOURCE = Request source (ALL, REQ, WAIT, RECALL) [OPTIONAL, DEFAULT=ALL]
+5 ;
+6 ; Open appointment request list. Select active appointment requests. Returns list in ^TMP($J).
+7 ;
+8 ; ^TMP($J)=SORT ORDER (1,2,3)
+9 ; ^TMP($J,sorted values,409.85)=pointer to #409.85 ^ 0 node from file #409.85
+10 ;
+11 ; sorted values are made up of: appointment request date/time in FileMan format (e.g., 3230701.1209)
+12 ; patient as LAST NAME,FIRST NAME ^ DFN (e.g., SMITH,JOHN A^12345)
+13 ; clinic as NAME ^ IEN in file #44. (e.g., MEDICAL CLINIC^12345)
+14 ;
+15 ;
NEW DIR,DFN,RQSTDATE,CLINIC,CLINNAME,IEN,X,Y,I
+16 ;
KILL ^TMP($JOB)
SET ^TMP($JOB)=SORTORDR
SET SOURCE=$GET(SOURCE,"ALL")
+17 ;
+18 ;
SET PROGRESS=$SELECT($GET(PROGRESS)="":1,1:PROGRESS)
+19 ;
+20 ; Scan SDEC Appointment Request file (#409.85)
+21 ;
+22 ;
IF SOURCE="ALL"!(SOURCE="REQ")
Begin DoDot:1
+23 ;
+24 ;
IF PROGRESS
WRITE !,"Scanning ",$PIECE(^DIC(409.85,0),U,1)," file.",!
+25 ;
+26 ;
SET IEN=0
SET I=0
+27 ;
FOR
SET IEN=$ORDER(^SDEC(409.85,IEN))
if 'IEN
QUIT
SET X=$GET(^(IEN,0))
IF X'=""
IF $PIECE(X,U,17)'="C"
SET RQSTDATE=$PIECE(X,U,16)
IF RQSTDATE'=""
Begin DoDot:2
+28 ;
SET I=I+1
if I#100=0&PROGRESS
DO PROGRESS^EHM13UTIL(I)
+29 ;
+30 ;
SET DFN=$PIECE(X,U,1)
SET CLINIC=$PIECE(X,U,9)
SET CLINNAME=$SELECT(CLINIC'="":$$GET1^DIQ(44,CLINIC,.01),1:"NOT SPECIFIED")
+31 ;
+32 ; Build ^TMP($J) in sort order
+33 ;
+34 ;
IF SORTORDR=1
Begin DoDot:3
+35 ;
SET ^TMP($JOB,RQSTDATE,$$GET1^DIQ(2,DFN,.01)_U_DFN,CLINNAME_U_CLINIC,409.85)=IEN_U_X
End DoDot:3
QUIT
+36 ;
+37 ;
IF SORTORDR=2
Begin DoDot:3
+38 ;
SET ^TMP($JOB,CLINNAME_U_CLINIC,RQSTDATE,$$GET1^DIQ(2,DFN,.01)_U_DFN,409.85)=IEN_U_X
End DoDot:3
QUIT
+39 ;
+40 ;
IF SORTORDR=3
Begin DoDot:3
+41 ;
SET ^TMP($JOB,$$GET1^DIQ(2,DFN,.01)_U_DFN,RQSTDATE,CLINNAME_U_CLINIC,409.85)=IEN_U_X
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+42 ;
+43 ;
+44 ; Scan SD Wait List file (#409.3)
+45 ;
+46 ;
IF SOURCE="ALL"!(SOURCE="WAIT")
Begin DoDot:1
+47 ;
+48 ;
IF PROGRESS
WRITE !,"Scanning ",$PIECE(^DIC(409.3,0),U,1)," file.",!
+49 ;
+50 ;
SET IEN=0
SET I=0
+51 ;
FOR
SET IEN=$ORDER(^SDWL(409.3,IEN))
if 'IEN
QUIT
SET X=$GET(^(IEN,0))
IF X'=""
IF $PIECE(X,U,17)'="C"
SET RQSTDATE=$PIECE(X,U,2)
IF RQSTDATE'=""
Begin DoDot:2
+52 ;
SET I=I+1
if I#100=0&PROGRESS
DO PROGRESS^EHM13UTIL(I)
+53 ;
+54 ;
SET DFN=$PIECE(X,U,1)
SET CLINIC=$PIECE(X,U,9)
SET CLINNAME=$SELECT(CLINIC'="":$$GET1^DIQ(44,CLINIC,.01),1:"NOT SPECIFIED")
+55 ;
+56 ; Build ^TMP($J) in sort order
+57 ;
+58 ;
IF SORTORDR=1
Begin DoDot:3
+59 ;
SET ^TMP($JOB,RQSTDATE,$$GET1^DIQ(2,DFN,.01)_U_DFN,CLINNAME_U_CLINIC,409.3)=IEN_U_X
End DoDot:3
QUIT
+60 ;
+61 ;
IF SORTORDR=2
Begin DoDot:3
+62 ;
SET ^TMP($JOB,CLINNAME_U_CLINIC,RQSTDATE,$$GET1^DIQ(2,DFN,.01)_U_DFN,409.3)=IEN_U_X
End DoDot:3
QUIT
+63 ;
+64 ;
IF SORTORDR=3
Begin DoDot:3
+65 ;
SET ^TMP($JOB,$$GET1^DIQ(2,DFN,.01)_U_DFN,RQSTDATE,CLINNAME_U_CLINIC,409.3)=IEN_U_X
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+66 ;
+67 ;
+68 ; Scan Recall Reminders file (#403.5)
+69 ;
+70 ;
IF SOURCE="ALL"!(SOURCE="RECALL")
Begin DoDot:1
+71 ;
+72 ;
IF PROGRESS
WRITE !,"Scanning ",$PIECE(^DIC(403.5,0),U,1)," file.",!
+73 ;
+74 ;
SET IEN=0
SET I=0
+75 ;
FOR
SET IEN=$ORDER(^SD(403.5,IEN))
if 'IEN
QUIT
SET X=$GET(^(IEN,0))
IF X'=""
SET RQSTDATE=$PIECE(X,U,6)
IF RQSTDATE'=""
Begin DoDot:2
+76 ;
SET I=I+1
if I#100=0&PROGRESS
DO PROGRESS^EHM13UTIL(I)
+77 ;
+78 ;
SET DFN=$PIECE(X,U,1)
SET CLINIC=$PIECE(X,U,2)
SET CLINNAME=$SELECT(CLINIC'="":$$GET1^DIQ(44,CLINIC,.01),1:"NOT SPECIFIED")
+79 ;
+80 ; Build ^TMP($J) in sort order
+81 ;
+82 ;
IF SORTORDR=1
Begin DoDot:3
+83 ;
SET ^TMP($JOB,RQSTDATE,$$GET1^DIQ(2,DFN,.01)_U_DFN,CLINNAME_U_CLINIC,403.5)=IEN_U_X
End DoDot:3
QUIT
+84 ;
+85 ;
IF SORTORDR=2
Begin DoDot:3
+86 ;
SET ^TMP($JOB,CLINNAME_U_CLINIC,RQSTDATE,$$GET1^DIQ(2,DFN,.01)_U_DFN,403.5)=IEN_U_X
End DoDot:3
QUIT
+87 ;
+88 ;
IF SORTORDR=3
Begin DoDot:3
+89 ;
SET ^TMP($JOB,$$GET1^DIQ(2,DFN,.01)_U_DFN,RQSTDATE,CLINNAME_U_CLINIC,403.5)=IEN_U_X
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+90 ;
+91 ;
QUIT
+92 ;
RQSTLIST ;
+1 ;
+2 ; List appointment requests.
+3 ;
+4 ;
NEW SORTORDR,DFN,RQSTDATE,CLINIC,CLINNAME,X1,X2,X3,SORT1,SORT2,SORT3,DIR,OUTPTFMT,Y,POP,%ZIS,DIRUT,QUEUED,SOURCE
+5 ;
+6 ; Source selection
+7 ;
+8 ;
KILL DIR
SET DIR(0)="SO^ALL:All Sources;REQ:Appointment Requests;WAIT:Wait List;RECALL:Recall Reminders"
SET DIR("A")="Source"
SET DIR("B")="All Sources"
DO ^DIR
if $DATA(DIRUT)
QUIT
SET SOURCE=Y
+9 ;
+10 ; Sort Order
+11 ;
+12 ;
IF $GET(SORTORDR)=""
Begin DoDot:1
+13 ;
SET DIR(0)="S^1:Requested Date of Appointment, Patient, Requested Clinic;2:Requested Clinic, Requested Date of Appointment, Patient;3:Patient, Requested Date of Appointment, Requested Clinic"
SET DIR("A")="Sort Order"
SET DIR("B")=1
+14 ;
DO ^DIR
if $DATA(DIRUT)
QUIT
SET SORTORDR=Y
End DoDot:1
if $DATA(DIRUT)
QUIT
+15 ;
+16 ; Output format
+17 ;
+18 ;
KILL DIR
SET DIR(0)="SO^F:Formatted Report;C:Comma-Delimited"
SET DIR("A")="Output Format"
SET DIR("B")="Formatted Report"
DO ^DIR
if $DATA(DIRUT)
QUIT
SET OUTPTFMT=Y
+19 ;
+20 ;
SET %ZIS="Q"
DO ^%ZIS
IF POP
KILL ^TMP($JOB)
QUIT
+21 ;
+22 ; If report is queued, add to Taskman
+23 ;
+24 ;
SET QUEUED=0
+25 ;
IF $DATA(IO("Q"))
SET QUEUED=1
Begin DoDot:1
+26 ;
NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+27 ;
SET ZTRTN="RQSTLST1^EHMAPTRQ"
SET ZTDESC="Appointment Request List"
+28 ;
SET ZTSAVE("*")=""
+29 ;
DO ^%ZTLOAD
WRITE $SELECT($DATA(ZTSK):"...Task queued",1:"...Task cancelled"),!
End DoDot:1
QUIT
+30 ;
RQSTLST1 ; TaskMan start point
+1 ;
+2 ; Create appointment request list.
+3 ;
+4 ;
DO OPENRQST(SORTORDR,1,SOURCE)
+5 ;
+6 ; List appointment requests
+7 ;
+8 ; Formatted report
IF OUTPTFMT="F"
DO APPTLSTF("Open Appointment Request List",SORTORDR,QUEUED)
+9 ; Comma-delimited file
IF OUTPTFMT="C"
DO APPTLSTC("Open Appointment Request List",SORTORDR)
+10 ;
+11 ;
USE 0
IF 'QUEUED
IF IO=$IO
READ !,"Press [RETURN] to continue",X:$GET(DTIME,300)
+12 ;
+13 ;
DO ^%ZISC
+14 ;
KILL ^TMP($JOB)
+15 ;
QUIT
+16 ;
+1 ;
+2 ; TITLE = Report title
+3 ; SORTORDR = Sort order (1,2,3)
+4 ;
+5 ;
WRITE @IOF,$$CENTER^EHM13UTIL(TITLE_" - Station "_$PIECE($$SITE^VASITE(),U,3),IOM),!!
+6 ;
+7 ;
IF SORTORDR=1
Begin DoDot:1
+8 ;
WRITE "CID/Preferred",!,"Date of Appt",?16,"Patient",?48,"Clinic",?80,"Source",?97,"Req IEN",!
+9 ;
WRITE $$DASHES^EHM13UTIL(14),?16,$$DASHES^EHM13UTIL(30),?48,$$DASHES^EHM13UTIL(30),?80,$$DASHES^EHM13UTIL(15),?97,$$DASHES^EHM13UTIL(9),!
End DoDot:1
+10 ;
+11 ;
IF SORTORDR=2
Begin DoDot:1
+12 ;
WRITE ?32,"CID/Preferred",!,"Clinic",?32,"Date of Appt",?48,"Patient",?80,"Source",?97,"Req IEN",!
+13 ;
WRITE $$DASHES^EHM13UTIL(30),?32,$$DASHES^EHM13UTIL(14),?48,$$DASHES^EHM13UTIL(30),?80,$$DASHES^EHM13UTIL(15),?97,$$DASHES^EHM13UTIL(9),!
End DoDot:1
+14 ;
+15 ;
IF SORTORDR=3
Begin DoDot:1
+16 ;
WRITE ?32,"CID/Preferred",!,"Patient",?32,"Date of Appt",?48,"Clinic",?80,"Source",?97,"Req IEN",!
+17 ;
WRITE $$DASHES^EHM13UTIL(30),?32,$$DASHES^EHM13UTIL(14),?48,$$DASHES^EHM13UTIL(30),?80,$$DASHES^EHM13UTIL(15),?97,$$DASHES^EHM13UTIL(9),!
End DoDot:1
+18 ;
+19 ;
QUIT
+20 ;
APPTLSTF(TITLE,SORTORDR,QUEUED) ; Formatted Report
+1 ;
+2 ;
NEW LINES,QUIT,SORT1,SORT2,SORT3,RQSTDATE,DFN,CLINNAME,RECRDCT,SOURCE,VADM,IEN40985
+3 ;
+4 ;
USE IO
DO HEADER(TITLE,SORTORDR)
+5 ;
SET LINES=0
SET QUIT=0
SET RECRDCT=0
+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 RQSTDATE=SORT1
SET DFN=$PIECE(SORT2,U,2)
SET CLINIC=$PIECE(SORT3,U,2)
+13 ;
IF SORTORDR=2
SET CLINIC=$PIECE(SORT1,U,2)
SET RQSTDATE=SORT2
SET DFN=$PIECE(SORT3,U,2)
+14 ;
IF SORTORDR=3
SET DFN=$PIECE(SORT1,U,2)
SET RQSTDATE=SORT2
SET CLINIC=$PIECE(SORT3,U,2)
+15 ;
KILL VADM
DO DEM^VADPT
+16 ;
+17 ;
SET SOURCE=$SELECT($DATA(^TMP($JOB,SORT1,SORT2,SORT3,409.85)):"APPT REQ",$DATA(^TMP($JOB,SORT1,SORT2,SORT3,409.3)):"WAIT LIST",$DATA(^TMP($JOB,SORT1,SORT2,SORT3,403.5)):"RECALL",1:"")
+18 ;
SET IEN40985=""
+19 ;
IF SOURCE="APPT REQ"
SET REQTYPE=$PIECE(^TMP($JOB,SORT1,SORT2,SORT3,409.85),U,6)
SET IEN40985=$PIECE(^(409.85),U,1)
SET SOURCE=SOURCE_"-"_$SELECT(REQTYPE="APPT":"APPT",REQTYPE="RTC":"RTC",1:"OTHER")
+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
if QUIT
QUIT
USE IO
DO HEADER(TITLE,SORTORDR)
SET LINES=1
QUIT
+26 ;
+27 ; New page header for printed report
+28 ;
+29 ;
IF LINES'<IOSL
USE IO
DO HEADER(TITLE,SORTORDR)
SET LINES=1
End DoDot:4
if QUIT
QUIT
+30 ;
+31 ;
USE IO
+32 ;
IF SORTORDR=1
Begin DoDot:4
+33 ;
WRITE $$FMTE^XLFDT(RQSTDATE),?16,$$LASTFI^EHM13UTIL(,VADM(1))," (",$PIECE($PIECE(VADM(2),U,2),"-",3),")",?48,$$GET1^DIQ(44,CLINIC,.01),?80,SOURCE,?97,$JUSTIFY(IEN40985,9),!
End DoDot:4
+34 ;
IF SORTORDR=2
Begin DoDot:4
+35 ;
WRITE $$GET1^DIQ(44,CLINIC,.01),?32,$$FMTE^XLFDT(RQSTDATE),?48,$$LASTFI^EHM13UTIL(,VADM(1))," (",$PIECE($PIECE(VADM(2),U,2),"-",3),")",?80,SOURCE,?97,$JUSTIFY(IEN40985,9),!
End DoDot:4
+36 ;
IF SORTORDR=3
Begin DoDot:4
+37 ;
WRITE $$LASTFI^EHM13UTIL(,VADM(1))," (",$PIECE($PIECE(VADM(2),U,2),"-",3),")",?32,$$FMTE^XLFDT(RQSTDATE),?48,$$GET1^DIQ(44,CLINIC,.01),?80,SOURCE,?97,$JUSTIFY(IEN40985,9),!
End DoDot:4
+38 ;
SET LINES=LINES+1
SET RECRDCT=RECRDCT+1
End DoDot:3
if QUIT
QUIT
End DoDot:2
if QUIT
QUIT
End DoDot:1
if QUIT
QUIT
+39 ;
WRITE !,"TOTAL RECORDS = ",RECRDCT,!
+40 ;
+41 ;
QUIT
+42 ;
APPTLSTC(TITLE,SORTORDR) ; Comma-delimited file
+1 ;
+2 ;
NEW SORT1,SORT2,SORT3,RQSTDATE,DFN,CLINIC,SOURCE
+3 ;
+4 ;
USE IO
+5 ;
+6 ; Output first row - list of data fields
+7 ;
+8 ;
IF SORTORDR=1
WRITE $$COMMAOUT^EHM13UTIL(5,"CID/Preferred Date of Appt","Patient","Clinic","Source","Req IEN"),!
+9 ;
IF SORTORDR=2
WRITE $$COMMAOUT^EHM13UTIL(5,"Clinic","CID/Preferred Date of Appt","Patient","Source","Req IEN"),!
+10 ;
IF SORTORDR=3
WRITE $$COMMAOUT^EHM13UTIL(5,"Patient","CID/Preferred Date of Appt","Clinic","Source","Req IEN"),!
+11 ;
+12 ; Scan sorted data in ^TMP($J)
+13 ;
+14 ;
SET SORT1=""
FOR
SET SORT1=$ORDER(^TMP($JOB,SORT1))
if SORT1=""
QUIT
Begin DoDot:1
+15 ;
SET SORT2=""
FOR
SET SORT2=$ORDER(^TMP($JOB,SORT1,SORT2))
if SORT2=""
QUIT
Begin DoDot:2
+16 ;
SET SORT3=""
FOR
SET SORT3=$ORDER(^TMP($JOB,SORT1,SORT2,SORT3))
if SORT3=""
QUIT
Begin DoDot:3
+17 ;
IF SORTORDR=1
SET RQSTDATE=SORT1
SET DFN=$PIECE(SORT2,U,2)
SET CLINIC=$PIECE(SORT3,U,2)
+18 ;
IF SORTORDR=2
SET CLINIC=$PIECE(SORT1,U,2)
SET RQSTDATE=SORT2
SET DFN=$PIECE(SORT3,U,2)
+19 ;
IF SORTORDR=3
SET DFN=$PIECE(SORT1,U,2)
SET RQSTDATE=SORT2
SET CLINIC=$PIECE(SORT3,U,2)
+20 ;
+21 ;
SET SOURCE=$SELECT($DATA(^TMP($JOB,SORT1,SORT2,SORT3,409.85)):"APPT REQ",$DATA(^TMP($JOB,SORT1,SORT2,SORT3,409.3)):"WAIT LIST",$DATA(^TMP($JOB,SORT1,SORT2,SORT3,403.5)):"RECALL",1:"")
+22 ;
SET IEN40985=""
+23 ;
IF SOURCE="APPT REQ"
SET IEN40985=$PIECE(^TMP($JOB,SORT1,SORT2,SORT3,409.85),U,1)
+24 ;
+25 ;
IF SORTORDR=1
Begin DoDot:4
+26 ;
WRITE $$COMMAOUT^EHM13UTIL(5,$$FMTE^XLFDT(RQSTDATE),$$GET1^DIQ(2,DFN,.01),$$GET1^DIQ(44,CLINIC,.01),SOURCE,IEN40985),!
End DoDot:4
+27 ;
IF SORTORDR=2
Begin DoDot:4
+28 ;
WRITE $$COMMAOUT^EHM13UTIL(5,$$GET1^DIQ(44,CLINIC,.01),$$FMTE^XLFDT(RQSTDATE),$$GET1^DIQ(2,DFN,.01),SOURCE,IEN40985),!
End DoDot:4
+29 ;
IF SORTORDR=3
Begin DoDot:4
+30 ;
WRITE $$COMMAOUT^EHM13UTIL(5,$$GET1^DIQ(2,DFN,.01),$$FMTE^XLFDT(RQSTDATE),$$GET1^DIQ(44,CLINIC,.01),SOURCE,IEN40985),!
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;
+32 ;
QUIT
+33 ;
SUMMARY ;
+1 ;
+2 ; Generate summary of appointment requests
+3 ;
+4 ;
NEW RQSTDATE,CLINNAME,SORT1,SORT2,SORT3,YYYYMM,SOURCE,COUNT,TOTAL,QUEUED,SOURCE
+5 ;
+6 ; Source selection
+7 ;
+8 ;
KILL DIR
SET DIR(0)="SO^ALL:All Sources;REQ:Appointment Requests;WAIT:Wait List;RECALL:Recall Reminders"
SET DIR("A")="Source"
SET DIR("B")="ALL Sources"
DO ^DIR
if $DATA(DIRUT)
QUIT
SET SOURCE=Y
+9 ;
+10 ;
SET %ZIS="Q"
DO ^%ZIS
IF POP
KILL ^TMP($JOB)
QUIT
+11 ;
+12 ; If report is queued, add to Taskman
+13 ;
+14 ;
SET QUEUED=0
IF $DATA(IO("Q"))
SET QUEUED=1
Begin DoDot:1
+15 ;
NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+16 ;
SET ZTRTN="SUMMARY1^EHMAPTRQ"
SET ZTDESC="Appointment Request Summary"
+17 ;
SET ZTSAVE("*")=""
+18 ;
DO ^%ZTLOAD
WRITE $SELECT($DATA(ZTSK):"...Task queued",1:"...Task cancelled"),!
End DoDot:1
QUIT
+19 ;
SUMMARY1 ; TaskMan entry point
+1 ;
+2 ; Output summary report.
+3 ;
+4 ;
NEW TITLE,LINES,QUIT,REQTYPE
+5 ;
+6 ; Create appointment request list.
+7 ;
+8 ;
IF QUEUED
DO OPENRQST(1,0,SOURCE)
+9 ;
IF 'QUEUED
DO OPENRQST(1,1,SOURCE)
+10 ;
+11 ; Scan sorted data in ^TMP($J) and summarize data.
+12 ;
+13 ;
KILL ^TMP("EHMAPTRQ",$JOB)
+14 ;
SET SORT1=""
FOR
SET SORT1=$ORDER(^TMP($JOB,SORT1))
if SORT1=""
QUIT
Begin DoDot:1
+15 ;
SET SORT2=""
FOR
SET SORT2=$ORDER(^TMP($JOB,SORT1,SORT2))
if SORT2=""
QUIT
Begin DoDot:2
+16 ;
SET SORT3=""
FOR
SET SORT3=$ORDER(^TMP($JOB,SORT1,SORT2,SORT3))
if SORT3=""
QUIT
Begin DoDot:3
+17 ;
SET RQSTDATE=SORT1
SET CLINNAME=$PIECE(SORT3,U,1)
SET YYYYMM=($EXTRACT(RQSTDATE,1,3)+1700)_"/"_$EXTRACT(RQSTDATE,4,5)
+18 ;
+19 ;
SET SOURCE=$SELECT($DATA(^TMP($JOB,SORT1,SORT2,SORT3,409.85)):"APPT REQ",$DATA(^TMP($JOB,SORT1,SORT2,SORT3,409.3)):"WAIT LIST",$DATA(^TMP($JOB,SORT1,SORT2,SORT3,403.5)):"RECALL",1:"")
+20 ;
IF SOURCE="APPT REQ"
SET REQTYPE=$PIECE(^TMP($JOB,SORT1,SORT2,SORT3,409.85),U,6)
SET SOURCE=SOURCE_"-"_$SELECT(REQTYPE="APPT":"APPT",REQTYPE="RTC":"RTC",1:"OTHER")
+21 ;
+22 ;
SET ^(SOURCE)=$GET(^TMP("EHMAPTRQ",$JOB,"SOURCE",SOURCE))+1
+23 ;
SET ^(YYYYMM)=$GET(^TMP("EHMAPTRQ",$JOB,"DATE",YYYYMM))+1
+24 ;
SET ^(CLINNAME)=$GET(^TMP("EHMAPTRQ",$JOB,"CLINIC",CLINNAME))+1
End DoDot:3
End DoDot:2
End DoDot:1
+25 ;
+26 ;
USE IO
DO SUMHDR("SOURCE",18)
+27 ;
SET TOTAL=0
SET QUIT=0
FOR SOURCE="APPT REQ-APPT","APPT REQ-RTC","APPT REQ-OTHER","RECALL","WAIT LIST"
SET COUNT=+$GET(^TMP("EHMAPTRQ",$JOB,"SOURCE",SOURCE))
WRITE SOURCE,?20,$JUSTIFY(COUNT,8),!
SET TOTAL=TOTAL+COUNT
+28 ;
WRITE $$DASHES^EHM13UTIL(15),?20,$$DASHES^EHM13UTIL(8),!,"TOTAL",?20,$JUSTIFY(TOTAL,8),!
+29 ;
IF 'QUEUED
SET QUIT=$$CONTINUE^EHM13UTIL()=0
IF QUIT
KILL ^TMP($JOB),^TMP("EHMAPTRQ",$JOB)
DO ^%ZISC
QUIT
+30 ;
+31 ;
DO SUMHDR("DATE",10)
+32 ;
SET TOTAL=0
SET YYYYMM=0
SET LINES=0
SET QUIT=0
+33 ;
FOR
SET YYYYMM=$ORDER(^TMP("EHMAPTRQ",$JOB,"DATE",YYYYMM))
if 'YYYYMM
QUIT
SET COUNT=^(YYYYMM)
Begin DoDot:1
+34 ;
+35 ; If report displayed on screen, stop when screen full and prompt user to continue or stop.
+36 ;
+37 ;
IF 'QUEUED
Begin DoDot:2
+38 ;
USE 0
+39 ;
IF IO=$IO
if LINES<(IOSL-7)
QUIT
SET QUIT=$$CONTINUE^EHM13UTIL()=0
if QUIT
QUIT
USE IO
DO SUMHDR("CLINIC",10)
SET LINES=1
QUIT
+40 ;
+41 ; New page header for printed report
+42 ;
+43 ;
IF LINES'<IOSL
USE IO
DO SUMHDR("CLINIC",10)
SET LINES=1
End DoDot:2
if QUIT
QUIT
+44 ;
+45 ;
USE IO
WRITE $PIECE(YYYYMM,"/",2),"/",$PIECE(YYYYMM,"/",1),?12,$JUSTIFY(COUNT,8),!
SET TOTAL=TOTAL+COUNT
SET LINES=LINES+1
End DoDot:1
if QUIT
QUIT
+46 ;
IF 'QUIT
WRITE $$DASHES^EHM13UTIL(9),?12,$$DASHES^EHM13UTIL(8),!,"TOTAL",?12,$JUSTIFY(TOTAL,8),!
+47 ;
IF QUIT
KILL ^TMP($JOB),^TMP("EHMAPTRQ",$JOB)
DO ^%ZISC
QUIT
+48 ;
IF 'QUEUED
IF 'QUIT
SET QUIT=$$CONTINUE^EHM13UTIL()=0
if QUIT
QUIT
+49 ;
+50 ;
DO SUMHDR("CLINIC",30)
+51 ;
SET TOTAL=0
SET CLINNAME=""
SET LINES=0
SET QUIT=0
+52 ;
FOR
SET CLINNAME=$ORDER(^TMP("EHMAPTRQ",$JOB,"CLINIC",CLINNAME))
if CLINNAME=""
QUIT
SET COUNT=^(CLINNAME)
Begin DoDot:1
+53 ;
+54 ; If report displayed on screen, stop when screen full and prompt user to continue or stop.
+55 ;
+56 ;
IF 'QUEUED
Begin DoDot:2
+57 ;
USE 0
+58 ;
IF IO=$IO
if LINES<(IOSL-7)
QUIT
SET QUIT=$$CONTINUE^EHM13UTIL()=0
if QUIT
QUIT
USE IO
DO SUMHDR("CLINIC",30)
SET LINES=1
QUIT
+59 ;
+60 ; New page header for printed report
+61 ;
+62 ;
IF LINES'<IOSL
USE IO
DO SUMHDR("CLINIC",30)
SET LINES=1
End DoDot:2
if QUIT
QUIT
+63 ;
+64 ;
USE IO
WRITE CLINNAME,?32,$JUSTIFY(COUNT,8),!
SET TOTAL=TOTAL+COUNT
SET LINES=LINES+1
End DoDot:1
if QUIT
QUIT
+65 ;
IF 'QUIT
WRITE $$DASHES^EHM13UTIL(30),?32,$$DASHES^EHM13UTIL(8),!,"TOTAL",?32,$JUSTIFY(TOTAL,8),!
+66 ;
+67 ;
USE 0
IF 'QUEUED
IF IO=$IO
READ !,"Press [RETURN] to continue",X:$GET(DTIME,300)
+68 ;
+69 ;
KILL ^TMP($JOB),^TMP("EHMAPTRQ",$JOB)
DO ^%ZISC
+70 ;
QUIT
+71 ;
SUMHDR(COLUMN1,WIDTH1) ;
+1 ;
+2 ;
WRITE @IOF,$$CENTER^EHM13UTIL("Appointment Request Summary",IOM),!
+3 ;
WRITE !,COLUMN1,?WIDTH1+2,"COUNT",!,$$DASHES^EHM13UTIL(WIDTH1),?WIDTH1+2,$$DASHES^EHM13UTIL(8),!
+4 ;
QUIT
+5 ;
