source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPRAC.m@ 846

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1SCRPRAC ;ALB/CMM - Practitioner Demographics ; 29 Jun 99 04:11PM
2 ;;5.3;Scheduling;**41,52,177**;AUG 13, 1993
3 ;
4 ;Practitioner Demographics Report
5 ;
6PROMPTS ;
7 ;Prompt for Practioner and Print device
8 ;
9 K SCUP
10 N QTIME,PRNT,VAUTP,Y,VAUTCI,NUMBER
11 S QTIME=""
12 ;S VAUTPO="" ;only can select one practitioner
13 S VAUTNA="" ;all not allowed
14 S VAUTT=1 ;all teams
15 W ! D PRACT^SCRPU1
16 I '$D(VAUTP) G ERR
17 D QUE(.VAUTP) Q
18 ;
19QUE(PRACT) ;queue report
20 ;Input: PRACT=array of providers
21 N ZTSAVE,II
22 F II="PRACT(","PRACT" S ZTSAVE(II)=""
23 W ! D EN^XUTMDEVQ("QENTRY^SCRPRAC","Practitioner Demographics",.ZTSAVE)
24 Q
25 ;
26ENTRY2(PRACT,IOP,ZTDTH) ;
27 ;Second entry point for GUI to use
28 ;Input Parameters:
29 ;PRACT - practitioner ien new person file
30 ;IOP - print device
31 ;ZTDTH - queue time (optional)
32 ;
33 ;validate parameters
34 I '$D(PRACT)!'$D(IOP)!(IOP="") Q
35 ;
36 N NUMBER
37 S IOST=$P(IOP,"^",2),IOP=$P(IOP,"^")
38 I IOP?1"Q;".E S IOP=$P(IOP,"Q;",2)
39 I IOST?1"C-".E D QENTRY G RET
40 I ZTDTH="" S ZTDTH=$H
41 S ZTRTN="QENTRY^SCRPRAC"
42 S ZTDESC="Practitioner Demographics",ZTIO=IOP
43 N II
44 F II="PRACT(","PRACT","IOP" S ZTSAVE(II)=""
45 D ^%ZTLOAD
46RET S NUMBER=0
47 I $D(ZTSK) S NUMBER=ZTSK
48 D EXIT1
49 Q NUMBER
50 ;
51QENTRY ;
52 ;driver entry point
53 S TITL="Practitioner Demographics"
54 S STORE="^TMP("_$J_",""SCRPRAC"")"
55 K @STORE
56 S @STORE=0
57 D DRIVE
58 I $O(@STORE@(0))="" S NODATA=$$NODATA^SCRPU3(TITL)
59 I '$D(NODATA) D PRINTIT(STORE,TITL)
60 D EXIT2
61 Q
62 ;
63ERR ;
64EXIT1 ;
65 K ZTDTH,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE,VAUTPO,VAUTT,VAUTP,SCUP,VAUTNA
66 Q
67 ;
68EXIT2 ;
69 K @STORE
70 K STORE,TITL,IOP,PRACT,NODATA,STOP
71 Q
72 ;
73DRIVE ;
74 ;driver module
75 N PRAC,INF,ARRY,ERROR
76 S ARRY="ARRAY",ERROR="ERR"
77 K @ARRY,@ERROR
78 S PRAC=0 F S PRAC=$O(PRACT(PRAC)) Q:PRAC="" D
79 .S INF=$$TPPR^SCAPMC12(PRAC,,,,ARRY,ERROR) ;get practitioner positions
80 .I INF=0 Q
81 .D GATHER^SCRPRAC2(.ARRY,PRAC)
82 .K @ERROR,@ARRY
83 Q
84 ;
85PRINTIT(STORE,TITL) ;
86 N PNAME,PIEN,PAGE,STOP,NEW,SCI
87 S PNAME="",(NEW,PAGE)=1,STOP=0 W:$E(IOST)="C" @IOF
88 F S PNAME=$O(@STORE@(PNAME)) Q:PNAME=""!(STOP) S PIEN=0 D
89 .F S PIEN=$O(@STORE@(PNAME,PIEN)) Q:'PIEN!(STOP) D
90 ..I NEW D TITLE^SCRPU3(.PAGE,TITL)
91 ..;I 'NEW,$E(IOST)="C" D HOLD^SCRPU3(.PAGE,TITL)
92 ..;I 'NEW,$E(IOST)'="C"
93 ..I 'NEW D NEWP1^SCRPU3(.PAGE,TITL)
94 ..Q:STOP S (NEW,SCI)=0
95 ..F S SCI=$O(@STORE@(PNAME,PIEN,SCI)) Q:'SCI!(STOP) D
96 ...I $E(IOST)="C",$Y>(IOSL-3) D HOLD^SCRPU3(.PAGE,TITL) Q:STOP D CONT
97 ...I $E(IOST)'="C",$Y>(IOSL-3) D NEWP1^SCRPU3(.PAGE,TITL) Q:STOP D CONT
98 ...W !,@STORE@(PNAME,PIEN,SCI)
99 ...Q
100 ..I $E(IOST)="C" N DIR S DIR(0)="E" W ! D ^DIR S STOP=Y'=1
101 ..Q
102 .Q
103 Q
104 ;
105CONT W !,"Provider '",PNAME,"' continued...",! Q
Note: See TracBrowser for help on using the repository browser.