- 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 Feb 19, 2025@00:14:41 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 ;
