SDECXML2 ;ALB/JCH - SCHEDULING ENHANCEMENTS 3 UTILITIES ;11/03/14 10:59am
;;5.3;Scheduling;**628**;Aug 13, 1993;Build 371
;
;
PROVIDER(SDLCNT,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,DTINC,CLNTAG,GRPFLG,SDCALL,DTNAM,SDGALL,SDNODE) ; Provider
N PRTOT,SDDATA,SDLG,APPTOT,APPLEN,SDSTPNAM,STSTP,SDACTAP,ACTOT,GRPCODE,ADJDIFF,ADJDEM,APPDEM,APPLEN
N APPEST,APPNEW,APPOVR,DIC,DR,DTNAMAR,SDRESCH,SDSTP,STRING
I ($G(SDGRP)=0)&(SDGALL=1) Q
;S DTNAM=$G(DTNAMAR(DTINC))
S SDSTPNAM=$P($G(^SC(+$P(SDCLN,"^",2),0)),"^")
;
; Appointments - demand
I SDIV="All",SDGRP="All" D Q
.D PRALALAL^SDECXML4(.SDLCNT,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,DTINC,DTNAM)
;
I SDIV,SDGRP="All",$P(SDCLN,"^",2) D Q
.D PRALAL^SDECXML4(.SDLCNT,SDRPTYP,SDAT,SDFAC,SDIV,"All",SDCLN,SDPRV,DTINC,DTNAM)
;
I SDIV="All" D
.S APPTOT="",APPLEN="",SDACTAP="",APPDEM="",ACTOT="",SDSTP="",ADJDIFF="",ADJDEM="",ADJDEM=""
.F S APPLEN=$O(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV,"APP","LEN",APPLEN)) Q:'APPLEN D
..S SDSTP="" F S SDSTP=$O(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV,"APP","LEN",APPLEN,SDSTP)) Q:SDSTP="" D
...Q:SDSTP="STAT" S ACTOT=""
...;I '$G(GRPFLG) S SDFILT=$$GRP^SDECXML(SDGRP) D SETTMPF^SDECXML(.SDLCNT,SDFILT,13)
...S APPTOT=$G(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV,"APP","LEN",APPLEN,SDSTP))
...S APPDEM=APPDEM+APPTOT
..S SDRESCH="" F S SDRESCH=$O(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV,"APP","LEN",APPLEN,"STAT",SDRESCH)) Q:SDRESCH="" D
...Q:'($P(SDRESCH,";")="NSR"!($P(SDRESCH,";")="CPR")!($P(SDRESCH,";")="CCR"))
...S ADJDIFF=ADJDIFF+(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV,"APP","LEN",APPLEN,"STAT",SDRESCH)*APPLEN)
.S ADJDEM=APPDEM I ADJDIFF&APPDEM S ADJDEM=APPDEM-ADJDIFF
.S ADJDEM=$S($G(ADJDIFF):ADJDEM,1:APPDEM)
.D PARSE^SDECXML2(APPDEM,SDCLN,SDPRV,"DEM",APPLEN,SDSTP,ADJDEM)
.;
I $G(SDIV) D
.S APPTOT="",APPLEN="",SDACTAP="",APPDEM="",ACTOT="",SDSTP="",ADJDIFF="",ADJDEM="",APPLEN=""
.S APPLEN="" F S APPLEN=$O(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,"APP","LEN",APPLEN)) Q:'APPLEN D
..S SDSTP="" F S SDSTP=$O(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,"APP","LEN",APPLEN,SDSTP)) Q:SDSTP="" D
...Q:SDSTP="STAT" S ACTOT=""
...I '$G(GRPFLG) S SDFILT=$$GRP^SDECXML(SDGRP) D SETTMPF^SDECXML(.SDLCNT,SDFILT,13)
...S APPTOT=$G(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,"APP","LEN",APPLEN,SDSTP))
...S APPDEM=APPDEM+APPTOT
..S SDRESCH="" F S SDRESCH=$O(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,"APP","LEN",APPLEN,"STAT",SDRESCH)) Q:SDRESCH="" D
...Q:'($P(SDRESCH,";")="NSR"!($P(SDRESCH,";")="CPR")!($P(SDRESCH,";")="CCR"))
...S ADJDIFF=ADJDIFF+(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,"APP","LEN",APPLEN,"STAT",SDRESCH)*APPLEN)
.S ADJDEM=APPDEM I ADJDIFF&APPDEM S ADJDEM=APPDEM-ADJDIFF
.S ADJDEM=$S($G(ADJDIFF):ADJDEM,1:APPDEM)
.D PARSE^SDECXML2(APPDEM,SDCLN,SDPRV,"DEM",APPLEN,SDSTP,ADJDEM)
.;
; Appointments - lengths
S APPTOT="",APPLEN="",SDACTAP="",APPDEM="",ACTOT=""
I SDIV="All" S APPLEN="" F S APPLEN=$O(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV,"APP","LEN",APPLEN)) Q:'APPLEN D
.S SDSTP="" F S SDSTP=$O(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV,"APP","LEN",APPLEN,SDSTP)) Q:SDSTP="" D
..Q:SDSTP="STAT" S ACTOT=""
..S APPTOT=$G(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV,"APP","LEN",APPLEN,SDSTP))
..;Q:(APPTOT="")
..I '$G(GRPFLG) S SDFILT=$$GRP^SDECXML(SDGRP) D SETTMPF^SDECXML(.SDLCNT,SDFILT,13)
..S APPOVR=$P(APPTOT,"^",2),APPNEW=$P(APPTOT,"^",3),APPEST=$P(APPTOT,"^",4),ACTOT=APPNEW+APPEST
..I ACTOT D PARSE^SDECXML2(ACTOT,SDCLN,SDPRV,"APPACT",APPLEN,SDSTP)
..I APPOVR S SDDATA=$$PROV^SDECXML(SDPRV)_" "_$$OVRAP^SDECXML2(APPOVR,APPLEN,SDSTP) D SETREC^SDECXML(.SDLCNT,SDDATA,15)
..I APPNEW S SDDATA=$$PROV^SDECXML(SDPRV)_" "_$$NEWAP^SDECXML2(APPNEW,APPLEN,SDSTP) D SETREC^SDECXML(.SDLCNT,SDDATA,15)
..I APPEST S SDDATA=$$PROV^SDECXML(SDPRV)_" "_$$ESTAP^SDECXML2(APPEST,APPLEN,SDSTP) D SETREC^SDECXML(.SDLCNT,SDDATA,15)
;
S APPTOT="",APPLEN="",SDACTAP="",APPDEM="",ACTOT=""
I $G(SDIV) S APPLEN="" F S APPLEN=$O(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,"APP","LEN",APPLEN)) Q:'APPLEN D
.S SDSTP="" F S SDSTP=$O(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,"APP","LEN",APPLEN,SDSTP)) Q:SDSTP="" D
..Q:SDSTP="STAT" S ACTOT=""
..S APPTOT=$G(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,"APP","LEN",APPLEN,SDSTP))
..;Q:(APPTOT="")
..I '$G(GRPFLG) S SDFILT=$$GRP^SDECXML(SDGRP) D SETTMPF^SDECXML(.SDLCNT,SDFILT,13)
..S APPOVR=$P(APPTOT,"^",2),APPNEW=$P(APPTOT,"^",3),APPEST=$P(APPTOT,"^",4),ACTOT=APPNEW+APPEST
..I ACTOT D PARSE^SDECXML2(ACTOT,SDCLN,SDPRV,"APPACT",APPLEN,SDSTP)
..I APPOVR S SDDATA=$$PROV^SDECXML(SDPRV)_" "_$$OVRAP^SDECXML2(APPOVR,APPLEN,SDSTP) D SETREC^SDECXML(.SDLCNT,SDDATA,15)
..I APPNEW S SDDATA=$$PROV^SDECXML(SDPRV)_" "_$$NEWAP^SDECXML2(APPNEW,APPLEN,SDSTP) D SETREC^SDECXML(.SDLCNT,SDDATA,15)
..I APPEST S SDDATA=$$PROV^SDECXML(SDPRV)_" "_$$ESTAP^SDECXML2(APPEST,APPLEN,SDSTP) D SETREC^SDECXML(.SDLCNT,SDDATA,15)
;
I $G(SDIV) S PRTOT=$G(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV))
I SDIV="All" S PRTOT=$G(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV))
I ($G(PRTOT)]"") N SDI F SDI=1:1:4 D
.S SDDATA=$$PROV^SDECXML(SDPRV)_" "_$S(SDI=1:$$ENC^SDECXML($P(PRTOT,"^",SDI)),SDI=2:$$NEW^SDECXML($P(PRTOT,"^",SDI)),SDI=3:$$EST^SDECXML($P(PRTOT,"^",SDI)),SDI=4:$$TEL^SDECXML($P(PRTOT,"^",SDI)),1:"")
.Q:($TR(SDDATA,"^","")="")
.I '$G(GRPFLG) S SDFILT=$$GRP^SDECXML(SDGRP) D SETTMPF^SDECXML(.SDLCNT,SDFILT,13)
.D SETREC^SDECXML(.SDLCNT,SDDATA,15)
Q
;
DIVNAME(DIV) ; Division name
K DIVNAME,DIC,DR
I DIV="All" Q DIV
N DIE,DIQ,DIR,DA,X,Y
S DIQ(0)="I",DIC=40.8,DA=+$G(DIV),DR=".01"
D GETS^DIQ(DIC,DA,DR,"I","DIVNAME")
S DIVNAME=$G(DIVNAME(DIC,DA_",",.01,"I"))
I DIVNAME=""!($L(DIVNAME)<3) S DIVNAME=$P($$SITE^VASITE(),"^",2)
Q DIVNAME
;
OUTPUT(TEXT,PAD,SDLCNT,SDEBUG) ; Generic Set/Output
I $G(XMLNODE)="" S XMLNODE=$S($G(SDFLTFLG):"FLTXML",1:"SDECXML")
I TEXT["/Rg" S GRPFLG=0
I TEXT["/Rs" S CLNTAG=0
S SDLCNT=$G(SDLCNT)+1
I $G(SDEBUG) U IO W:(SDLCNT>1) ! W ?PAD,TEXT
S ^XTMP("SDVSE",XMLNODE,SDLCNT)=TEXT
Q
;
CLINIC(SDLCNT,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLIN,DTINC,SDNODE,CLNTAG,SDCALL,GRPFLG,SDEBUG,XMLNODE) ; Clinic
N CLTOT,SDFILT,SDMEAS,SDDATA,DTNAM,TMPCLIN,GRPTOT,PRGDTOT,SDCLDIV,ACTOT,SDCLNALL,SDCLPR
S DTNAM=$G(DTNAMAR(DTINC))
I '$G(SDCALL) D ALLCLIN^SDECXML5(.SDLCNT,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,DTINC,.CLNTAG,"",SDCALL,SDNODE,.GRPFLG,SDEBUG,XMLNODE)
D ONECLIN^SDECXML4(.SDLCNT,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLIN,DTINC,"",SDEBUG,.CLNTAG,.GRPFLG,SDNODE,XMLNODE) ; Single Clinic
;
Q
;
NEWAP(NEW,LEN,STOP) ; Return new patients
N STOPNAM
;S STOPNAM=$$GRPNAM^SDECXML(STOP)
S STOPNAM=$P($$GRPNAM^SDECXML(STOP),") ",2)
S STRING="Mn="""_LEN_" Min Appointments - "_STOPNAM_""" Vt=""New Patients"" Vl="""_NEW_"""" Q STRING
ESTAP(EST,LEN,STOP) ; Return established patients
N STOPNAM
;S STOPNAM=$$GRPNAM^SDECXML(STOP)
S STOPNAM=$P($$GRPNAM^SDECXML(STOP),") ",2)
S STRING="Mn="""_LEN_" Min Appointments - "_STOPNAM_""" Vt=""Established Patients"" Vl="""_EST_"""" Q STRING
OVRAP(OVR,LEN,STOP) ; Appointment
N STOPNAM
S STOPNAM=$P($$GRPNAM^SDECXML(STOP),") ",2)
S STRING="Mn="""_LEN_" Min Appointments - "_STOPNAM_""" Vt=""Overbooks"" Vl="""_OVR_""""
Q STRING
ACTUALAP(ACTUAL,LEN,STOP) ; Appointment
N STOPNAM
S STOPNAM=$P($$GRPNAM^SDECXML(STOP),") ",2)
S STRING="Mn="""_LEN_" Min Appointments - "_STOPNAM_""" Vt=""Actual"" Vl="""_ACTUAL_""""
Q STRING
;
PARSE(TOT,CL,PR,TYPE,LEN,STOP,ADJ) ; Get record attributes, write/set
I $G(TYPE)="" D Q
.N SDI F SDI=1:1:4 D
..S SDDATA=$$PROV^SDECXML(PR)_" "_$S(SDI=1:$$ENC^SDECXML($P(TOT,"^",SDI)),SDI=2:$$NEW^SDECXML($P(TOT,"^",SDI)),SDI=3:$$EST^SDECXML($P(TOT,"^",SDI)),SDI=4:$$TEL^SDECXML($P(TOT,"^",SDI)),1:"")
..Q:($TR(SDDATA,"^","")="")
..D SETREC^SDECXML(.SDLCNT,SDDATA,15)
;
I $G(TYPE)="OVR" D
.S SDDATA=$$PROV^SDECXML(PR)_" "_$$RCAOVR^SDECXML($P(TOT,"^"))
.Q:SDDATA=""
.D SETREC^SDECXML(.SDLCNT,SDDATA,15)
;
I $E($G(TYPE),1,3)="APP" D
.S SDDATA=$$PROV^SDECXML(PR)_" "_$S(TYPE="APPOVR":$$OVRAP^SDECXML2(TOT,LEN,STOP),TYPE="APPNEW":$$NEWAP^SDECXML2(TOT,LEN,STOP),TYPE="APPEST":$$ESTAP^SDECXML2(TOT,LEN,STOP),TYPE="APPACT":$$ACTUALAP^SDECXML2(TOT,LEN,STOP),1:"")
.Q:SDDATA=""
.D SETREC^SDECXML(.SDLCNT,SDDATA,15)
;
I $G(TYPE)="DEM" S SDDATA=$$PROV^SDECXML(PR)_" "_$$RCADEM^SDECXML(TOT) D
.I $G(ADJ)<0
.D SETREC^SDECXML(.SDLCNT,SDDATA,15)
.S SDDATA=$$PROV^SDECXML(PR)_" "_$$RCADEMA^SDECXML($G(ADJ))
.D SETREC^SDECXML(.SDLCNT,SDDATA,15)
;
I $G(TYPE)="SUP" D
.S SDDATA=$$PROV^SDECXML("All")_" "_$$RCASUP^SDECXML($P(TOT,"^"))
.Q:SDDATA=""
.D SETREC^SDECXML(.SDLCNT,SDDATA,15)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECXML2 9216 printed Nov 22, 2024@18:03:05 Page 2
SDECXML2 ;ALB/JCH - SCHEDULING ENHANCEMENTS 3 UTILITIES ;11/03/14 10:59am
+1 ;;5.3;Scheduling;**628**;Aug 13, 1993;Build 371
+2 ;
+3 ;
PROVIDER(SDLCNT,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,DTINC,CLNTAG,GRPFLG,SDCALL,DTNAM,SDGALL,SDNODE) ; Provider
+1 NEW PRTOT,SDDATA,SDLG,APPTOT,APPLEN,SDSTPNAM,STSTP,SDACTAP,ACTOT,GRPCODE,ADJDIFF,ADJDEM,APPDEM,APPLEN
+2 NEW APPEST,APPNEW,APPOVR,DIC,DR,DTNAMAR,SDRESCH,SDSTP,STRING
+3 IF ($GET(SDGRP)=0)&(SDGALL=1)
QUIT
+4 ;S DTNAM=$G(DTNAMAR(DTINC))
+5 SET SDSTPNAM=$PIECE($GET(^SC(+$PIECE(SDCLN,"^",2),0)),"^")
+6 ;
+7 ; Appointments - demand
+8 IF SDIV="All"
IF SDGRP="All"
Begin DoDot:1
+9 DO PRALALAL^SDECXML4(.SDLCNT,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,DTINC,DTNAM)
End DoDot:1
QUIT
+10 ;
+11 IF SDIV
IF SDGRP="All"
IF $PIECE(SDCLN,"^",2)
Begin DoDot:1
+12 DO PRALAL^SDECXML4(.SDLCNT,SDRPTYP,SDAT,SDFAC,SDIV,"All",SDCLN,SDPRV,DTINC,DTNAM)
End DoDot:1
QUIT
+13 ;
+14 IF SDIV="All"
Begin DoDot:1
+15 SET APPTOT=""
SET APPLEN=""
SET SDACTAP=""
SET APPDEM=""
SET ACTOT=""
SET SDSTP=""
SET ADJDIFF=""
SET ADJDEM=""
SET ADJDEM=""
+16 FOR
SET APPLEN=$ORDER(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV,"APP","LEN",APPLEN))
if 'APPLEN
QUIT
Begin DoDot:2
+17 SET SDSTP=""
FOR
SET SDSTP=$ORDER(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV,"APP","LEN",APPLEN,SDSTP))
if SDSTP=""
QUIT
Begin DoDot:3
+18 if SDSTP="STAT"
QUIT
SET ACTOT=""
+19 ;I '$G(GRPFLG) S SDFILT=$$GRP^SDECXML(SDGRP) D SETTMPF^SDECXML(.SDLCNT,SDFILT,13)
+20 SET APPTOT=$GET(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV,"APP","LEN",APPLEN,SDSTP))
+21 SET APPDEM=APPDEM+APPTOT
End DoDot:3
+22 SET SDRESCH=""
FOR
SET SDRESCH=$ORDER(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV,"APP","LEN",APPLEN,"STAT",SDRESCH))
if SDRESCH=""
QUIT
Begin DoDot:3
+23 if '($PIECE(SDRESCH,";")="NSR"!($PIECE(SDRESCH,";")="CPR")!($PIECE(SDRESCH,";")="CCR"))
QUIT
+24 SET ADJDIFF=ADJDIFF+(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV,"APP","LEN",APPLEN,"STAT",SDRESCH)*APPLEN)
End DoDot:3
End DoDot:2
+25 SET ADJDEM=APPDEM
IF ADJDIFF&APPDEM
SET ADJDEM=APPDEM-ADJDIFF
+26 SET ADJDEM=$SELECT($GET(ADJDIFF):ADJDEM,1:APPDEM)
+27 DO PARSE^SDECXML2(APPDEM,SDCLN,SDPRV,"DEM",APPLEN,SDSTP,ADJDEM)
+28 ;
End DoDot:1
+29 IF $GET(SDIV)
Begin DoDot:1
+30 SET APPTOT=""
SET APPLEN=""
SET SDACTAP=""
SET APPDEM=""
SET ACTOT=""
SET SDSTP=""
SET ADJDIFF=""
SET ADJDEM=""
SET APPLEN=""
+31 SET APPLEN=""
FOR
SET APPLEN=$ORDER(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,"APP","LEN",APPLEN))
if 'APPLEN
QUIT
Begin DoDot:2
+32 SET SDSTP=""
FOR
SET SDSTP=$ORDER(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,"APP","LEN",APPLEN,SDSTP))
if SDSTP=""
QUIT
Begin DoDot:3
+33 if SDSTP="STAT"
QUIT
SET ACTOT=""
+34 IF '$GET(GRPFLG)
SET SDFILT=$$GRP^SDECXML(SDGRP)
DO SETTMPF^SDECXML(.SDLCNT,SDFILT,13)
+35 SET APPTOT=$GET(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,"APP","LEN",APPLEN,SDSTP))
+36 SET APPDEM=APPDEM+APPTOT
End DoDot:3
+37 SET SDRESCH=""
FOR
SET SDRESCH=$ORDER(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,"APP","LEN",APPLEN,"STAT",SDRESCH))
if SDRESCH=""
QUIT
Begin DoDot:3
+38 if '($PIECE(SDRESCH,";")="NSR"!($PIECE(SDRESCH,";")="CPR")!($PIECE(SDRESCH,";")="CCR"))
QUIT
+39 SET ADJDIFF=ADJDIFF+(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,"APP","LEN",APPLEN,"STAT",SDRESCH)*APPLEN)
End DoDot:3
End DoDot:2
+40 SET ADJDEM=APPDEM
IF ADJDIFF&APPDEM
SET ADJDEM=APPDEM-ADJDIFF
+41 SET ADJDEM=$SELECT($GET(ADJDIFF):ADJDEM,1:APPDEM)
+42 DO PARSE^SDECXML2(APPDEM,SDCLN,SDPRV,"DEM",APPLEN,SDSTP,ADJDEM)
+43 ;
End DoDot:1
+44 ; Appointments - lengths
+45 SET APPTOT=""
SET APPLEN=""
SET SDACTAP=""
SET APPDEM=""
SET ACTOT=""
+46 IF SDIV="All"
SET APPLEN=""
FOR
SET APPLEN=$ORDER(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV,"APP","LEN",APPLEN))
if 'APPLEN
QUIT
Begin DoDot:1
+47 SET SDSTP=""
FOR
SET SDSTP=$ORDER(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV,"APP","LEN",APPLEN,SDSTP))
if SDSTP=""
QUIT
Begin DoDot:2
+48 if SDSTP="STAT"
QUIT
SET ACTOT=""
+49 SET APPTOT=$GET(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV,"APP","LEN",APPLEN,SDSTP))
+50 ;Q:(APPTOT="")
+51 IF '$GET(GRPFLG)
SET SDFILT=$$GRP^SDECXML(SDGRP)
DO SETTMPF^SDECXML(.SDLCNT,SDFILT,13)
+52 SET APPOVR=$PIECE(APPTOT,"^",2)
SET APPNEW=$PIECE(APPTOT,"^",3)
SET APPEST=$PIECE(APPTOT,"^",4)
SET ACTOT=APPNEW+APPEST
+53 IF ACTOT
DO PARSE^SDECXML2(ACTOT,SDCLN,SDPRV,"APPACT",APPLEN,SDSTP)
+54 IF APPOVR
SET SDDATA=$$PROV^SDECXML(SDPRV)_" "_$$OVRAP^SDECXML2(APPOVR,APPLEN,SDSTP)
DO SETREC^SDECXML(.SDLCNT,SDDATA,15)
+55 IF APPNEW
SET SDDATA=$$PROV^SDECXML(SDPRV)_" "_$$NEWAP^SDECXML2(APPNEW,APPLEN,SDSTP)
DO SETREC^SDECXML(.SDLCNT,SDDATA,15)
+56 IF APPEST
SET SDDATA=$$PROV^SDECXML(SDPRV)_" "_$$ESTAP^SDECXML2(APPEST,APPLEN,SDSTP)
DO SETREC^SDECXML(.SDLCNT,SDDATA,15)
End DoDot:2
End DoDot:1
+57 ;
+58 SET APPTOT=""
SET APPLEN=""
SET SDACTAP=""
SET APPDEM=""
SET ACTOT=""
+59 IF $GET(SDIV)
SET APPLEN=""
FOR
SET APPLEN=$ORDER(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,"APP","LEN",APPLEN))
if 'APPLEN
QUIT
Begin DoDot:1
+60 SET SDSTP=""
FOR
SET SDSTP=$ORDER(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,"APP","LEN",APPLEN,SDSTP))
if SDSTP=""
QUIT
Begin DoDot:2
+61 if SDSTP="STAT"
QUIT
SET ACTOT=""
+62 SET APPTOT=$GET(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV,"APP","LEN",APPLEN,SDSTP))
+63 ;Q:(APPTOT="")
+64 IF '$GET(GRPFLG)
SET SDFILT=$$GRP^SDECXML(SDGRP)
DO SETTMPF^SDECXML(.SDLCNT,SDFILT,13)
+65 SET APPOVR=$PIECE(APPTOT,"^",2)
SET APPNEW=$PIECE(APPTOT,"^",3)
SET APPEST=$PIECE(APPTOT,"^",4)
SET ACTOT=APPNEW+APPEST
+66 IF ACTOT
DO PARSE^SDECXML2(ACTOT,SDCLN,SDPRV,"APPACT",APPLEN,SDSTP)
+67 IF APPOVR
SET SDDATA=$$PROV^SDECXML(SDPRV)_" "_$$OVRAP^SDECXML2(APPOVR,APPLEN,SDSTP)
DO SETREC^SDECXML(.SDLCNT,SDDATA,15)
+68 IF APPNEW
SET SDDATA=$$PROV^SDECXML(SDPRV)_" "_$$NEWAP^SDECXML2(APPNEW,APPLEN,SDSTP)
DO SETREC^SDECXML(.SDLCNT,SDDATA,15)
+69 IF APPEST
SET SDDATA=$$PROV^SDECXML(SDPRV)_" "_$$ESTAP^SDECXML2(APPEST,APPLEN,SDSTP)
DO SETREC^SDECXML(.SDLCNT,SDDATA,15)
End DoDot:2
End DoDot:1
+70 ;
+71 IF $GET(SDIV)
SET PRTOT=$GET(^XTMP(SDNODE,DTNAM,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLN,SDPRV))
+72 IF SDIV="All"
SET PRTOT=$GET(^XTMP(SDNODE,"PROVIDER",DTNAM,SDRPTYP,SDAT,"GRP",SDGRP,"CLIN",SDCLN,SDPRV))
+73 IF ($GET(PRTOT)]"")
NEW SDI
FOR SDI=1:1:4
Begin DoDot:1
+74 SET SDDATA=$$PROV^SDECXML(SDPRV)_" "_$SELECT(SDI=1:$$ENC^SDECXML($PIECE(PRTOT,"^",SDI)),SDI=2:$$NEW^SDECXML($PIECE(PRTOT,"^",SDI)),SDI=3:$$EST^SDECXML($PIECE(PRTOT,"^",SDI)),SDI=4:$$TEL^SDECXML($PIECE(PRTOT,"^",SDI)),1:"")
+75 if ($TRANSLATE(SDDATA,"^","")="")
QUIT
+76 IF '$GET(GRPFLG)
SET SDFILT=$$GRP^SDECXML(SDGRP)
DO SETTMPF^SDECXML(.SDLCNT,SDFILT,13)
+77 DO SETREC^SDECXML(.SDLCNT,SDDATA,15)
End DoDot:1
+78 QUIT
+79 ;
DIVNAME(DIV) ; Division name
+1 KILL DIVNAME,DIC,DR
+2 IF DIV="All"
QUIT DIV
+3 NEW DIE,DIQ,DIR,DA,X,Y
+4 SET DIQ(0)="I"
SET DIC=40.8
SET DA=+$GET(DIV)
SET DR=".01"
+5 DO GETS^DIQ(DIC,DA,DR,"I","DIVNAME")
+6 SET DIVNAME=$GET(DIVNAME(DIC,DA_",",.01,"I"))
+7 IF DIVNAME=""!($LENGTH(DIVNAME)<3)
SET DIVNAME=$PIECE($$SITE^VASITE(),"^",2)
+8 QUIT DIVNAME
+9 ;
OUTPUT(TEXT,PAD,SDLCNT,SDEBUG) ; Generic Set/Output
+1 IF $GET(XMLNODE)=""
SET XMLNODE=$SELECT($GET(SDFLTFLG):"FLTXML",1:"SDECXML")
+2 IF TEXT["/Rg"
SET GRPFLG=0
+3 IF TEXT["/Rs"
SET CLNTAG=0
+4 SET SDLCNT=$GET(SDLCNT)+1
+5 IF $GET(SDEBUG)
USE IO
if (SDLCNT>1)
WRITE !
WRITE ?PAD,TEXT
+6 SET ^XTMP("SDVSE",XMLNODE,SDLCNT)=TEXT
+7 QUIT
+8 ;
CLINIC(SDLCNT,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLIN,DTINC,SDNODE,CLNTAG,SDCALL,GRPFLG,SDEBUG,XMLNODE) ; Clinic
+1 NEW CLTOT,SDFILT,SDMEAS,SDDATA,DTNAM,TMPCLIN,GRPTOT,PRGDTOT,SDCLDIV,ACTOT,SDCLNALL,SDCLPR
+2 SET DTNAM=$GET(DTNAMAR(DTINC))
+3 IF '$GET(SDCALL)
DO ALLCLIN^SDECXML5(.SDLCNT,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,DTINC,.CLNTAG,"",SDCALL,SDNODE,.GRPFLG,SDEBUG,XMLNODE)
+4 ; Single Clinic
DO ONECLIN^SDECXML4(.SDLCNT,SDRPTYP,SDAT,SDFAC,SDIV,SDGRP,SDCLIN,DTINC,"",SDEBUG,.CLNTAG,.GRPFLG,SDNODE,XMLNODE)
+5 ;
+6 QUIT
+7 ;
NEWAP(NEW,LEN,STOP) ; Return new patients
+1 NEW STOPNAM
+2 ;S STOPNAM=$$GRPNAM^SDECXML(STOP)
+3 SET STOPNAM=$PIECE($$GRPNAM^SDECXML(STOP),") ",2)
+4 SET STRING="Mn="""_LEN_" Min Appointments - "_STOPNAM_""" Vt=""New Patients"" Vl="""_NEW_""""
QUIT STRING
ESTAP(EST,LEN,STOP) ; Return established patients
+1 NEW STOPNAM
+2 ;S STOPNAM=$$GRPNAM^SDECXML(STOP)
+3 SET STOPNAM=$PIECE($$GRPNAM^SDECXML(STOP),") ",2)
+4 SET STRING="Mn="""_LEN_" Min Appointments - "_STOPNAM_""" Vt=""Established Patients"" Vl="""_EST_""""
QUIT STRING
OVRAP(OVR,LEN,STOP) ; Appointment
+1 NEW STOPNAM
+2 SET STOPNAM=$PIECE($$GRPNAM^SDECXML(STOP),") ",2)
+3 SET STRING="Mn="""_LEN_" Min Appointments - "_STOPNAM_""" Vt=""Overbooks"" Vl="""_OVR_""""
+4 QUIT STRING
ACTUALAP(ACTUAL,LEN,STOP) ; Appointment
+1 NEW STOPNAM
+2 SET STOPNAM=$PIECE($$GRPNAM^SDECXML(STOP),") ",2)
+3 SET STRING="Mn="""_LEN_" Min Appointments - "_STOPNAM_""" Vt=""Actual"" Vl="""_ACTUAL_""""
+4 QUIT STRING
+5 ;
PARSE(TOT,CL,PR,TYPE,LEN,STOP,ADJ) ; Get record attributes, write/set
+1 IF $GET(TYPE)=""
Begin DoDot:1
+2 NEW SDI
FOR SDI=1:1:4
Begin DoDot:2
+3 SET SDDATA=$$PROV^SDECXML(PR)_" "_$SELECT(SDI=1:$$ENC^SDECXML($PIECE(TOT,"^",SDI)),SDI=2:$$NEW^SDECXML($PIECE(TOT,"^",SDI)),SDI=3:$$EST^SDECXML($PIECE(TOT,"^",SDI)),SDI=4:$$TEL^SDECXML($PIECE(TOT,"^",SDI)),1:"")
+4 if ($TRANSLATE(SDDATA,"^","")="")
QUIT
+5 DO SETREC^SDECXML(.SDLCNT,SDDATA,15)
End DoDot:2
End DoDot:1
QUIT
+6 ;
+7 IF $GET(TYPE)="OVR"
Begin DoDot:1
+8 SET SDDATA=$$PROV^SDECXML(PR)_" "_$$RCAOVR^SDECXML($PIECE(TOT,"^"))
+9 if SDDATA=""
QUIT
+10 DO SETREC^SDECXML(.SDLCNT,SDDATA,15)
End DoDot:1
+11 ;
+12 IF $EXTRACT($GET(TYPE),1,3)="APP"
Begin DoDot:1
+13 SET SDDATA=$$PROV^SDECXML(PR)_" "_$SELECT(TYPE="APPOVR":$$OVRAP^SDECXML2(TOT,LEN,STOP),TYPE="APPNEW":$$NEWAP^SDECXML2(TOT,LEN,STOP),TYPE="APPEST":$$ESTAP^SDECXML2(TOT,LEN,STOP),TYPE="APPACT":$$ACTUALAP^SDECXML2(TOT,LEN,STOP),1:"")
+14 if SDDATA=""
QUIT
+15 DO SETREC^SDECXML(.SDLCNT,SDDATA,15)
End DoDot:1
+16 ;
+17 IF $GET(TYPE)="DEM"
SET SDDATA=$$PROV^SDECXML(PR)_" "_$$RCADEM^SDECXML(TOT)
Begin DoDot:1
+18 IF $GET(ADJ)<0
+19 DO SETREC^SDECXML(.SDLCNT,SDDATA,15)
+20 SET SDDATA=$$PROV^SDECXML(PR)_" "_$$RCADEMA^SDECXML($GET(ADJ))
+21 DO SETREC^SDECXML(.SDLCNT,SDDATA,15)
End DoDot:1
+22 ;
+23 IF $GET(TYPE)="SUP"
Begin DoDot:1
+24 SET SDDATA=$$PROV^SDECXML("All")_" "_$$RCASUP^SDECXML($PIECE(TOT,"^"))
+25 if SDDATA=""
QUIT
+26 DO SETREC^SDECXML(.SDLCNT,SDDATA,15)
End DoDot:1
+27 QUIT
