- 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
