SDAMQ5 ;ALB/MJK - AM Background Job/Disposition Processing ; 05/19/97
;;5.3;Scheduling;**24,125,374**;Aug 13, 1993
;
EN(SDBEG,SDEND) ; -- count dispositions
N SDIVNM,SDT,SD0,SDDA,SDNAT,DFN,X,SDOE
S SDT=SDBEG F S SDT=$O(^DPT("ADIS",SDT)) Q:'SDT!(SDT>SDEND) I $$REQ^SDM1A(.SDT)="CO" D
.S DFN=0 F S DFN=$O(^DPT("ADIS",SDT,DFN)) Q:'DFN D
..S SDDA=0 F S SDDA=$O(^DPT("ADIS",SDT,DFN,SDDA)) Q:'SDDA D CHK(.DFN,.SDDA,.SDT)
ENQ Q
;
CHK(DFN,SDDA,SDT) ; check dispositions
N SDOE,SD0,SDIVNM,SDNAT,X,SDERR,SDLOC
S SDERR=""
G CHKQ:'$D(^DPT(DFN,"DIS",SDDA,0)) S SD0=^(0)
I $P(SD0,U,2)=0!($P(SD0,U,2)=1),$P(SD0,U,7),$$DIV^SDAMQ(+$P(SD0,U,4),.SDIVNM,35) D
.;CHECK INSTALL DATE FOR PATCH DG*5.3*459 IF BEFORE RELEASE DATE
.;SEND TO ERROR CHECKER OTHERWISE SKIP. DBIA:2197
.N SDINIEN,SDINDT,SDPCHK S SDPCHK=0
.S SDINIEN=$O(^XPD(9.7,"B","DG*5.3*459",0)) D
..I SDINIEN'="" S SDINDT=$$GET1^DIQ(9.7,SDINIEN,2,"I") D
...I SDINDT>SDT S SDPCHK=1
.S SDOE=$P(SD0,U,18)
.I SDOE="" I SDPCHK S SDERR=1 G CHKERR
.I SDOE="" Q
.I '$D(^SCE(SDOE,0)) S SDERR=2 G CHKERR
.S SDLOC=$P(^SCE(SDOE,0),U,4)
.I SDLOC="" S SDERR=3 G CHKERR
.I '$D(^PX(815,1,"DHL","B",SDLOC)) S SDERR=4 G CHKERR
.S SDNAT='$$CO^SDAMQ(+$$GETDISP^SDVSIT2(DFN,SDT))
.S X=$G(^TMP("SDSTATS",$J,SDIVNM,"DISP",102)),^(102)=(X+SDNAT)_U_($P(X,U,2)+1) Q
CHKERR .S ^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR",SDERR,DFN,SDDA)="" Q
CHKQ Q
;
BULL(SDIVNM,SDLN,SDTOT) ; build disposition section of bulletin
N SDSTOP,NAT,GRAND,OTHER,TNAT,TGRAND
I $D(^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR")) D ERRLIST
D HDR
S (SDSTOP,TNAT,TGRAND)=0
F S SDSTOP=$O(^TMP("SDSTATS",$J,SDIVNM,"DISP",SDSTOP)) Q:'SDSTOP!(SDSTOP="ERR") S X=^(SDSTOP) 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
D LINE^SDAMQ3("Dispositions",TNAT,TGRAND)
BULLQ Q
;
HDR ; header for disposition section of bulletin
D SET^SDAMQ3("")
D SET^SDAMQ3(" Dispositions")
D SET^SDAMQ3(" Requiring Action Total Pct.")
D SET^SDAMQ3(" ---------------- ------- -------")
Q
ERRLIST ; if disposition errors, add to bulletin
I $D(^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR",1)) D SHOWIT(1)
I $D(^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR",2)) D SHOWIT(2)
I $D(^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR",3)) D SHOWIT(3)
I $D(^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR",4)) D SHOWIT(4)
Q
SHOWIT(SDERR) ; add disposition errors to bulletin
N SDDFN,SDDI,SDPAT,Y
D SET^SDAMQ3("")
D SET^SDAMQ3($P($T(HEADERS+SDERR),"^",2))
D SET^SDAMQ3(" (not included in totals)")
D SET^SDAMQ3(" -------------------------------------")
S SDDFN=""
F S SDDFN=$O(^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR",SDERR,SDDFN)) Q:'SDDFN D
.S SDDI=""
.F S SDDI=$O(^TMP("SDSTATS",$J,SDIVNM,"DISP","ERR",SDERR,SDDFN,SDDI)) Q:'SDDI D
..S SDPAT=$P(^DPT(SDDFN,0),U,1),Y=(9999999-SDDI) D DD^%DT
..D SET^SDAMQ3(" "_SDPAT_" "_Y)
Q
;;^ **** Disposition without encounter pointer: ****
;;^ **** Disposition points to non-existent encounter: ****
;;^ **** Disposition clinic missing: ****
;;^ **** Disposition clinic not in file 815: ****
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMQ5 3485 printed Dec 13, 2024@02:48:14 Page 2
SDAMQ5 ;ALB/MJK - AM Background Job/Disposition Processing ; 05/19/97
+1 ;;5.3;Scheduling;**24,125,374**;Aug 13, 1993
+2 ;
EN(SDBEG,SDEND) ; -- count dispositions
+1 NEW SDIVNM,SDT,SD0,SDDA,SDNAT,DFN,X,SDOE
+2 SET SDT=SDBEG
FOR
SET SDT=$ORDER(^DPT("ADIS",SDT))
if 'SDT!(SDT>SDEND)
QUIT
IF $$REQ^SDM1A(.SDT)="CO"
Begin DoDot:1
+3 SET DFN=0
FOR
SET DFN=$ORDER(^DPT("ADIS",SDT,DFN))
if 'DFN
QUIT
Begin DoDot:2
+4 SET SDDA=0
FOR
SET SDDA=$ORDER(^DPT("ADIS",SDT,DFN,SDDA))
if 'SDDA
QUIT
DO CHK(.DFN,.SDDA,.SDT)
End DoDot:2
End DoDot:1
ENQ QUIT
+1 ;
CHK(DFN,SDDA,SDT) ; check dispositions
+1 NEW SDOE,SD0,SDIVNM,SDNAT,X,SDERR,SDLOC
+2 SET SDERR=""
+3 if '$DATA(^DPT(DFN,"DIS",SDDA,0))
GOTO CHKQ
SET SD0=^(0)
+4 IF $PIECE(SD0,U,2)=0!($PIECE(SD0,U,2)=1)
IF $PIECE(SD0,U,7)
IF $$DIV^SDAMQ(+$PIECE(SD0,U,4),.SDIVNM,35)
Begin DoDot:1
+5 ;CHECK INSTALL DATE FOR PATCH DG*5.3*459 IF BEFORE RELEASE DATE
+6 ;SEND TO ERROR CHECKER OTHERWISE SKIP. DBIA:2197
+7 NEW SDINIEN,SDINDT,SDPCHK
SET SDPCHK=0
+8 SET SDINIEN=$ORDER(^XPD(9.7,"B","DG*5.3*459",0))
Begin DoDot:2
+9 IF SDINIEN'=""
SET SDINDT=$$GET1^DIQ(9.7,SDINIEN,2,"I")
Begin DoDot:3
+10 IF SDINDT>SDT
SET SDPCHK=1
End DoDot:3
End DoDot:2
+11 SET SDOE=$PIECE(SD0,U,18)
+12 IF SDOE=""
IF SDPCHK
SET SDERR=1
GOTO CHKERR
+13 IF SDOE=""
QUIT
+14 IF '$DATA(^SCE(SDOE,0))
SET SDERR=2
GOTO CHKERR
+15 SET SDLOC=$PIECE(^SCE(SDOE,0),U,4)
+16 IF SDLOC=""
SET SDERR=3
GOTO CHKERR
+17 IF '$DATA(^PX(815,1,"DHL","B",SDLOC))
SET SDERR=4
GOTO CHKERR
+18 SET SDNAT='$$CO^SDAMQ(+$$GETDISP^SDVSIT2(DFN,SDT))
+19 SET X=$GET(^TMP("SDSTATS",$JOB,SDIVNM,"DISP",102))
SET ^(102)=(X+SDNAT)_U_($PIECE(X,U,2)+1)
QUIT
CHKERR SET ^TMP("SDSTATS",$JOB,SDIVNM,"DISP","ERR",SDERR,DFN,SDDA)=""
QUIT
End DoDot:1
CHKQ QUIT
+1 ;
BULL(SDIVNM,SDLN,SDTOT) ; build disposition section of bulletin
+1 NEW SDSTOP,NAT,GRAND,OTHER,TNAT,TGRAND
+2 IF $DATA(^TMP("SDSTATS",$JOB,SDIVNM,"DISP","ERR"))
DO ERRLIST
+3 DO HDR
+4 SET (SDSTOP,TNAT,TGRAND)=0
+5 FOR
SET SDSTOP=$ORDER(^TMP("SDSTATS",$JOB,SDIVNM,"DISP",SDSTOP))
if 'SDSTOP!(SDSTOP="ERR")
QUIT
SET X=^(SDSTOP)
Begin DoDot:1
+6 SET NAT=+X
SET GRAND=+$PIECE(X,U,2)
+7 SET TNAT=TNAT+NAT
SET TGRAND=TGRAND+GRAND
+8 SET SDTOT("DIV","NAT")=SDTOT("DIV","NAT")+NAT
+9 SET SDTOT("DIV","GRAND")=SDTOT("DIV","GRAND")+GRAND
End DoDot:1
+10 DO LINE^SDAMQ3("Dispositions",TNAT,TGRAND)
BULLQ QUIT
+1 ;
HDR ; header for disposition section of bulletin
+1 DO SET^SDAMQ3("")
+2 DO SET^SDAMQ3(" Dispositions")
+3 DO SET^SDAMQ3(" Requiring Action Total Pct.")
+4 DO SET^SDAMQ3(" ---------------- ------- -------")
+5 QUIT
ERRLIST ; if disposition errors, add to bulletin
+1 IF $DATA(^TMP("SDSTATS",$JOB,SDIVNM,"DISP","ERR",1))
DO SHOWIT(1)
+2 IF $DATA(^TMP("SDSTATS",$JOB,SDIVNM,"DISP","ERR",2))
DO SHOWIT(2)
+3 IF $DATA(^TMP("SDSTATS",$JOB,SDIVNM,"DISP","ERR",3))
DO SHOWIT(3)
+4 IF $DATA(^TMP("SDSTATS",$JOB,SDIVNM,"DISP","ERR",4))
DO SHOWIT(4)
+5 QUIT
SHOWIT(SDERR) ; add disposition errors to bulletin
+1 NEW SDDFN,SDDI,SDPAT,Y
+2 DO SET^SDAMQ3("")
+3 DO SET^SDAMQ3($PIECE($TEXT(HEADERS+SDERR),"^",2))
+4 DO SET^SDAMQ3(" (not included in totals)")
+5 DO SET^SDAMQ3(" -------------------------------------")
+6 SET SDDFN=""
+7 FOR
SET SDDFN=$ORDER(^TMP("SDSTATS",$JOB,SDIVNM,"DISP","ERR",SDERR,SDDFN))
if 'SDDFN
QUIT
Begin DoDot:1
+8 SET SDDI=""
+9 FOR
SET SDDI=$ORDER(^TMP("SDSTATS",$JOB,SDIVNM,"DISP","ERR",SDERR,SDDFN,SDDI))
if 'SDDI
QUIT
Begin DoDot:2
+10 SET SDPAT=$PIECE(^DPT(SDDFN,0),U,1)
SET Y=(9999999-SDDI)
DO DD^%DT
+11 DO SET^SDAMQ3(" "_SDPAT_" "_Y)
End DoDot:2
End DoDot:1
+12 QUIT
+1 ;;^ **** Disposition without encounter pointer: ****
+2 ;;^ **** Disposition points to non-existent encounter: ****
+3 ;;^ **** Disposition clinic missing: ****
+4 ;;^ **** Disposition clinic not in file 815: ****
+5 ;
