SDAMQ3 ;ALB/MJK - AM Background Job/Appointments ; 12/1/91
;;5.3;Scheduling;**24,466**;Aug 13, 1993;Build 2
;
EN(SDBEG,SDEND) ; -- search appts
N VAUTD,SDCL,X,SDIVNM,SDNAME,SDT,SDDA,SDREQ,SDNONCNT
S VAUTD=+$P($G(^DG(43,1,"GL")),U,2) S:'VAUTD VAUTD(+$O(^DG(40.8,0)))=""
S SDCL=0 F S SDCL=$O(^SC(SDCL)) Q:'SDCL S X=$G(^SC(SDCL,0)) I $P(X,U,3)["C" D
.S SDNONCNT=($P(X,U,17)="Y") ; non-count clinic?
.S SDNAME=$E($P(X,U),1,30),SDIVNM=""
.S X=$$DIV^SDAMU(.SDCL,.VAUTD,.SDIVNM,35)
.S SDT=SDBEG F S SDT=$O(^SC(SDCL,"S",SDT)) Q:'SDT!(SDT>SDEND) S SDREQ=$$REQ^SDM1A(.SDT) D
..S SDDA=0 F S SDDA=$O(^SC(SDCL,"S",SDT,1,SDDA)) Q:'SDDA D CHK(SDCL,SDT,SDDA,.SDIVNM,.SDNAME,.SDREQ)
ENQ Q
;
CHK(SDCL,SDT,SDDA,SDIVNM,SDNAME,SDREQ) ; -- check appts
; input: SDCL := clinic ifn
; SDT := appt d/t
; SDDA := ifn of appt mutiple
; SDIVNM := division name
; SDNAME := clinic name
; SDREQ := required for credit (ci or co)
;
N SD0,SDC,SDNAT,Y,X,DFN,SDPT,SDOE
S SD0=$G(^SC(SDCL,"S",SDT,1,SDDA,0)),SDC=$G(^("C")),SDNAT=0,DFN=+SD0
S SDPT=$G(^DPT(DFN,"S",SDT,0))
;
; -- must be same clinic
I SDCL'=+SDPT G CHKQ
;
; -- valid appointment
I '$$VALID^SDAM2(DFN,SDCL,SDT,SDDA) G CHKQ
;
; -- check if canceled or no-showed
S X=$P(SDPT,U,2) I X'="I",X'="",X'="NT" G CHKQ
;
; -- re-set for inpatient appt
I X="I"!(X="") D
.N Y
.S Y=$$INP^SDAM2(DFN,SDT)
.I X'=Y S $P(SDPT,U,2)=Y,^DPT(DFN,"S",SDT,0)=SDPT
.;I Y="I" D CO(DFN,SDT,SDCL,SDREQ)
;
; -- non-count processing
I SDNONCNT D CO(DFN,SDT,SDCL,SDREQ) G CHKQ
;
; -- has appt been checked in or out
I SDREQ="CI",SDC!($P(SDC,U,3)) G TOT
I SDREQ="CO" S SDOE=+$$GETAPT^SDVSIT2(DFN,SDT,SDCL) I $P(SDC,U,3),$$CO^SDAMQ(SDOE) G TOT
G TOT:'SD0
;
; -- if good appt then set to nt
I $P(SDPT,U,2)="" S $P(^DPT(DFN,"S",SDT,0),U,2)="NT",SDPT=^(0)
;
; -- set nt flag
I $P(SDPT,U,2)="NT" S SDNAT=1
;
TOT ; -- set totals clinic
S X=$G(^TMP("SDSTATS",$J,SDIVNM,"APPT",SDNAME)),^(SDNAME)=(X+SDNAT)_U_($P(X,U,2)+1)
CHKQ Q
;
CO(DFN,SDT,SDCL,SDREQ) ; -- attempt to CO quietly for inpats and non-counts
I SDREQ'="CO" G COQ
; -- get encounter ien
N SDOE S SDOE=+$$GETAPT^SDVSIT2(DFN,SDT,SDCL)
; -- if not checked out, try to co
I '$$CO^SDAMQ(SDOE) D EN^SDCOM(SDOE,0)
COQ Q
;
BULL(SDIVNM,SDLN,SDTOT) ;
N SDNAME,NAT,GRAND,OTHER,TGRAND,TNAT
S SDNAME="",(TNAT,TGRAND,OTHER)=0
D HDR
F S SDNAME=$O(^TMP("SDSTATS",$J,SDIVNM,"APPT",SDNAME)) Q:SDNAME="" S X=^(SDNAME) D
.S NAT=+X,GRAND=+$P(X,U,2)
.S TNAT=TNAT+NAT,TGRAND=TGRAND+GRAND
.S SDTOT("DIV","NAT")=SDTOT("DIV","NAT")+NAT
.S SDTOT("DIV","GRAND")=SDTOT("DIV","GRAND")+GRAND
.I 'NAT S OTHER=OTHER+GRAND
.I NAT D LINE(SDNAME,NAT,GRAND)
D LINE("ALL OTHER CLINICS",0,OTHER)
D SET(" ------------- ---------------- ------- -------")
D LINE("Clinic Totals",TNAT,TGRAND)
BULLQ Q
;
LINE(CAPTION,NAT,GRAND) ;
; input: CAPTION := text for leftmost col
; NAT := # of encounters requiring action
; GRAND := total # of encounters
N Y
S Y="",Y=$$SETSTR^VALM1(CAPTION,Y,10,25),Y=$$SETSTR^VALM1($J(NAT,7),Y,43,7),Y=$$SETSTR^VALM1($J(GRAND,7),Y,60,7),Y=$$SETSTR^VALM1($J($S(GRAND:100*(NAT/GRAND),1:0),6,1)_"%",Y,70,7) D SET(Y)
Q
;
SET(X) ;
S SDLN=SDLN+1,^TMP("SDAMTEXT",$J,SDLN,0)=X
Q
;
HDR ;
; input: SDIVNM := division name
;
D SET("")
D SET(" Appointments Total")
D SET(" Clinic Requiring Action Appts Pct.")
D SET(" ------ ---------------- ------- -------")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMQ3 3689 printed Oct 16, 2024@18:48:48 Page 2
SDAMQ3 ;ALB/MJK - AM Background Job/Appointments ; 12/1/91
+1 ;;5.3;Scheduling;**24,466**;Aug 13, 1993;Build 2
+2 ;
EN(SDBEG,SDEND) ; -- search appts
+1 NEW VAUTD,SDCL,X,SDIVNM,SDNAME,SDT,SDDA,SDREQ,SDNONCNT
+2 SET VAUTD=+$PIECE($GET(^DG(43,1,"GL")),U,2)
if 'VAUTD
SET VAUTD(+$ORDER(^DG(40.8,0)))=""
+3 SET SDCL=0
FOR
SET SDCL=$ORDER(^SC(SDCL))
if 'SDCL
QUIT
SET X=$GET(^SC(SDCL,0))
IF $PIECE(X,U,3)["C"
Begin DoDot:1
+4 ; non-count clinic?
SET SDNONCNT=($PIECE(X,U,17)="Y")
+5 SET SDNAME=$EXTRACT($PIECE(X,U),1,30)
SET SDIVNM=""
+6 SET X=$$DIV^SDAMU(.SDCL,.VAUTD,.SDIVNM,35)
+7 SET SDT=SDBEG
FOR
SET SDT=$ORDER(^SC(SDCL,"S",SDT))
if 'SDT!(SDT>SDEND)
QUIT
SET SDREQ=$$REQ^SDM1A(.SDT)
Begin DoDot:2
+8 SET SDDA=0
FOR
SET SDDA=$ORDER(^SC(SDCL,"S",SDT,1,SDDA))
if 'SDDA
QUIT
DO CHK(SDCL,SDT,SDDA,.SDIVNM,.SDNAME,.SDREQ)
End DoDot:2
End DoDot:1
ENQ QUIT
+1 ;
CHK(SDCL,SDT,SDDA,SDIVNM,SDNAME,SDREQ) ; -- check appts
+1 ; input: SDCL := clinic ifn
+2 ; SDT := appt d/t
+3 ; SDDA := ifn of appt mutiple
+4 ; SDIVNM := division name
+5 ; SDNAME := clinic name
+6 ; SDREQ := required for credit (ci or co)
+7 ;
+8 NEW SD0,SDC,SDNAT,Y,X,DFN,SDPT,SDOE
+9 SET SD0=$GET(^SC(SDCL,"S",SDT,1,SDDA,0))
SET SDC=$GET(^("C"))
SET SDNAT=0
SET DFN=+SD0
+10 SET SDPT=$GET(^DPT(DFN,"S",SDT,0))
+11 ;
+12 ; -- must be same clinic
+13 IF SDCL'=+SDPT
GOTO CHKQ
+14 ;
+15 ; -- valid appointment
+16 IF '$$VALID^SDAM2(DFN,SDCL,SDT,SDDA)
GOTO CHKQ
+17 ;
+18 ; -- check if canceled or no-showed
+19 SET X=$PIECE(SDPT,U,2)
IF X'="I"
IF X'=""
IF X'="NT"
GOTO CHKQ
+20 ;
+21 ; -- re-set for inpatient appt
+22 IF X="I"!(X="")
Begin DoDot:1
+23 NEW Y
+24 SET Y=$$INP^SDAM2(DFN,SDT)
+25 IF X'=Y
SET $PIECE(SDPT,U,2)=Y
SET ^DPT(DFN,"S",SDT,0)=SDPT
+26 ;I Y="I" D CO(DFN,SDT,SDCL,SDREQ)
End DoDot:1
+27 ;
+28 ; -- non-count processing
+29 IF SDNONCNT
DO CO(DFN,SDT,SDCL,SDREQ)
GOTO CHKQ
+30 ;
+31 ; -- has appt been checked in or out
+32 IF SDREQ="CI"
IF SDC!($PIECE(SDC,U,3))
GOTO TOT
+33 IF SDREQ="CO"
SET SDOE=+$$GETAPT^SDVSIT2(DFN,SDT,SDCL)
IF $PIECE(SDC,U,3)
IF $$CO^SDAMQ(SDOE)
GOTO TOT
+34 if 'SD0
GOTO TOT
+35 ;
+36 ; -- if good appt then set to nt
+37 IF $PIECE(SDPT,U,2)=""
SET $PIECE(^DPT(DFN,"S",SDT,0),U,2)="NT"
SET SDPT=^(0)
+38 ;
+39 ; -- set nt flag
+40 IF $PIECE(SDPT,U,2)="NT"
SET SDNAT=1
+41 ;
TOT ; -- set totals clinic
+1 SET X=$GET(^TMP("SDSTATS",$JOB,SDIVNM,"APPT",SDNAME))
SET ^(SDNAME)=(X+SDNAT)_U_($PIECE(X,U,2)+1)
CHKQ QUIT
+1 ;
CO(DFN,SDT,SDCL,SDREQ) ; -- attempt to CO quietly for inpats and non-counts
+1 IF SDREQ'="CO"
GOTO COQ
+2 ; -- get encounter ien
+3 NEW SDOE
SET SDOE=+$$GETAPT^SDVSIT2(DFN,SDT,SDCL)
+4 ; -- if not checked out, try to co
+5 IF '$$CO^SDAMQ(SDOE)
DO EN^SDCOM(SDOE,0)
COQ QUIT
+1 ;
BULL(SDIVNM,SDLN,SDTOT) ;
+1 NEW SDNAME,NAT,GRAND,OTHER,TGRAND,TNAT
+2 SET SDNAME=""
SET (TNAT,TGRAND,OTHER)=0
+3 DO HDR
+4 FOR
SET SDNAME=$ORDER(^TMP("SDSTATS",$JOB,SDIVNM,"APPT",SDNAME))
if SDNAME=""
QUIT
SET X=^(SDNAME)
Begin DoDot:1
+5 SET NAT=+X
SET GRAND=+$PIECE(X,U,2)
+6 SET TNAT=TNAT+NAT
SET TGRAND=TGRAND+GRAND
+7 SET SDTOT("DIV","NAT")=SDTOT("DIV","NAT")+NAT
+8 SET SDTOT("DIV","GRAND")=SDTOT("DIV","GRAND")+GRAND
+9 IF 'NAT
SET OTHER=OTHER+GRAND
+10 IF NAT
DO LINE(SDNAME,NAT,GRAND)
End DoDot:1
+11 DO LINE("ALL OTHER CLINICS",0,OTHER)
+12 DO SET(" ------------- ---------------- ------- -------")
+13 DO LINE("Clinic Totals",TNAT,TGRAND)
BULLQ QUIT
+1 ;
LINE(CAPTION,NAT,GRAND) ;
+1 ; input: CAPTION := text for leftmost col
+2 ; NAT := # of encounters requiring action
+3 ; GRAND := total # of encounters
+4 NEW Y
+5 SET Y=""
SET Y=$$SETSTR^VALM1(CAPTION,Y,10,25)
SET Y=$$SETSTR^VALM1($JUSTIFY(NAT,7),Y,43,7)
SET Y=$$SETSTR^VALM1($JUSTIFY(GRAND,7),Y,60,7)
SET Y=$$SETSTR^VALM1($JUSTIFY($SELECT(GRAND:100*(NAT/GRAND),1:0),6,1)_"%",Y,70,7)
DO SET(Y)
+6 QUIT
+7 ;
SET(X) ;
+1 SET SDLN=SDLN+1
SET ^TMP("SDAMTEXT",$JOB,SDLN,0)=X
+2 QUIT
+3 ;
HDR ;
+1 ; input: SDIVNM := division name
+2 ;
+3 DO SET("")
+4 DO SET(" Appointments Total")
+5 DO SET(" Clinic Requiring Action Appts Pct.")
+6 DO SET(" ------ ---------------- ------- -------")
+7 QUIT
