source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMOW1.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1SDAMOW1 ;ALB/CAW - Waiting Time Report (con't) ; 8-NOV-93
2 ;;5.3;Scheduling;**12**;Aug 13, 1993
3 ;
4START ; -- entry point to start
5 K ^TMP("SDWAIT",$J),^TMP("SDWTTOT",$J)
6 U IO
7 N SDASH,SDPAGE,SDRT,SDAMDD,SDLEN
8 I '$$INIT G STARTQ
9 D BUILD,PRINT^SDAMOWP
10 K ^TMP("SDWAIT",$J),^TMP("SDWTTOT",$J),^TMP("SDWTTOTD",$J),^TMP("SDWTTOTG",$J)
11STARTQ D:'$D(ZTQUEUED) ^%ZISC
12 K SDATA,SDATE,SDCHKIN,SDCHKOUT,SDCLIN,SDDATA,SDDAY,SDDIV,SDDIVNAM,SDOPEIEN,SDOTTIME,SDSTOP,SDT,SDTTTIME,SDWTTIME,VAERR,VAUTS
13 Q
14 ;
15INIT() ; init variables
16 S SDLEN=25,$P(SDASH,"-",IOM+1)="",$P(SDASH1,"=",IOM+1)="",SDPAGE=0
17 Q 1
18BUILD ;build tmp array with line values & summary totals
19 ;
20 S SDT=SDBEG
21 F S SDT=$O(^SCE("B",SDT)) Q:'SDT!(SDT>SDEND) S SDOPEIEN=0 D
22 .F S SDOPEIEN=$O(^SCE("B",SDT,SDOPEIEN)) Q:'SDOPEIEN D PROCAPPT
23 Q
24PROCAPPT ;process each appointment
25 ; INPUT:
26 ; SDOPEINE - INE of Outpatient Encounter File #409.68
27 ; SDT - Appointment Date/Time
28 ; OUTPUT:
29 ; DFN - IEN of Patient File #2
30 ; SDCLIN - Clinic, Pointer to Hospital Location File #44
31 ; SDSTOP - Stop Code Number Pointer to Clinic Stop #40.7
32 ; SDDIV - Division, Pointer to MC Division File #40.8
33 ; SDCHKIN - Checkin Date/Time in FM format
34 ; SDCHKOUT - Checkout Date/Time "
35 ;
36 N SDENODE,SDTMPND,PC,SDCKNODE,SDX
37 S SDENODE=$G(^SCE(SDOPEIEN,0))
38 S DFN=$P(SDENODE,U,2) G:'DFN QTPRAPP
39 ; - Originating Process (1=appoint)& Scheduled else quit
40 G:$P(SDENODE,U,8)'=1 QTPRAPP
41 G:$P($G(^DPT(DFN,"S",SDT,0)),U,7)'=3 QTPRAPP
42 ; - Status must be checked out (no pending,inpatient, or non-count)
43 G:$P(SDENODE,U,12)'=2 QTPRAPP
44 S SDCLIN=$P(SDENODE,U,4)
45 S SDSTOP=$P(SDENODE,U,3)
46 S X=SDT D DW^%DTC
47 S SDDAY=$S(%Y>0:%Y,%Y:"",1:7)
48 S SDDIV=$P(SDENODE,U,11)
49 S SDX=U_SDCLIN_U_SDSTOP_U_SDDAY_U_SDDIV_U_DFN_U
50 G:SDX["^^" QTPRAPP
51 S SDCKNODE=$G(^SC(SDCLIN,"S",SDT,1,+$$FIND^SDAM2(DFN,SDT,SDCLIN),"C"))
52 S SDCHKIN=$P(SDCKNODE,U,1)
53 S SDCHKOUT=$P(SDCKNODE,U,3)
54 S SDX=SDX_SDCHKIN_U_SDCHKOUT ;add checkin;checkout
55 G:SDX["^^" QTPRAPP ; no missing variables allowed
56 S SDDATA=$P(SDX,U,2,99)
57 G:$$REJECT^SDAMOWB QTPRAPP
58 D STORE^SDAMOWB(SDSORT,SDDIV,SDCLIN,SDSTOP,SDT,DFN)
59QTPRAPP Q
60 ;
61DISP() ; -- display selection choices
62 ; input: all selection variables
63 ; output: none
64 ; return: displayed w/o mishap [ 1|yes 0|no]
65 ;
66 D HOME^%ZIS W @IOF,*13
67 W $$LINE^SDAMOW("Report Specifications")
68 W !!," Appointment Dates: ",$$FDATE^VALM1(SDBEG)," to ",$$FDATE^VALM1(SDEND)
69 W:$D(SDSORT) !," Sorted By: ",$P($T(SORT1+SDSORT^SDAMOWP1),";;",2)
70 W !!?15,"Divisions",?55,$S(SDSORT=1!(SDSORT=2):"Clinics",SDSORT=5:"Patients",1:"Stop Codes")
71 W !?15,"---------",?55,"----------",!
72 S (D,C,S)=0
73 S D=$S($G(VAUTD):"All",1:$O(VAUTD(0))) W ?15,$S(D:VAUTD(D),1:D) S D=+D
74 S C=$S($G(VAUTC):"All",1:$O(VAUTC(0))) W ?55,$S(C:VAUTC(C),1:C) S C=+C
75 I SDSORT'=5 S S=$S($G(VAUTS):"All",1:$O(VAUTS(0))) W ?55,$S(S:VAUTS(S),1:S) S S=+S
76 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
77 W !,$$LINE^SDAMOW("")
78 S Y=1
79DISPQ Q Y
Note: See TracBrowser for help on using the repository browser.