SD53P377.m

SD53P377 ;BP OIFO/TEH - POST INIT FOR PHY LOC SORT ; 4/24/01 3:10pm

 ;;5.3;Scheduling;**377,1015**;Aug 13, 1993;Build 21

 ;

 ;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

SD53P377  ;BP OIFO/TEH - POST INIT FOR PHY LOC SORT ; 4/24/01 3:10pm

 +1       ;;5.3;Scheduling;**377,1015**;Aug 13, 1993;Build 21

 +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