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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53P377 1711 printed Sep 23, 2025@20:22:37 Page 2
SD53P377 ;BP OIFO/TEH - POST INIT FOR PHY LOC SORT ; 4/24/01 3:10pm
+1 ;;5.3;Scheduling;**377**;Aug 13, 1993
+2 ;
+3 ;This routine creates a report of clinics without physical
+4 ;locations.
+5 ;
+6 ;
EN NEW SC,SCPL,SDI,SDR
KILL ^TMP("SD53P377")
+1 SET SC=0
FOR
SET SC=$ORDER(^SC(SC))
if SC<1
QUIT
Begin DoDot:1
+2 IF $PIECE(^SC(SC,0),"^",3)'="C"
QUIT
+3 IF $DATA(^SC(SC,"I"))
SET SDI=$PIECE($GET(^SC(SC,"I")),"^",1)
SET SDR=$PIECE($GET(^("I")),"^",2)
+4 IF $DATA(^SC(SC,"I"))
IF SDI'=""
IF SDR=""
QUIT
+5 SET SCPL=$PIECE($GET(^SC(SC,0)),"^",11)
IF SCPL=""
Begin DoDot:2
+6 SET ^TMP("SD53P377",SC)=$PIECE(^SC(SC,0),"^")
End DoDot:2
End DoDot:1
PRINT ;
+1 NEW SDCLIN,SDPAGE,SDEND
+2 WRITE !,"Clinics W/O Physical Location Report",!
+3 SET SDPAGE=0
SET SDEND=""
SET %ZIS="Q"
DO ^%ZIS
+4 IF POP
QUIT
+5 IF $GET(IO("Q"))=1
Begin DoDot:1
+6 NEW ZTRTN,ZTDESC,ZTSAVE
+7 SET ZTRTN="PRINT1^SD53P377"
SET ZTDESC="Clinics W/O Physical Location"
+8 SET ZTSAVE("SD*")=""
+9 DO ^%ZTLOAD
KILL IO("Q")
End DoDot:1
QUIT
+10 ;
PRINT1 ;
+1 USE IO
+2 DO HDR
+3 SET SDCLIN=0
+4 FOR
SET SDCLIN=$ORDER(^TMP("SD53P377",SDCLIN))
if SDCLIN=""!(SDEND)
QUIT
Begin DoDot:1
+5 WRITE !,?15,$GET(^TMP("SD53P377",SDCLIN))
+6 if $Y+3>IOSL
DO HDR
if SDEND
QUIT
End DoDot:1
+7 WRITE @IOF
+8 DO ^%ZISC
+9 QUIT
HDR ;
+1 IF SDPAGE>0
IF $EXTRACT(IOST,1,2)="C-"
SET SDEND=$$EOP()
if SDEND
QUIT
+2 SET SDPAGE=SDPAGE+1
+3 if SDPAGE'=1
WRITE @IOF
+4 WRITE !,?10,"Clinics W/O Physical Location"
+5 WRITE !,?10,"-----------------------------",!
+6 QUIT
EOP() ;End of page check
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 ;not a terminal
IF $EXTRACT(IOST,1,2)'="C-"
QUIT 0
+3 SET DIR(0)="E"
+4 DO ^DIR
+5 QUIT 'Y
+6 ;
+7 ;MAIL MESSAGE
+8 ;
+9 ;N XMSUB,XMY,XMTEXT,XMDUZ
+10 ;S XMSUB="Scheduling 5.3 - Clinic Without Phyiscal Locations for Routing Slip Sort."
+11 ;S XMY("G.APPOINTMENT MANAGEMENT")=""
+12 ;K ^TMP("SD53P377",$J)
+13 ;I '$D(^TMP("SD53P377",$J)) D
+14 ;.S ^TMP("SD53P377",$J,999999)="All Phys Locations are populated."
+15 ;S XMTEXT="^TMP(""SD53P377"",$J,"
+16 ;S XMDUZ="POSTMASTER"
+17 ;D ^XMD
+18 QUIT
