- 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 Jan 18, 2025@03:53:41 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