SDECRPT ;ALB/BNT - SCHEDULING ENHANCEMENTS CLINIC REPORTS ;MAR 15, 2017
;;5.3;Scheduling;**628,658**;Aug 13, 1993;Build 23
;
;
Q
;
RPT(DAYS,SDSTPAR) ; Get all clinic appointments for each report type category
; Input: DAYS = The number of days to go back and search for appointments
; The default is 365, one year.
; SDSTPAR = Array of clinics
;
N SDECARR,SDECLNM,SDECTOT,SDLAST
I $G(DAYS)="" S DAYS=365
; Update date node of report data to today
S SDLAST=$O(^XTMP("SDVSE","DT",""),-1)
I SDLAST,SDLAST'=$P($$NOW^XLFDT,".") M ^XTMP("SDVSE","DT",DT)=^XTMP("SDVSE","DT",SDLAST) K ^XTMP("SDVSE","DT",SDLAST)
S SDECARR(1)=$$HTFM^XLFDT($H-DAYS)_";"_DT,SDECARR("FLDS")="1;2;3;4;5;7;11;12;22"
S (SDECARR(2),SDECLNM)="",SDECARR(4)="^DPT("
; Get appointment data for all clinics by report type
F SDRT="P","S","M" D
. F S SDECLNM=$O(SDSTPAR(SDRT,SDECLNM)) Q:SDECLNM="" S SDECARR(2)=SDECARR(2)_$P(SDSTPAR(SDRT,SDECLNM),U)_";"
. D GETDATA(.SDECARR,SDRT)
. S SDECARR(2)=""
Q
;
GETDATA(SDECARR,SDRT) ;
N SDECCNT,CLN,DFN,SDT,SDOB,SDLEN,CNT,SDENC,SDECPRV,SDECSTS,PROV
S CNT=0
K ^TMP($J,"SDAMA301")
S SDECCNT=$$SDAPI^SDAMA301(.SDECARR)
I SDECCNT S DFN=0 F S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:DFN="" D
. S CLN=0 F S CLN=$O(^TMP($J,"SDAMA301",DFN,CLN)) Q:CLN="" D
. . S SDT=0 F S SDT=$O(^TMP($J,"SDAMA301",DFN,CLN,SDT)) Q:SDT="" D
. . . S SDENC=$P(^TMP($J,"SDAMA301",DFN,CLN,SDT),U,12) ; Encounter IEN
. . . S SDECPRV=0 I +SDENC,$D(^SCE(+SDENC,0)) D ;alb/sat 658 - verify encounter record exists
. . . . N SDENCPR,SDVISIT,DIC,DA,DR,DIQ,ENCARAY
. . . . S DIQ(0)="I",DIC=409.68,DA=SDENC,DR=".01;.04;.05;.08;.11"
. . . . D GETS^DIQ(DIC,DA,DR,"I","ENCARAY")
. . . . S SDVISIT=$G(ENCARAY("409.68",DA_",",".05","I")) ;alb/sat 658 - add $G
. . . . Q:'SDVISIT
. . . . S SDENCPR=$$VPRV(SDVISIT) ; Get visit provider
. . . . Q:'$G(SDENCPR) Q:'$D(^VA(200,SDENCPR))
. . . . S SDECPRV=SDENCPR
. . . S SDECSTS=$P(^TMP($J,"SDAMA301",DFN,CLN,SDT),U,3) ; Appointment Status
. . . S SDOB=$P(^TMP($J,"SDAMA301",DFN,CLN,SDT),U,7) ; Overbook indicator
. . . S SDLEN=$P(^TMP($J,"SDAMA301",DFN,CLN,SDT),U,5) ; Lenth of Appointment
. . . S ^XTMP("SDVSE","DT",DT,SDRT,CLN,SDT,DFN,"APPT",SDECPRV)=$S(SDOB="Y":1,1:0)_U_$$PATSTAT(DFN,SDT)_U_SDLEN_U_SDECSTS
. . . S CNT=CNT+1
. . . S ^XTMP("SDVSE","DT",DT,"APPT",SDRT)=CNT
. . . K ^TMP($J,"SDAMA301",DFN,CLN,SDT)
K ^TMP($J,"SDAMA301")
Q
;
PATSTAT(DFN,SDT) ; Return Patient Appointment status of New and Established
; Input: DFN = Patient IEN
; SDT = Current appointment
; Return: New Patient(1/0)^Established Patient(1/0)
;
; This API will return an indicator for New and Established patients
; New patient is determined if the patient has not had an appointment in a
; clinic in the last 2 years.
;
N SDLST,SDIFF
I '$D(^DPT(DFN,0)) Q -1
S SDLST=$O(^DPT(DFN,"S",SDT),-1)
S SDIFF=$$FMDIFF^XLFDT(DT,SDLST)
Q $S(SDIFF<720:"0^1",1:"1^0")
;
MERGE(SDECARR) ; Merge Report data into ^TMP global
; Input: Array passed by ref
; Appointment Data:
; SDECARR(Report Type,Hospital Location IEN,FileMan Date/Time,Patient IEN,"APPT",Provider IEN (Or zero if appt not checked out))
; Overbook(1/0)^New Patient(1/0)^Established Patient(1/0)^Length of Appt(min)^Appt Status
; Encounter Data:
; SDECARR(Report Type,Hospital Location IEN,FileMan Date/Time,Patient IEN,"ENC",Provider IEN)=Telephone(1/0)
Q:'$D(SDECARR)
M ^XTMP("SDVSE","DT",DT)=SDECARR
Q
;
VPRV(VISIT) ; Find encounter provider
Q:'$G(VISIT)
N VPRV,ENCARAY,VARAY,DIC,DA,DR,DIQ
S VPRV=$O(^AUPNVPRV("AD",+VISIT,0))
Q:'VPRV ""
S DIQ(0)="I",DIC=9000010.06,DA=+VPRV,DR=.01
D GETS^DIQ(DIC,DA,DR,"I","VARAY")
S PROV=$G(VARAY("9000010.06",DA_",",".01","I"))
Q PROV
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECRPT 3822 printed Apr 09, 2024@21:39:56 Page 2
SDECRPT ;ALB/BNT - SCHEDULING ENHANCEMENTS CLINIC REPORTS ;MAR 15, 2017
+1 ;;5.3;Scheduling;**628,658**;Aug 13, 1993;Build 23
+2 ;
+3 ;
+4 QUIT
+5 ;
RPT(DAYS,SDSTPAR) ; Get all clinic appointments for each report type category
+1 ; Input: DAYS = The number of days to go back and search for appointments
+2 ; The default is 365, one year.
+3 ; SDSTPAR = Array of clinics
+4 ;
+5 NEW SDECARR,SDECLNM,SDECTOT,SDLAST
+6 IF $GET(DAYS)=""
SET DAYS=365
+7 ; Update date node of report data to today
+8 SET SDLAST=$ORDER(^XTMP("SDVSE","DT",""),-1)
+9 IF SDLAST
IF SDLAST'=$PIECE($$NOW^XLFDT,".")
MERGE ^XTMP("SDVSE","DT",DT)=^XTMP("SDVSE","DT",SDLAST)
KILL ^XTMP("SDVSE","DT",SDLAST)
+10 SET SDECARR(1)=$$HTFM^XLFDT($HOROLOG-DAYS)_";"_DT
SET SDECARR("FLDS")="1;2;3;4;5;7;11;12;22"
+11 SET (SDECARR(2),SDECLNM)=""
SET SDECARR(4)="^DPT("
+12 ; Get appointment data for all clinics by report type
+13 FOR SDRT="P","S","M"
Begin DoDot:1
+14 FOR
SET SDECLNM=$ORDER(SDSTPAR(SDRT,SDECLNM))
if SDECLNM=""
QUIT
SET SDECARR(2)=SDECARR(2)_$PIECE(SDSTPAR(SDRT,SDECLNM),U)_";"
+15 DO GETDATA(.SDECARR,SDRT)
+16 SET SDECARR(2)=""
End DoDot:1
+17 QUIT
+18 ;
GETDATA(SDECARR,SDRT) ;
+1 NEW SDECCNT,CLN,DFN,SDT,SDOB,SDLEN,CNT,SDENC,SDECPRV,SDECSTS,PROV
+2 SET CNT=0
+3 KILL ^TMP($JOB,"SDAMA301")
+4 SET SDECCNT=$$SDAPI^SDAMA301(.SDECARR)
+5 IF SDECCNT
SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"SDAMA301",DFN))
if DFN=""
QUIT
Begin DoDot:1
+6 SET CLN=0
FOR
SET CLN=$ORDER(^TMP($JOB,"SDAMA301",DFN,CLN))
if CLN=""
QUIT
Begin DoDot:2
+7 SET SDT=0
FOR
SET SDT=$ORDER(^TMP($JOB,"SDAMA301",DFN,CLN,SDT))
if SDT=""
QUIT
Begin DoDot:3
+8 ; Encounter IEN
SET SDENC=$PIECE(^TMP($JOB,"SDAMA301",DFN,CLN,SDT),U,12)
+9 ;alb/sat 658 - verify encounter record exists
SET SDECPRV=0
IF +SDENC
IF $DATA(^SCE(+SDENC,0))
Begin DoDot:4
+10 NEW SDENCPR,SDVISIT,DIC,DA,DR,DIQ,ENCARAY
+11 SET DIQ(0)="I"
SET DIC=409.68
SET DA=SDENC
SET DR=".01;.04;.05;.08;.11"
+12 DO GETS^DIQ(DIC,DA,DR,"I","ENCARAY")
+13 ;alb/sat 658 - add $G
SET SDVISIT=$GET(ENCARAY("409.68",DA_",",".05","I"))
+14 if 'SDVISIT
QUIT
+15 ; Get visit provider
SET SDENCPR=$$VPRV(SDVISIT)
+16 if '$GET(SDENCPR)
QUIT
if '$DATA(^VA(200,SDENCPR))
QUIT
+17 SET SDECPRV=SDENCPR
End DoDot:4
+18 ; Appointment Status
SET SDECSTS=$PIECE(^TMP($JOB,"SDAMA301",DFN,CLN,SDT),U,3)
+19 ; Overbook indicator
SET SDOB=$PIECE(^TMP($JOB,"SDAMA301",DFN,CLN,SDT),U,7)
+20 ; Lenth of Appointment
SET SDLEN=$PIECE(^TMP($JOB,"SDAMA301",DFN,CLN,SDT),U,5)
+21 SET ^XTMP("SDVSE","DT",DT,SDRT,CLN,SDT,DFN,"APPT",SDECPRV)=$SELECT(SDOB="Y":1,1:0)_U_$$PATSTAT(DFN,SDT)_U_SDLEN_U_SDECSTS
+22 SET CNT=CNT+1
+23 SET ^XTMP("SDVSE","DT",DT,"APPT",SDRT)=CNT
+24 KILL ^TMP($JOB,"SDAMA301",DFN,CLN,SDT)
End DoDot:3
End DoDot:2
End DoDot:1
+25 KILL ^TMP($JOB,"SDAMA301")
+26 QUIT
+27 ;
PATSTAT(DFN,SDT) ; Return Patient Appointment status of New and Established
+1 ; Input: DFN = Patient IEN
+2 ; SDT = Current appointment
+3 ; Return: New Patient(1/0)^Established Patient(1/0)
+4 ;
+5 ; This API will return an indicator for New and Established patients
+6 ; New patient is determined if the patient has not had an appointment in a
+7 ; clinic in the last 2 years.
+8 ;
+9 NEW SDLST,SDIFF
+10 IF '$DATA(^DPT(DFN,0))
QUIT -1
+11 SET SDLST=$ORDER(^DPT(DFN,"S",SDT),-1)
+12 SET SDIFF=$$FMDIFF^XLFDT(DT,SDLST)
+13 QUIT $SELECT(SDIFF<720:"0^1",1:"1^0")
+14 ;
MERGE(SDECARR) ; Merge Report data into ^TMP global
+1 ; Input: Array passed by ref
+2 ; Appointment Data:
+3 ; SDECARR(Report Type,Hospital Location IEN,FileMan Date/Time,Patient IEN,"APPT",Provider IEN (Or zero if appt not checked out))
+4 ; Overbook(1/0)^New Patient(1/0)^Established Patient(1/0)^Length of Appt(min)^Appt Status
+5 ; Encounter Data:
+6 ; SDECARR(Report Type,Hospital Location IEN,FileMan Date/Time,Patient IEN,"ENC",Provider IEN)=Telephone(1/0)
+7 if '$DATA(SDECARR)
QUIT
+8 MERGE ^XTMP("SDVSE","DT",DT)=SDECARR
+9 QUIT
+10 ;
VPRV(VISIT) ; Find encounter provider
+1 if '$GET(VISIT)
QUIT
+2 NEW VPRV,ENCARAY,VARAY,DIC,DA,DR,DIQ
+3 SET VPRV=$ORDER(^AUPNVPRV("AD",+VISIT,0))
+4 if 'VPRV
QUIT ""
+5 SET DIQ(0)="I"
SET DIC=9000010.06
SET DA=+VPRV
SET DR=.01
+6 DO GETS^DIQ(DIC,DA,DR,"I","VARAY")
+7 SET PROV=$GET(VARAY("9000010.06",DA_",",".01","I"))
+8 QUIT PROV
