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  Sep 23, 2025@20:28:59                                                                                                                                                                                                     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