source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMQ3.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1SDAMQ3 ;ALB/MJK - AM Background Job/Appointments ; 12/1/91
2 ;;5.3;Scheduling;**24,466**;Aug 13, 1993;Build 2
3 ;
4EN(SDBEG,SDEND) ; -- search appts
5 N VAUTD,SDCL,X,SDIVNM,SDNAME,SDT,SDDA,SDREQ,SDNONCNT
6 S VAUTD=+$P($G(^DG(43,1,"GL")),U,2) S:'VAUTD VAUTD(+$O(^DG(40.8,0)))=""
7 S SDCL=0 F S SDCL=$O(^SC(SDCL)) Q:'SDCL S X=$G(^SC(SDCL,0)) I $P(X,U,3)["C" D
8 .S SDNONCNT=($P(X,U,17)="Y") ; non-count clinic?
9 .S SDNAME=$E($P(X,U),1,30),SDIVNM=""
10 .S X=$$DIV^SDAMU(.SDCL,.VAUTD,.SDIVNM,35)
11 .S SDT=SDBEG F S SDT=$O(^SC(SDCL,"S",SDT)) Q:'SDT!(SDT>SDEND) S SDREQ=$$REQ^SDM1A(.SDT) D
12 ..S SDDA=0 F S SDDA=$O(^SC(SDCL,"S",SDT,1,SDDA)) Q:'SDDA D CHK(SDCL,SDT,SDDA,.SDIVNM,.SDNAME,.SDREQ)
13ENQ Q
14 ;
15CHK(SDCL,SDT,SDDA,SDIVNM,SDNAME,SDREQ) ; -- check appts
16 ; input: SDCL := clinic ifn
17 ; SDT := appt d/t
18 ; SDDA := ifn of appt mutiple
19 ; SDIVNM := division name
20 ; SDNAME := clinic name
21 ; SDREQ := required for credit (ci or co)
22 ;
23 N SD0,SDC,SDNAT,Y,X,DFN,SDPT,SDOE
24 S SD0=$G(^SC(SDCL,"S",SDT,1,SDDA,0)),SDC=$G(^("C")),SDNAT=0,DFN=+SD0
25 S SDPT=$G(^DPT(DFN,"S",SDT,0))
26 ;
27 ; -- must be same clinic
28 I SDCL'=+SDPT G CHKQ
29 ;
30 ; -- valid appointment
31 I '$$VALID^SDAM2(DFN,SDCL,SDT,SDDA) G CHKQ
32 ;
33 ; -- check if canceled or no-showed
34 S X=$P(SDPT,U,2) I X'="I",X'="",X'="NT" G CHKQ
35 ;
36 ; -- re-set for inpatient appt
37 I X="I"!(X="") D
38 .N Y
39 .S Y=$$INP^SDAM2(DFN,SDT)
40 .I X'=Y S $P(SDPT,U,2)=Y,^DPT(DFN,"S",SDT,0)=SDPT
41 .;I Y="I" D CO(DFN,SDT,SDCL,SDREQ)
42 ;
43 ; -- non-count processing
44 I SDNONCNT D CO(DFN,SDT,SDCL,SDREQ) G CHKQ
45 ;
46 ; -- has appt been checked in or out
47 I SDREQ="CI",SDC!($P(SDC,U,3)) G TOT
48 I SDREQ="CO" S SDOE=+$$GETAPT^SDVSIT2(DFN,SDT,SDCL) I $P(SDC,U,3),$$CO^SDAMQ(SDOE) G TOT
49 G TOT:'SD0
50 ;
51 ; -- if good appt then set to nt
52 I $P(SDPT,U,2)="" S $P(^DPT(DFN,"S",SDT,0),U,2)="NT",SDPT=^(0)
53 ;
54 ; -- set nt flag
55 I $P(SDPT,U,2)="NT" S SDNAT=1
56 ;
57TOT ; -- set totals clinic
58 S X=$G(^TMP("SDSTATS",$J,SDIVNM,"APPT",SDNAME)),^(SDNAME)=(X+SDNAT)_U_($P(X,U,2)+1)
59CHKQ Q
60 ;
61CO(DFN,SDT,SDCL,SDREQ) ; -- attempt to CO quietly for inpats and non-counts
62 I SDREQ'="CO" G COQ
63 ; -- get encounter ien
64 N SDOE S SDOE=+$$GETAPT^SDVSIT2(DFN,SDT,SDCL)
65 ; -- if not checked out, try to co
66 I '$$CO^SDAMQ(SDOE) D EN^SDCOM(SDOE,0)
67COQ Q
68 ;
69BULL(SDIVNM,SDLN,SDTOT) ;
70 N SDNAME,NAT,GRAND,OTHER,TGRAND,TNAT
71 S SDNAME="",(TNAT,TGRAND,OTHER)=0
72 D HDR
73 F S SDNAME=$O(^TMP("SDSTATS",$J,SDIVNM,"APPT",SDNAME)) Q:SDNAME="" S X=^(SDNAME) D
74 .S NAT=+X,GRAND=+$P(X,U,2)
75 .S TNAT=TNAT+NAT,TGRAND=TGRAND+GRAND
76 .S SDTOT("DIV","NAT")=SDTOT("DIV","NAT")+NAT
77 .S SDTOT("DIV","GRAND")=SDTOT("DIV","GRAND")+GRAND
78 .I 'NAT S OTHER=OTHER+GRAND
79 .I NAT D LINE(SDNAME,NAT,GRAND)
80 D LINE("ALL OTHER CLINICS",0,OTHER)
81 D SET(" ------------- ---------------- ------- -------")
82 D LINE("Clinic Totals",TNAT,TGRAND)
83BULLQ Q
84 ;
85LINE(CAPTION,NAT,GRAND) ;
86 ; input: CAPTION := text for leftmost col
87 ; NAT := # of encounters requiring action
88 ; GRAND := total # of encounters
89 N Y
90 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)
91 Q
92 ;
93SET(X) ;
94 S SDLN=SDLN+1,^TMP("SDAMTEXT",$J,SDLN,0)=X
95 Q
96 ;
97HDR ;
98 ; input: SDIVNM := division name
99 ;
100 D SET("")
101 D SET(" Appointments Total")
102 D SET(" Clinic Requiring Action Appts Pct.")
103 D SET(" ------ ---------------- ------- -------")
104 Q
Note: See TracBrowser for help on using the repository browser.