| 1 | SD53P377 ;BP OIFO/TEH - POST INIT FOR PHY LOC SORT ; 4/24/01 3:10pm
|
|---|
| 2 | ;;5.3;Scheduling;**377**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;This routine creates a report of clinics without physical
|
|---|
| 5 | ;locations.
|
|---|
| 6 | ;
|
|---|
| 7 | ;
|
|---|
| 8 | EN N SC,SCPL,SDI,SDR K ^TMP("SD53P377")
|
|---|
| 9 | S SC=0 F S SC=$O(^SC(SC)) Q:SC<1 D
|
|---|
| 10 | .I $P(^SC(SC,0),"^",3)'="C" Q
|
|---|
| 11 | .I $D(^SC(SC,"I")) S SDI=$P($G(^SC(SC,"I")),"^",1),SDR=$P($G(^("I")),"^",2)
|
|---|
| 12 | .I $D(^SC(SC,"I")),SDI'="",SDR="" Q
|
|---|
| 13 | .S SCPL=$P($G(^SC(SC,0)),"^",11) I SCPL="" D
|
|---|
| 14 | ..S ^TMP("SD53P377",SC)=$P(^SC(SC,0),"^")
|
|---|
| 15 | PRINT ;
|
|---|
| 16 | N SDCLIN,SDPAGE,SDEND
|
|---|
| 17 | W !,"Clinics W/O Physical Location Report",!
|
|---|
| 18 | S SDPAGE=0,SDEND="",%ZIS="Q" D ^%ZIS
|
|---|
| 19 | I POP Q
|
|---|
| 20 | I $G(IO("Q"))=1 D Q
|
|---|
| 21 | .N ZTRTN,ZTDESC,ZTSAVE
|
|---|
| 22 | .S ZTRTN="PRINT1^SD53P377",ZTDESC="Clinics W/O Physical Location"
|
|---|
| 23 | .S ZTSAVE("SD*")=""
|
|---|
| 24 | .D ^%ZTLOAD K IO("Q")
|
|---|
| 25 | ;
|
|---|
| 26 | PRINT1 ;
|
|---|
| 27 | U IO
|
|---|
| 28 | D HDR
|
|---|
| 29 | S SDCLIN=0
|
|---|
| 30 | F S SDCLIN=$O(^TMP("SD53P377",SDCLIN)) Q:SDCLIN=""!(SDEND) D
|
|---|
| 31 | .W !,?15,$G(^TMP("SD53P377",SDCLIN))
|
|---|
| 32 | .D HDR:$Y+3>IOSL Q:SDEND
|
|---|
| 33 | W @IOF
|
|---|
| 34 | D ^%ZISC
|
|---|
| 35 | Q
|
|---|
| 36 | HDR ;
|
|---|
| 37 | I SDPAGE>0,$E(IOST,1,2)="C-" S SDEND=$$EOP() Q:SDEND
|
|---|
| 38 | S SDPAGE=SDPAGE+1
|
|---|
| 39 | W:SDPAGE'=1 @IOF
|
|---|
| 40 | W !,?10,"Clinics W/O Physical Location"
|
|---|
| 41 | W !,?10,"-----------------------------",!
|
|---|
| 42 | Q
|
|---|
| 43 | EOP() ;End of page check
|
|---|
| 44 | N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 45 | I $E(IOST,1,2)'="C-" Q 0 ;not a terminal
|
|---|
| 46 | S DIR(0)="E"
|
|---|
| 47 | D ^DIR
|
|---|
| 48 | Q 'Y
|
|---|
| 49 | ;
|
|---|
| 50 | ;MAIL MESSAGE
|
|---|
| 51 | ;
|
|---|
| 52 | ;N XMSUB,XMY,XMTEXT,XMDUZ
|
|---|
| 53 | ;S XMSUB="Scheduling 5.3 - Clinic Without Phyiscal Locations for Routing Slip Sort."
|
|---|
| 54 | ;S XMY("G.APPOINTMENT MANAGEMENT")=""
|
|---|
| 55 | ;K ^TMP("SD53P377",$J)
|
|---|
| 56 | ;I '$D(^TMP("SD53P377",$J)) D
|
|---|
| 57 | ;.S ^TMP("SD53P377",$J,999999)="All Phys Locations are populated."
|
|---|
| 58 | ;S XMTEXT="^TMP(""SD53P377"",$J,"
|
|---|
| 59 | ;S XMDUZ="POSTMASTER"
|
|---|
| 60 | ;D ^XMD
|
|---|
| 61 | Q
|
|---|
