| [613] | 1 | SDAMQ5 ;ALB/MJK - AM Background Job/Disposition Processing ; 05/19/97
|
|---|
| 2 | ;;5.3;Scheduling;**24,125,374**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN(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)
|
|---|
| 9 | ENQ Q
|
|---|
| 10 | ;
|
|---|
| 11 | CHK(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
|
|---|
| 31 | CHKERR .S ^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR",SDERR,DFN,SDDA)="" Q
|
|---|
| 32 | CHKQ Q
|
|---|
| 33 | ;
|
|---|
| 34 | BULL(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)
|
|---|
| 45 | BULLQ Q
|
|---|
| 46 | ;
|
|---|
| 47 | HDR ; 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
|
|---|
| 53 | ERRLIST ; 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
|
|---|
| 59 | SHOWIT(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
|
|---|
| 72 | HEADERS ; 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 | ;
|
|---|
