SDTMPSTN ;TMP/DRF - TMP Missing Station Report;Mar 15, 2022
;;5.3;Scheduling;**812**;SEP 26, 2018;Build 17
Q
;
BEGIN ;Report Begin & Title
W #,"CLINICS THAT ARE MISSING STATION NUMBER",!!
D ACT I Y="^" Q
D ASKTYPE I Y="^" Q
;
IO ;Ask IO device and Queue
S %ZIS="PQM" D ^%ZIS I POP D END Q
I $D(IO("Q")) D QUE,END Q
;
LOOP ;Begin Report
S FND=0,PGNO=0
S CL=0 F S CL=$O(^SC(CL)) Q:'CL D
. S I=$G(^SC(CL,"I"))
. I $P(I,U,1)>0,+$P(I,U,2)=0,ACT="A" Q ;Eliminate inactive clinics
. I +$P(I,U,1)=0,ACT="I" Q ;Eliminate active clinics
. S CL0=$G(^SC(CL,0))
. S PSTOP=$P(CL0,"^",7),SSTOP=$P(CL0,"^",18),CLTYP=$P(CL0,"^",3),NCNT=$P(CL0,"^",17)
. I ASKTYPE'="A",CLTYP'=ASKTYPE Q ;Not the requested clinic type
. S STN=$$STATION^SDTMPHLA(CL)
. I STN="" D LINE
I 'FND W "NO CLINICS MISSING STATION NUMBER WERE FOUND",!
D END
Q
;
TYPE(CLTYP) ;Clinic Type
I CLTYP="C" Q "CLINIC"
I CLTYP="M" Q "MODULE"
I CLTYP="W" Q "WARD"
I CLTYP="Z" Q "OTHER LOCATION"
I CLTYP="N" Q "NON-CLINIC STOP"
I CLTYP="F" Q "FILE AREA"
I CLTYP="I" Q "IMAGING"
I CLTYP="OR" Q "OPERATING ROOM"
Q ""
;
W #
S PGNO=PGNO+1
W ?2,"CLINICS THAT ARE MISSING STATION NUMBER",?71,"DATE: ",$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),?122,"PAGE: ",PGNO,!
W ?2,"CLINIC TYPE: ",$S(ASKTYPE="A":"ALL",1:$$TYPE(ASKTYPE)),!
W ?2,$S(ACT="B":"BOTH ACTIVE AND INACTIVE CLINICS",ACT="I":"INACTIVE CLINICS",1:"ACTIVE CLINICS"),!
W ?2,"CLINIC",?10,"CLINIC NAME",?42,"ABR",?54,"TYPE",?71,"INST",?79,"DIV",?96,"PRI SC",?103,"SEC SC",?111,"NCNT",?116,"STATION",!
W ?2,"-------",?10,"-------------------------------",?42,"-----------",?54,"----------------",?71,"-------",?79,"----------------",?96,"------",?103,"------",?111,"----",?116,"-------",!
Q
;
LINE ;Write a single clinic record
S FND=FND+1
I FND#60=1 D HEADER
N CLNM,CLABR,CLTYP,CLINS,CLDIV
S CLNM=$P(CL0,U,1),CLABR=$P(CL0,U,2),CLTYP=$P(CL0,U,3),CLINS=$P(CL0,U,4),CLDIV=$P(CL0,U,15)
I CLTYP]"" S CLTYP=$$TYPE(CLTYP)
S DIV="" I CLDIV S DIV=$$GET1^DIQ(40.8,CLDIV_",",.01,"I")
W ?2,CL,?10,CLNM,?42,CLABR,?54,CLTYP,?71,CLINS,?79,DIV,?96,PSTOP,?103,SSTOP,?111,NCNT,?116,STN,!
Q
;
QUE ;Run job in background
S ZTRTN="LOOP^SDTMPSTN",ZTDESC="TMP CLINICS THAT ARE MISSING STATION NUMBER"
D ^%ZTLOAD W:$D(ZTSK) !,"Task #",ZTSK," Started."
D HOME^%ZIS K IO("Q"),ZTSK,ZTDESC,ZTQUEUED,ZTRTN
D END
Q
;
END ;Clean up and Quit
D:'$D(ZTQUEUED) ^%ZISC
K ACT,ASKTYPE,DIR,DIV,CL,CL0,FND,I,NCNT,PGNO,PSTOP,SSTOP,STN,STOP1,STOP2,CLABR,CLDIV,CLINS,CLNM,CLTYP,POP,Y,ZTDESC,ZTQUEUE,ZTRTN,ZTSK
Q
;
ACT ;View active, inactive or both clinics
S DIR(0)="SA^A:ACTIVE;I:INACTIVE;B:BOTH^",DIR("B")="B"
S DIR("A")="List which clinics - (A)ctive, (I)nactive or (B)oth ? "
D ^DIR
S ACT=Y
Q
;
ASKTYPE ;Ask clinic type
S DIR(0)="SA^C:CLINIC;M:MODULE;W:WARD;Z:OTHER LOCATION;N:NON-CLINIC STOP;F:FILE AREA;I:IMAGING;R:OPERATING ROOM;A:ALL^",DIR("B")="C"
S DIR("A")="List which clinic types - (C)linic, (M)odule, (W)ard, (Z)Other Location, (N)on-Clinic Stop, (F)ile Area, (I)maging, Operating (R)oom or (A)ll ? "
D ^DIR
I Y="R" S Y="OR"
S ASKTYPE=Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDTMPSTN 3175 printed Oct 16, 2024@19:02 Page 2
SDTMPSTN ;TMP/DRF - TMP Missing Station Report;Mar 15, 2022
+1 ;;5.3;Scheduling;**812**;SEP 26, 2018;Build 17
+2 QUIT
+3 ;
BEGIN ;Report Begin & Title
+1 WRITE #,"CLINICS THAT ARE MISSING STATION NUMBER",!!
+2 DO ACT
IF Y="^"
QUIT
+3 DO ASKTYPE
IF Y="^"
QUIT
+4 ;
IO ;Ask IO device and Queue
+1 SET %ZIS="PQM"
DO ^%ZIS
IF POP
DO END
QUIT
+2 IF $DATA(IO("Q"))
DO QUE
DO END
QUIT
+3 ;
LOOP ;Begin Report
+1 SET FND=0
SET PGNO=0
+2 SET CL=0
FOR
SET CL=$ORDER(^SC(CL))
if 'CL
QUIT
Begin DoDot:1
+3 SET I=$GET(^SC(CL,"I"))
+4 ;Eliminate inactive clinics
IF $PIECE(I,U,1)>0
IF +$PIECE(I,U,2)=0
IF ACT="A"
QUIT
+5 ;Eliminate active clinics
IF +$PIECE(I,U,1)=0
IF ACT="I"
QUIT
+6 SET CL0=$GET(^SC(CL,0))
+7 SET PSTOP=$PIECE(CL0,"^",7)
SET SSTOP=$PIECE(CL0,"^",18)
SET CLTYP=$PIECE(CL0,"^",3)
SET NCNT=$PIECE(CL0,"^",17)
+8 ;Not the requested clinic type
IF ASKTYPE'="A"
IF CLTYP'=ASKTYPE
QUIT
+9 SET STN=$$STATION^SDTMPHLA(CL)
+10 IF STN=""
DO LINE
End DoDot:1
+11 IF 'FND
WRITE "NO CLINICS MISSING STATION NUMBER WERE FOUND",!
+12 DO END
+13 QUIT
+14 ;
TYPE(CLTYP) ;Clinic Type
+1 IF CLTYP="C"
QUIT "CLINIC"
+2 IF CLTYP="M"
QUIT "MODULE"
+3 IF CLTYP="W"
QUIT "WARD"
+4 IF CLTYP="Z"
QUIT "OTHER LOCATION"
+5 IF CLTYP="N"
QUIT "NON-CLINIC STOP"
+6 IF CLTYP="F"
QUIT "FILE AREA"
+7 IF CLTYP="I"
QUIT "IMAGING"
+8 IF CLTYP="OR"
QUIT "OPERATING ROOM"
+9 QUIT ""
+10 ;
+1 WRITE #
+2 SET PGNO=PGNO+1
+3 WRITE ?2,"CLINICS THAT ARE MISSING STATION NUMBER",?71,"DATE: ",$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3),?122,"PAGE: ",PGNO,!
+4 WRITE ?2,"CLINIC TYPE: ",$SELECT(ASKTYPE="A":"ALL",1:$$TYPE(ASKTYPE)),!
+5 WRITE ?2,$SELECT(ACT="B":"BOTH ACTIVE AND INACTIVE CLINICS",ACT="I":"INACTIVE CLINICS",1:"ACTIVE CLINICS"),!
+6 WRITE ?2,"CLINIC",?10,"CLINIC NAME",?42,"ABR",?54,"TYPE",?71,"INST",?79,"DIV",?96,"PRI SC",?103,"SEC SC",?111,"NCNT",?116,"STATION",!
+7 WRITE ?2,"-------",?10,"-------------------------------",?42,"-----------",?54,"----------------",?71,"-------",?79,"----------------",?96,"------",?103,"------",?111,"----",?116,"-------",!
+8 QUIT
+9 ;
LINE ;Write a single clinic record
+1 SET FND=FND+1
+2 IF FND#60=1
DO HEADER
+3 NEW CLNM,CLABR,CLTYP,CLINS,CLDIV
+4 SET CLNM=$PIECE(CL0,U,1)
SET CLABR=$PIECE(CL0,U,2)
SET CLTYP=$PIECE(CL0,U,3)
SET CLINS=$PIECE(CL0,U,4)
SET CLDIV=$PIECE(CL0,U,15)
+5 IF CLTYP]""
SET CLTYP=$$TYPE(CLTYP)
+6 SET DIV=""
IF CLDIV
SET DIV=$$GET1^DIQ(40.8,CLDIV_",",.01,"I")
+7 WRITE ?2,CL,?10,CLNM,?42,CLABR,?54,CLTYP,?71,CLINS,?79,DIV,?96,PSTOP,?103,SSTOP,?111,NCNT,?116,STN,!
+8 QUIT
+9 ;
QUE ;Run job in background
+1 SET ZTRTN="LOOP^SDTMPSTN"
SET ZTDESC="TMP CLINICS THAT ARE MISSING STATION NUMBER"
+2 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Task #",ZTSK," Started."
+3 DO HOME^%ZIS
KILL IO("Q"),ZTSK,ZTDESC,ZTQUEUED,ZTRTN
+4 DO END
+5 QUIT
+6 ;
END ;Clean up and Quit
+1 if '$DATA(ZTQUEUED)
DO ^%ZISC
+2 KILL ACT,ASKTYPE,DIR,DIV,CL,CL0,FND,I,NCNT,PGNO,PSTOP,SSTOP,STN,STOP1,STOP2,CLABR,CLDIV,CLINS,CLNM,CLTYP,POP,Y,ZTDESC,ZTQUEUE,ZTRTN,ZTSK
+3 QUIT
+4 ;
ACT ;View active, inactive or both clinics
+1 SET DIR(0)="SA^A:ACTIVE;I:INACTIVE;B:BOTH^"
SET DIR("B")="B"
+2 SET DIR("A")="List which clinics - (A)ctive, (I)nactive or (B)oth ? "
+3 DO ^DIR
+4 SET ACT=Y
+5 QUIT
+6 ;
ASKTYPE ;Ask clinic type
+1 SET DIR(0)="SA^C:CLINIC;M:MODULE;W:WARD;Z:OTHER LOCATION;N:NON-CLINIC STOP;F:FILE AREA;I:IMAGING;R:OPERATING ROOM;A:ALL^"
SET DIR("B")="C"
+2 SET DIR("A")="List which clinic types - (C)linic, (M)odule, (W)ard, (Z)Other Location, (N)on-Clinic Stop, (F)ile Area, (I)maging, Operating (R)oom or (A)ll ? "
+3 DO ^DIR
+4 IF Y="R"
SET Y="OR"
+5 SET ASKTYPE=Y
+6 QUIT
