source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMQ5.m@ 1500

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1SDAMQ5 ;ALB/MJK - AM Background Job/Disposition Processing ; 05/19/97
2 ;;5.3;Scheduling;**24,125,374**;Aug 13, 1993
3 ;
4EN(SDBEG,SDEND) ; -- count dispositions
5 N SDIVNM,SDT,SD0,SDDA,SDNAT,DFN,X,SDOE
6 S SDT=SDBEG F S SDT=$O(^DPT("ADIS",SDT)) Q:'SDT!(SDT>SDEND) I $$REQ^SDM1A(.SDT)="CO" D
7 .S DFN=0 F S DFN=$O(^DPT("ADIS",SDT,DFN)) Q:'DFN D
8 ..S SDDA=0 F S SDDA=$O(^DPT("ADIS",SDT,DFN,SDDA)) Q:'SDDA D CHK(.DFN,.SDDA,.SDT)
9ENQ Q
10 ;
11CHK(DFN,SDDA,SDT) ; check dispositions
12 N SDOE,SD0,SDIVNM,SDNAT,X,SDERR,SDLOC
13 S SDERR=""
14 G CHKQ:'$D(^DPT(DFN,"DIS",SDDA,0)) S SD0=^(0)
15 I $P(SD0,U,2)=0!($P(SD0,U,2)=1),$P(SD0,U,7),$$DIV^SDAMQ(+$P(SD0,U,4),.SDIVNM,35) D
16 .;CHECK INSTALL DATE FOR PATCH DG*5.3*459 IF BEFORE RELEASE DATE
17 .;SEND TO ERROR CHECKER OTHERWISE SKIP. DBIA:2197
18 .N SDINIEN,SDINDT,SDPCHK S SDPCHK=0
19 .S SDINIEN=$O(^XPD(9.7,"B","DG*5.3*459",0)) D
20 ..I SDINIEN'="" S SDINDT=$$GET1^DIQ(9.7,SDINIEN,2,"I") D
21 ...I SDINDT>SDT S SDPCHK=1
22 .S SDOE=$P(SD0,U,18)
23 .I SDOE="" I SDPCHK S SDERR=1 G CHKERR
24 .I SDOE="" Q
25 .I '$D(^SCE(SDOE,0)) S SDERR=2 G CHKERR
26 .S SDLOC=$P(^SCE(SDOE,0),U,4)
27 .I SDLOC="" S SDERR=3 G CHKERR
28 .I '$D(^PX(815,1,"DHL","B",SDLOC)) S SDERR=4 G CHKERR
29 .S SDNAT='$$CO^SDAMQ(+$$GETDISP^SDVSIT2(DFN,SDT))
30 .S X=$G(^TMP("SDSTATS",$J,SDIVNM,"DISP",102)),^(102)=(X+SDNAT)_U_($P(X,U,2)+1) Q
31CHKERR .S ^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR",SDERR,DFN,SDDA)="" Q
32CHKQ Q
33 ;
34BULL(SDIVNM,SDLN,SDTOT) ; build disposition section of bulletin
35 N SDSTOP,NAT,GRAND,OTHER,TNAT,TGRAND
36 I $D(^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR")) D ERRLIST
37 D HDR
38 S (SDSTOP,TNAT,TGRAND)=0
39 F S SDSTOP=$O(^TMP("SDSTATS",$J,SDIVNM,"DISP",SDSTOP)) Q:'SDSTOP!(SDSTOP="ERR") S X=^(SDSTOP) D
40 .S NAT=+X,GRAND=+$P(X,U,2)
41 .S TNAT=TNAT+NAT,TGRAND=TGRAND+GRAND
42 .S SDTOT("DIV","NAT")=SDTOT("DIV","NAT")+NAT
43 .S SDTOT("DIV","GRAND")=SDTOT("DIV","GRAND")+GRAND
44 D LINE^SDAMQ3("Dispositions",TNAT,TGRAND)
45BULLQ Q
46 ;
47HDR ; header for disposition section of bulletin
48 D SET^SDAMQ3("")
49 D SET^SDAMQ3(" Dispositions")
50 D SET^SDAMQ3(" Requiring Action Total Pct.")
51 D SET^SDAMQ3(" ---------------- ------- -------")
52 Q
53ERRLIST ; if disposition errors, add to bulletin
54 I $D(^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR",1)) D SHOWIT(1)
55 I $D(^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR",2)) D SHOWIT(2)
56 I $D(^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR",3)) D SHOWIT(3)
57 I $D(^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR",4)) D SHOWIT(4)
58 Q
59SHOWIT(SDERR) ; add disposition errors to bulletin
60 N SDDFN,SDDI,SDPAT,Y
61 D SET^SDAMQ3("")
62 D SET^SDAMQ3($P($T(HEADERS+SDERR),"^",2))
63 D SET^SDAMQ3(" (not included in totals)")
64 D SET^SDAMQ3(" -------------------------------------")
65 S SDDFN=""
66 F S SDDFN=$O(^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR",SDERR,SDDFN)) Q:'SDDFN D
67 .S SDDI=""
68 .F S SDDI=$O(^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR",SDERR,SDDFN,SDDI)) Q:'SDDI D
69 ..S SDPAT=$P(^DPT(SDDFN,0),U,1),Y=(9999999-SDDI) D DD^%DT
70 ..D SET^SDAMQ3(" "_SDPAT_" "_Y)
71 Q
72HEADERS ; text for message headers
73 ;;^ **** Disposition without encounter pointer: ****
74 ;;^ **** Disposition points to non-existent encounter: ****
75 ;;^ **** Disposition clinic missing: ****
76 ;;^ **** Disposition clinic not in file 815: ****
77 ;
Note: See TracBrowser for help on using the repository browser.