SDAMOW1 ;ALB/CAW - Waiting Time Report (con't) ; 8-NOV-93
;;5.3;Scheduling;**12**;Aug 13, 1993
;
START ; -- entry point to start
K ^TMP("SDWAIT",$J),^TMP("SDWTTOT",$J)
U IO
N SDASH,SDPAGE,SDRT,SDAMDD,SDLEN
I '$$INIT G STARTQ
D BUILD,PRINT^SDAMOWP
K ^TMP("SDWAIT",$J),^TMP("SDWTTOT",$J),^TMP("SDWTTOTD",$J),^TMP("SDWTTOTG",$J)
STARTQ D:'$D(ZTQUEUED) ^%ZISC
K SDATA,SDATE,SDCHKIN,SDCHKOUT,SDCLIN,SDDATA,SDDAY,SDDIV,SDDIVNAM,SDOPEIEN,SDOTTIME,SDSTOP,SDT,SDTTTIME,SDWTTIME,VAERR,VAUTS
Q
;
INIT() ; init variables
S SDLEN=25,$P(SDASH,"-",IOM+1)="",$P(SDASH1,"=",IOM+1)="",SDPAGE=0
Q 1
BUILD ;build tmp array with line values & summary totals
;
S SDT=SDBEG
F S SDT=$O(^SCE("B",SDT)) Q:'SDT!(SDT>SDEND) S SDOPEIEN=0 D
.F S SDOPEIEN=$O(^SCE("B",SDT,SDOPEIEN)) Q:'SDOPEIEN D PROCAPPT
Q
PROCAPPT ;process each appointment
; INPUT:
; SDOPEINE - INE of Outpatient Encounter File #409.68
; SDT - Appointment Date/Time
; OUTPUT:
; DFN - IEN of Patient File #2
; SDCLIN - Clinic, Pointer to Hospital Location File #44
; SDSTOP - Stop Code Number Pointer to Clinic Stop #40.7
; SDDIV - Division, Pointer to MC Division File #40.8
; SDCHKIN - Checkin Date/Time in FM format
; SDCHKOUT - Checkout Date/Time "
;
N SDENODE,SDTMPND,PC,SDCKNODE,SDX
S SDENODE=$G(^SCE(SDOPEIEN,0))
S DFN=$P(SDENODE,U,2) G:'DFN QTPRAPP
; - Originating Process (1=appoint)& Scheduled else quit
G:$P(SDENODE,U,8)'=1 QTPRAPP
G:$P($G(^DPT(DFN,"S",SDT,0)),U,7)'=3 QTPRAPP
; - Status must be checked out (no pending,inpatient, or non-count)
G:$P(SDENODE,U,12)'=2 QTPRAPP
S SDCLIN=$P(SDENODE,U,4)
S SDSTOP=$P(SDENODE,U,3)
S X=SDT D DW^%DTC
S SDDAY=$S(%Y>0:%Y,%Y:"",1:7)
S SDDIV=$P(SDENODE,U,11)
S SDX=U_SDCLIN_U_SDSTOP_U_SDDAY_U_SDDIV_U_DFN_U
G:SDX["^^" QTPRAPP
S SDCKNODE=$G(^SC(SDCLIN,"S",SDT,1,+$$FIND^SDAM2(DFN,SDT,SDCLIN),"C"))
S SDCHKIN=$P(SDCKNODE,U,1)
S SDCHKOUT=$P(SDCKNODE,U,3)
S SDX=SDX_SDCHKIN_U_SDCHKOUT ;add checkin;checkout
G:SDX["^^" QTPRAPP ; no missing variables allowed
S SDDATA=$P(SDX,U,2,99)
G:$$REJECT^SDAMOWB QTPRAPP
D STORE^SDAMOWB(SDSORT,SDDIV,SDCLIN,SDSTOP,SDT,DFN)
QTPRAPP Q
;
DISP() ; -- display selection choices
; input: all selection variables
; output: none
; return: displayed w/o mishap [ 1|yes 0|no]
;
D HOME^%ZIS W @IOF,*13
W $$LINE^SDAMOW("Report Specifications")
W !!," Appointment Dates: ",$$FDATE^VALM1(SDBEG)," to ",$$FDATE^VALM1(SDEND)
W:$D(SDSORT) !," Sorted By: ",$P($T(SORT1+SDSORT^SDAMOWP1),";;",2)
W !!?15,"Divisions",?55,$S(SDSORT=1!(SDSORT=2):"Clinics",SDSORT=5:"Patients",1:"Stop Codes")
W !?15,"---------",?55,"----------",!
S (D,C,S)=0
S D=$S($G(VAUTD):"All",1:$O(VAUTD(0))) W ?15,$S(D:VAUTD(D),1:D) S D=+D
S C=$S($G(VAUTC):"All",1:$O(VAUTC(0))) W ?55,$S(C:VAUTC(C),1:C) S C=+C
I SDSORT'=5 S S=$S($G(VAUTS):"All",1:$O(VAUTS(0))) W ?55,$S(S:VAUTS(S),1:S) S S=+S
F I=1:1 S:D'="" D=$O(VAUTD(D)) S:C'="" C=$O(VAUTC(C)) S:S'="" S=$O(VAUTS(S)) Q:'D&('C!('S)) W ! W:D ?15,VAUTD(D) W:C ?55,VAUTC(C) W:S ?55,VAUTS(S) I I>9 S I=0 D PAUSE^VALM1 I 'Y G DISPQ
W !,$$LINE^SDAMOW("")
S Y=1
DISPQ Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMOW1 3200 printed Oct 16, 2024@18:48:41 Page 2
SDAMOW1 ;ALB/CAW - Waiting Time Report (con't) ; 8-NOV-93
+1 ;;5.3;Scheduling;**12**;Aug 13, 1993
+2 ;
START ; -- entry point to start
+1 KILL ^TMP("SDWAIT",$JOB),^TMP("SDWTTOT",$JOB)
+2 USE IO
+3 NEW SDASH,SDPAGE,SDRT,SDAMDD,SDLEN
+4 IF '$$INIT
GOTO STARTQ
+5 DO BUILD
DO PRINT^SDAMOWP
+6 KILL ^TMP("SDWAIT",$JOB),^TMP("SDWTTOT",$JOB),^TMP("SDWTTOTD",$JOB),^TMP("SDWTTOTG",$JOB)
STARTQ if '$DATA(ZTQUEUED)
DO ^%ZISC
+1 KILL SDATA,SDATE,SDCHKIN,SDCHKOUT,SDCLIN,SDDATA,SDDAY,SDDIV,SDDIVNAM,SDOPEIEN,SDOTTIME,SDSTOP,SDT,SDTTTIME,SDWTTIME,VAERR,VAUTS
+2 QUIT
+3 ;
INIT() ; init variables
+1 SET SDLEN=25
SET $PIECE(SDASH,"-",IOM+1)=""
SET $PIECE(SDASH1,"=",IOM+1)=""
SET SDPAGE=0
+2 QUIT 1
BUILD ;build tmp array with line values & summary totals
+1 ;
+2 SET SDT=SDBEG
+3 FOR
SET SDT=$ORDER(^SCE("B",SDT))
if 'SDT!(SDT>SDEND)
QUIT
SET SDOPEIEN=0
Begin DoDot:1
+4 FOR
SET SDOPEIEN=$ORDER(^SCE("B",SDT,SDOPEIEN))
if 'SDOPEIEN
QUIT
DO PROCAPPT
End DoDot:1
+5 QUIT
PROCAPPT ;process each appointment
+1 ; INPUT:
+2 ; SDOPEINE - INE of Outpatient Encounter File #409.68
+3 ; SDT - Appointment Date/Time
+4 ; OUTPUT:
+5 ; DFN - IEN of Patient File #2
+6 ; SDCLIN - Clinic, Pointer to Hospital Location File #44
+7 ; SDSTOP - Stop Code Number Pointer to Clinic Stop #40.7
+8 ; SDDIV - Division, Pointer to MC Division File #40.8
+9 ; SDCHKIN - Checkin Date/Time in FM format
+10 ; SDCHKOUT - Checkout Date/Time "
+11 ;
+12 NEW SDENODE,SDTMPND,PC,SDCKNODE,SDX
+13 SET SDENODE=$GET(^SCE(SDOPEIEN,0))
+14 SET DFN=$PIECE(SDENODE,U,2)
if 'DFN
GOTO QTPRAPP
+15 ; - Originating Process (1=appoint)& Scheduled else quit
+16 if $PIECE(SDENODE,U,8)'=1
GOTO QTPRAPP
+17 if $PIECE($GET(^DPT(DFN,"S",SDT,0)),U,7)'=3
GOTO QTPRAPP
+18 ; - Status must be checked out (no pending,inpatient, or non-count)
+19 if $PIECE(SDENODE,U,12)'=2
GOTO QTPRAPP
+20 SET SDCLIN=$PIECE(SDENODE,U,4)
+21 SET SDSTOP=$PIECE(SDENODE,U,3)
+22 SET X=SDT
DO DW^%DTC
+23 SET SDDAY=$SELECT(%Y>0:%Y,%Y:"",1:7)
+24 SET SDDIV=$PIECE(SDENODE,U,11)
+25 SET SDX=U_SDCLIN_U_SDSTOP_U_SDDAY_U_SDDIV_U_DFN_U
+26 if SDX["^^"
GOTO QTPRAPP
+27 SET SDCKNODE=$GET(^SC(SDCLIN,"S",SDT,1,+$$FIND^SDAM2(DFN,SDT,SDCLIN),"C"))
+28 SET SDCHKIN=$PIECE(SDCKNODE,U,1)
+29 SET SDCHKOUT=$PIECE(SDCKNODE,U,3)
+30 ;add checkin;checkout
SET SDX=SDX_SDCHKIN_U_SDCHKOUT
+31 ; no missing variables allowed
if SDX["^^"
GOTO QTPRAPP
+32 SET SDDATA=$PIECE(SDX,U,2,99)
+33 if $$REJECT^SDAMOWB
GOTO QTPRAPP
+34 DO STORE^SDAMOWB(SDSORT,SDDIV,SDCLIN,SDSTOP,SDT,DFN)
QTPRAPP QUIT
+1 ;
DISP() ; -- display selection choices
+1 ; input: all selection variables
+2 ; output: none
+3 ; return: displayed w/o mishap [ 1|yes 0|no]
+4 ;
+5 DO HOME^%ZIS
WRITE @IOF,*13
+6 WRITE $$LINE^SDAMOW("Report Specifications")
+7 WRITE !!," Appointment Dates: ",$$FDATE^VALM1(SDBEG)," to ",$$FDATE^VALM1(SDEND)
+8 if $DATA(SDSORT)
WRITE !," Sorted By: ",$PIECE($TEXT(SORT1+SDSORT^SDAMOWP1),";;",2)
+9 WRITE !!?15,"Divisions",?55,$SELECT(SDSORT=1!(SDSORT=2):"Clinics",SDSORT=5:"Patients",1:"Stop Codes")
+10 WRITE !?15,"---------",?55,"----------",!
+11 SET (D,C,S)=0
+12 SET D=$SELECT($GET(VAUTD):"All",1:$ORDER(VAUTD(0)))
WRITE ?15,$SELECT(D:VAUTD(D),1:D)
SET D=+D
+13 SET C=$SELECT($GET(VAUTC):"All",1:$ORDER(VAUTC(0)))
WRITE ?55,$SELECT(C:VAUTC(C),1:C)
SET C=+C
+14 IF SDSORT'=5
SET S=$SELECT($GET(VAUTS):"All",1:$ORDER(VAUTS(0)))
WRITE ?55,$SELECT(S:VAUTS(S),1:S)
SET S=+S
+15 FOR I=1:1
if D'=""
SET D=$ORDER(VAUTD(D))
if C'=""
SET C=$ORDER(VAUTC(C))
if S'=""
SET S=$ORDER(VAUTS(S))
if 'D&('C!('S))
QUIT
WRITE !
if D
WRITE ?15,VAUTD(D)
if C
WRITE ?55,VAUTC(C)
if S
WRITE ?55,VAUTS(S)
IF I>9
SET I=0
DO PAUSE^VALM1
IF 'Y
GOTO DISPQ
+16 WRITE !,$$LINE^SDAMOW("")
+17 SET Y=1
DISPQ QUIT Y
