Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDECRPT

SDECRPT.m

Go to the documentation of this file.
  1. SDECRPT ;ALB/BNT - SCHEDULING ENHANCEMENTS CLINIC REPORTS ;MAR 15, 2017
  1. ;;5.3;Scheduling;**628,658**;Aug 13, 1993;Build 23
  1. ;
  1. ;
  1. Q
  1. ;
  1. 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
  1. ; The default is 365, one year.
  1. ; SDSTPAR = Array of clinics
  1. ;
  1. N SDECARR,SDECLNM,SDECTOT,SDLAST
  1. I $G(DAYS)="" S DAYS=365
  1. ; Update date node of report data to today
  1. S SDLAST=$O(^XTMP("SDVSE","DT",""),-1)
  1. I SDLAST,SDLAST'=$P($$NOW^XLFDT,".") M ^XTMP("SDVSE","DT",DT)=^XTMP("SDVSE","DT",SDLAST) K ^XTMP("SDVSE","DT",SDLAST)
  1. S SDECARR(1)=$$HTFM^XLFDT($H-DAYS)_";"_DT,SDECARR("FLDS")="1;2;3;4;5;7;11;12;22"
  1. S (SDECARR(2),SDECLNM)="",SDECARR(4)="^DPT("
  1. ; Get appointment data for all clinics by report type
  1. F SDRT="P","S","M" D
  1. . F S SDECLNM=$O(SDSTPAR(SDRT,SDECLNM)) Q:SDECLNM="" S SDECARR(2)=SDECARR(2)_$P(SDSTPAR(SDRT,SDECLNM),U)_";"
  1. . D GETDATA(.SDECARR,SDRT)
  1. . S SDECARR(2)=""
  1. Q
  1. ;
  1. GETDATA(SDECARR,SDRT) ;
  1. N SDECCNT,CLN,DFN,SDT,SDOB,SDLEN,CNT,SDENC,SDECPRV,SDECSTS,PROV
  1. S CNT=0
  1. K ^TMP($J,"SDAMA301")
  1. S SDECCNT=$$SDAPI^SDAMA301(.SDECARR)
  1. I SDECCNT S DFN=0 F S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:DFN="" D
  1. . S CLN=0 F S CLN=$O(^TMP($J,"SDAMA301",DFN,CLN)) Q:CLN="" D
  1. . . S SDT=0 F S SDT=$O(^TMP($J,"SDAMA301",DFN,CLN,SDT)) Q:SDT="" D
  1. . . . S SDENC=$P(^TMP($J,"SDAMA301",DFN,CLN,SDT),U,12) ; Encounter IEN
  1. . . . S SDECPRV=0 I +SDENC,$D(^SCE(+SDENC,0)) D ;alb/sat 658 - verify encounter record exists
  1. . . . . N SDENCPR,SDVISIT,DIC,DA,DR,DIQ,ENCARAY
  1. . . . . S DIQ(0)="I",DIC=409.68,DA=SDENC,DR=".01;.04;.05;.08;.11"
  1. . . . . D GETS^DIQ(DIC,DA,DR,"I","ENCARAY")
  1. . . . . S SDVISIT=$G(ENCARAY("409.68",DA_",",".05","I")) ;alb/sat 658 - add $G
  1. . . . . Q:'SDVISIT
  1. . . . . S SDENCPR=$$VPRV(SDVISIT) ; Get visit provider
  1. . . . . Q:'$G(SDENCPR) Q:'$D(^VA(200,SDENCPR))
  1. . . . . S SDECPRV=SDENCPR
  1. . . . S SDECSTS=$P(^TMP($J,"SDAMA301",DFN,CLN,SDT),U,3) ; Appointment Status
  1. . . . S SDOB=$P(^TMP($J,"SDAMA301",DFN,CLN,SDT),U,7) ; Overbook indicator
  1. . . . S SDLEN=$P(^TMP($J,"SDAMA301",DFN,CLN,SDT),U,5) ; Lenth of Appointment
  1. . . . 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
  1. . . . S CNT=CNT+1
  1. . . . S ^XTMP("SDVSE","DT",DT,"APPT",SDRT)=CNT
  1. . . . K ^TMP($J,"SDAMA301",DFN,CLN,SDT)
  1. K ^TMP($J,"SDAMA301")
  1. Q
  1. ;
  1. PATSTAT(DFN,SDT) ; Return Patient Appointment status of New and Established
  1. ; Input: DFN = Patient IEN
  1. ; SDT = Current appointment
  1. ; Return: New Patient(1/0)^Established Patient(1/0)
  1. ;
  1. ; This API will return an indicator for New and Established patients
  1. ; New patient is determined if the patient has not had an appointment in a
  1. ; clinic in the last 2 years.
  1. ;
  1. N SDLST,SDIFF
  1. I '$D(^DPT(DFN,0)) Q -1
  1. S SDLST=$O(^DPT(DFN,"S",SDT),-1)
  1. S SDIFF=$$FMDIFF^XLFDT(DT,SDLST)
  1. Q $S(SDIFF<720:"0^1",1:"1^0")
  1. ;
  1. MERGE(SDECARR) ; Merge Report data into ^TMP global
  1. ; Input: Array passed by ref
  1. ; Appointment Data:
  1. ; SDECARR(Report Type,Hospital Location IEN,FileMan Date/Time,Patient IEN,"APPT",Provider IEN (Or zero if appt not checked out))
  1. ; Overbook(1/0)^New Patient(1/0)^Established Patient(1/0)^Length of Appt(min)^Appt Status
  1. ; Encounter Data:
  1. ; SDECARR(Report Type,Hospital Location IEN,FileMan Date/Time,Patient IEN,"ENC",Provider IEN)=Telephone(1/0)
  1. Q:'$D(SDECARR)
  1. M ^XTMP("SDVSE","DT",DT)=SDECARR
  1. Q
  1. ;
  1. VPRV(VISIT) ; Find encounter provider
  1. Q:'$G(VISIT)
  1. N VPRV,ENCARAY,VARAY,DIC,DA,DR,DIQ
  1. S VPRV=$O(^AUPNVPRV("AD",+VISIT,0))
  1. Q:'VPRV ""
  1. S DIQ(0)="I",DIC=9000010.06,DA=+VPRV,DR=.01
  1. D GETS^DIQ(DIC,DA,DR,"I","VARAY")
  1. S PROV=$G(VARAY("9000010.06",DA_",",".01","I"))
  1. Q PROV