VistA-WorldVistAEHR/r/SCHEDULING-SD-SC/SD53P377.m

62 lines
1.6 KiB
Mathematica

SD53P377 ;BP OIFO/TEH - POST INIT FOR PHY LOC SORT ; 4/24/01 3:10pm
;;5.3;Scheduling;**377**;Aug 13, 1993
;
;This routine creates a report of clinics without physical
;locations.
;
;
EN N SC,SCPL,SDI,SDR K ^TMP("SD53P377")
S SC=0 F S SC=$O(^SC(SC)) Q:SC<1 D
.I $P(^SC(SC,0),"^",3)'="C" Q
.I $D(^SC(SC,"I")) S SDI=$P($G(^SC(SC,"I")),"^",1),SDR=$P($G(^("I")),"^",2)
.I $D(^SC(SC,"I")),SDI'="",SDR="" Q
.S SCPL=$P($G(^SC(SC,0)),"^",11) I SCPL="" D
..S ^TMP("SD53P377",SC)=$P(^SC(SC,0),"^")
PRINT ;
N SDCLIN,SDPAGE,SDEND
W !,"Clinics W/O Physical Location Report",!
S SDPAGE=0,SDEND="",%ZIS="Q" D ^%ZIS
I POP Q
I $G(IO("Q"))=1 D Q
.N ZTRTN,ZTDESC,ZTSAVE
.S ZTRTN="PRINT1^SD53P377",ZTDESC="Clinics W/O Physical Location"
.S ZTSAVE("SD*")=""
.D ^%ZTLOAD K IO("Q")
;
PRINT1 ;
U IO
D HDR
S SDCLIN=0
F S SDCLIN=$O(^TMP("SD53P377",SDCLIN)) Q:SDCLIN=""!(SDEND) D
.W !,?15,$G(^TMP("SD53P377",SDCLIN))
.D HDR:$Y+3>IOSL Q:SDEND
W @IOF
D ^%ZISC
Q
HDR ;
I SDPAGE>0,$E(IOST,1,2)="C-" S SDEND=$$EOP() Q:SDEND
S SDPAGE=SDPAGE+1
W:SDPAGE'=1 @IOF
W !,?10,"Clinics W/O Physical Location"
W !,?10,"-----------------------------",!
Q
EOP() ;End of page check
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
I $E(IOST,1,2)'="C-" Q 0 ;not a terminal
S DIR(0)="E"
D ^DIR
Q 'Y
;
;MAIL MESSAGE
;
;N XMSUB,XMY,XMTEXT,XMDUZ
;S XMSUB="Scheduling 5.3 - Clinic Without Phyiscal Locations for Routing Slip Sort."
;S XMY("G.APPOINTMENT MANAGEMENT")=""
;K ^TMP("SD53P377",$J)
;I '$D(^TMP("SD53P377",$J)) D
;.S ^TMP("SD53P377",$J,999999)="All Phys Locations are populated."
;S XMTEXT="^TMP(""SD53P377"",$J,"
;S XMDUZ="POSTMASTER"
;D ^XMD
Q