| 1 | SCRPRAC ;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 | ;
|
|---|
| 6 | PROMPTS ;
|
|---|
| 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 | ;
|
|---|
| 19 | QUE(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 | ;
|
|---|
| 26 | ENTRY2(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
|
|---|
| 46 | RET S NUMBER=0
|
|---|
| 47 | I $D(ZTSK) S NUMBER=ZTSK
|
|---|
| 48 | D EXIT1
|
|---|
| 49 | Q NUMBER
|
|---|
| 50 | ;
|
|---|
| 51 | QENTRY ;
|
|---|
| 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 | ;
|
|---|
| 63 | ERR ;
|
|---|
| 64 | EXIT1 ;
|
|---|
| 65 | K ZTDTH,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE,VAUTPO,VAUTT,VAUTP,SCUP,VAUTNA
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | EXIT2 ;
|
|---|
| 69 | K @STORE
|
|---|
| 70 | K STORE,TITL,IOP,PRACT,NODATA,STOP
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | DRIVE ;
|
|---|
| 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 | ;
|
|---|
| 85 | PRINTIT(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 | ;
|
|---|
| 105 | CONT W !,"Provider '",PNAME,"' continued...",! Q
|
|---|
