SDAMQ1 ;ALB/MJK - AM Background Job (cont.) ; 12/1/91
;;5.3;Scheduling;**24,132**;Aug 13, 1993
;
BULL ; -- send bulletin
; use site specified mg
N SDLN,XMY,XMTEXT,XMSUB,XMDUZ
D XMY^SDUTL2(+$P($G(^DG(43,1,"SCLR")),U,15),0)
G BULLQ:'$D(XMY)
S XMSUB="Outpatient Encounter Status Update"
K ^TMP("SDAMTEXT",$J) S XMTEXT="^TMP(""SDAMTEXT"",$J,",SDLN=0
D TEXT,^XMD
BULLQ K ^TMP("SDAMTEXT",$J)
Q
;
TEXT ;
D SET^SDAMQ3("The 'Outpatient Encounter' status update has been completed.")
D SET^SDAMQ3(" ")
D SET^SDAMQ3(" Job STARTED Date/Time: "_$$FTIME^VALM1(SDSTART))
D SET^SDAMQ3(" Job FINISHED Date/Time: "_$$FTIME^VALM1(SDFIN))
D SET^SDAMQ3(" ")
D SET^SDAMQ3(" ")
D SET^SDAMQ3(" *** Update Summary ***")
D SET^SDAMQ3(" ")
D SET^SDAMQ3(" Outpatient encounters from "_$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDEND)_"@2400:")
N SDIVNM,SDTOT
S SDIVNM="" F X="NAT","GRAND" S SDTOT("OVERALL",X)=0
F S SDIVNM=$O(^TMP("SDSTATS",$J,SDIVNM)) Q:SDIVNM="" D
.F X="NAT","GRAND" S SDTOT("DIV",X)=0
.D SET^SDAMQ3(""),SET^SDAMQ3(""),SET^SDAMQ3(""),SET^SDAMQ3(" Division: "_SDIVNM)
.D BULL^SDAMQ3(.SDIVNM,.SDLN,.SDTOT) ; appointments
.D BULL^SDAMQ4(.SDIVNM,.SDLN,.SDTOT) ; add/edits
.D BULL^SDAMQ5(.SDIVNM,.SDLN,.SDTOT) ; dispositions
.D SET^SDAMQ3(" ============== =============== ======= =======")
.D LINE^SDAMQ3("DIVISION TOTAL",SDTOT("DIV","NAT"),SDTOT("DIV","GRAND"))
.F X="NAT","GRAND" S SDTOT("OVERALL",X)=SDTOT("OVERALL",X)+SDTOT("DIV",X)
D SET^SDAMQ3(" ============== =============== ======= =======")
D LINE^SDAMQ3("FACILITY TOTAL",SDTOT("OVERALL","NAT"),SDTOT("OVERALL","GRAND"))
Q
;
ADD ; -- add log entries
N SDDT,X1,X2,X,DR,DA,DIE,DIC
S SDDT=SDBEG
F Q:SDDT>SDEND S X=SDDT,DIC(0)="LM",DLAYGO=409.65,DIC="^SDD(409.65," D ^DIC K DIC,DLAYGO D
.I Y>0 S DA=+Y,DR="[SDAM ADD LOG]",DIE="^SDD(409.65," D ^DIE
.S X1=SDDT,X2=1 D C^%DTC S SDDT=X
Q
;
UPD(SDBEG,SDEND,SDATE,SDFLD,SDADD) ; -- update date fields in 409.65
; input: SDBEG := begin date
; SDEND := end date
; SDATE := date/time of processing(i.e. NOW)
; SDFLD := date field to update
; SDADD := flag to add entry [optional]
;
N SDDT,X1,X2,X,DR,DA,DIE,DIC,SDDR
I '$D(SDADD) N SDADD S SDADD=0
S SDDT=SDBEG,SDDR=SDFLD_"////"_SDATE
F Q:SDDT>SDEND D
.S X=SDDT,DIC(0)="",DIC="^SDD(409.65,"
.S:SDADD DIC(0)=DIC(0)_"L",DLAYGO=409.65
.D ^DIC K DIC,DLAYGO
.I Y>0,$S(SDFLD'=.06:1,1:'$D(^TMP("SDAM NOT UPDATED",$J,SDDT))) S DA=+Y,DR=SDDR,DIE="^SDD(409.65," D ^DIE
.S X1=SDDT,X2=1 D C^%DTC S SDDT=X
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMQ1 2713 printed Nov 22, 2024@17:58:08 Page 2
SDAMQ1 ;ALB/MJK - AM Background Job (cont.) ; 12/1/91
+1 ;;5.3;Scheduling;**24,132**;Aug 13, 1993
+2 ;
BULL ; -- send bulletin
+1 ; use site specified mg
+2 NEW SDLN,XMY,XMTEXT,XMSUB,XMDUZ
+3 DO XMY^SDUTL2(+$PIECE($GET(^DG(43,1,"SCLR")),U,15),0)
+4 if '$DATA(XMY)
GOTO BULLQ
+5 SET XMSUB="Outpatient Encounter Status Update"
+6 KILL ^TMP("SDAMTEXT",$JOB)
SET XMTEXT="^TMP(""SDAMTEXT"",$J,"
SET SDLN=0
+7 DO TEXT
DO ^XMD
BULLQ KILL ^TMP("SDAMTEXT",$JOB)
+1 QUIT
+2 ;
TEXT ;
+1 DO SET^SDAMQ3("The 'Outpatient Encounter' status update has been completed.")
+2 DO SET^SDAMQ3(" ")
+3 DO SET^SDAMQ3(" Job STARTED Date/Time: "_$$FTIME^VALM1(SDSTART))
+4 DO SET^SDAMQ3(" Job FINISHED Date/Time: "_$$FTIME^VALM1(SDFIN))
+5 DO SET^SDAMQ3(" ")
+6 DO SET^SDAMQ3(" ")
+7 DO SET^SDAMQ3(" *** Update Summary ***")
+8 DO SET^SDAMQ3(" ")
+9 DO SET^SDAMQ3(" Outpatient encounters from "_$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDEND)_"@2400:")
+10 NEW SDIVNM,SDTOT
+11 SET SDIVNM=""
FOR X="NAT","GRAND"
SET SDTOT("OVERALL",X)=0
+12 FOR
SET SDIVNM=$ORDER(^TMP("SDSTATS",$JOB,SDIVNM))
if SDIVNM=""
QUIT
Begin DoDot:1
+13 FOR X="NAT","GRAND"
SET SDTOT("DIV",X)=0
+14 DO SET^SDAMQ3("")
DO SET^SDAMQ3("")
DO SET^SDAMQ3("")
DO SET^SDAMQ3(" Division: "_SDIVNM)
+15 ; appointments
DO BULL^SDAMQ3(.SDIVNM,.SDLN,.SDTOT)
+16 ; add/edits
DO BULL^SDAMQ4(.SDIVNM,.SDLN,.SDTOT)
+17 ; dispositions
DO BULL^SDAMQ5(.SDIVNM,.SDLN,.SDTOT)
+18 DO SET^SDAMQ3(" ============== =============== ======= =======")
+19 DO LINE^SDAMQ3("DIVISION TOTAL",SDTOT("DIV","NAT"),SDTOT("DIV","GRAND"))
+20 FOR X="NAT","GRAND"
SET SDTOT("OVERALL",X)=SDTOT("OVERALL",X)+SDTOT("DIV",X)
End DoDot:1
+21 DO SET^SDAMQ3(" ============== =============== ======= =======")
+22 DO LINE^SDAMQ3("FACILITY TOTAL",SDTOT("OVERALL","NAT"),SDTOT("OVERALL","GRAND"))
+23 QUIT
+24 ;
ADD ; -- add log entries
+1 NEW SDDT,X1,X2,X,DR,DA,DIE,DIC
+2 SET SDDT=SDBEG
+3 FOR
if SDDT>SDEND
QUIT
SET X=SDDT
SET DIC(0)="LM"
SET DLAYGO=409.65
SET DIC="^SDD(409.65,"
DO ^DIC
KILL DIC,DLAYGO
Begin DoDot:1
+4 IF Y>0
SET DA=+Y
SET DR="[SDAM ADD LOG]"
SET DIE="^SDD(409.65,"
DO ^DIE
+5 SET X1=SDDT
SET X2=1
DO C^%DTC
SET SDDT=X
End DoDot:1
+6 QUIT
+7 ;
UPD(SDBEG,SDEND,SDATE,SDFLD,SDADD) ; -- update date fields in 409.65
+1 ; input: SDBEG := begin date
+2 ; SDEND := end date
+3 ; SDATE := date/time of processing(i.e. NOW)
+4 ; SDFLD := date field to update
+5 ; SDADD := flag to add entry [optional]
+6 ;
+7 NEW SDDT,X1,X2,X,DR,DA,DIE,DIC,SDDR
+8 IF '$DATA(SDADD)
NEW SDADD
SET SDADD=0
+9 SET SDDT=SDBEG
SET SDDR=SDFLD_"////"_SDATE
+10 FOR
if SDDT>SDEND
QUIT
Begin DoDot:1
+11 SET X=SDDT
SET DIC(0)=""
SET DIC="^SDD(409.65,"
+12 if SDADD
SET DIC(0)=DIC(0)_"L"
SET DLAYGO=409.65
+13 DO ^DIC
KILL DIC,DLAYGO
+14 IF Y>0
IF $SELECT(SDFLD'=.06:1,1:'$DATA(^TMP("SDAM NOT UPDATED",$JOB,SDDT)))
SET DA=+Y
SET DR=SDDR
SET DIE="^SDD(409.65,"
DO ^DIE
+15 SET X1=SDDT
SET X2=1
DO C^%DTC
SET SDDT=X
End DoDot:1
+16 QUIT
+17 ;
