SDCWL ;ALB/MLI - CLINIC WORKLOAD REPORT ; 18 APRIL 88
;;5.3;Scheduling;**140,132**;Aug 13, 1993
D Q S U="^" D ASK2^SDDIV G Q:Y<0 S (VAUTC,SDADD,SDALL,SDNAM,SDPRE)=0 D DATE^SDUTL G Q:POP D WKL^SDAMQ2(SDBD,SDED) G DT:($E(SDBD,6,7)&$E(SDED,6,7))
S:'$E(SDBD,4,5) SDBD=$E(SDBD,1,3)_"0101" S:'$E(SDED,4,5) SDED=$E(SDED,1,3)_"1231" S:'$E(SDBD,6,7) SDBD=$E(SDBD,1,5)_"01" S:'$E(SDED,6,7) SDED=$E(SDED,1,5)_"31"
DT S SDB1=$TR($$FMTE^XLFDT(SDBD,"5DF")," ","0"),SDE1=$TR($$FMTE^XLFDT(SDED,"5DF")," ","0")
S SDB=$TR($$FMTE^XLFDT(SDBD,"2FD")," ","0"),SDE=$TR($$FMTE^XLFDT(SDED,"2FD")," ","0")
S SDBD=SDBD-.1,SDED=SDED+.9
I SDED<2871001 S SDS="C" S VAUTNI=2 D CLINIC^VAUTOMA G Q:Y<0,RT
1 R !,"Totals by (C)LINIC or (S)TOP CODE?: C//",X:DTIME G Q:(X="^")!'$T S Z="^CLINIC^STOP CODE" W:X["?" !,"Type:",!?10,"'C' for CLINIC totals only, or",!?10,"'S' for STOP CODE and CLINIC totals",! I X="" S X="C" W X
D IN^DGHELP G:%=-1 1 S SDS=X I SDS="C" S VAUTNI=2 D CLINIC^VAUTOMA G Q:Y<0,RT
2 F SDI=1:0 Q:SDI>20 W !,"Enter Stop Code: " W:'$D(SDCL) "ALL//" R X:DTIME Q:(X="^")!'$T!(X="") W:X["?" !,"Enter a stop code or return when all stop codes have been entered" D CL^SDSCP
G:X="^"!('$T&(SDI<20)) Q I X="",'$D(SDCL) S SDCL="",SDALL=1
ADD I SDS="S" W !,"Do you want to include add/edits" S %=2 D YN^DICN W:%Y["?" !,"Answer 'Y'es to see add/edits entered through the ADD/EDIT STOP CODES option or",!,"'N'o to leave them out" G Q:%<0,ADD:%'>0 S SDADD='(%-1)
RT I SDS="S"&((SDBD-10000)<2871000) S SDRT="E" G 3
R !,"Brief or Expanded Report? E//",X:DTIME G Q:X="^"!'$T S Z="^BRIEF^EXPANDED" W:X["?" !,"Enter 'B'rief to see a comparison of data to previous year only",!,"or 'E'xpanded to see patient breakdown by clinic/stop code" I X="" S X="E" W X
D IN^DGHELP S SDRT=X G RT:%=-1,ST:X="B"
3 W !,"(D)ETAIL BY DAY or (S)UMMARY BY MONTH?: D//" R X:DTIME G Q:(X="^")!'$T W:X["?" !,"TYPE:",!?10,"'D' for report by individual clinic meeting",!?10,"'S' for report by month" I X="" S X="D" W X
S Z="^DETAIL BY DAY^SUMMARY BY MONTH" D IN^DGHELP G:%=-1 3 S SDF=X
PN I SDF="D" W !,"Do you want to see patient names" S %=2 D YN^DICN W:%Y["?" "ANSWER 'Y'ES OR 'N'O" G Q:%<0,PN:%'>0 S SDNAM='(%-1)
5 I SDS="C"!((SDBD-10000)>2871000) W !,"Do you want to compare this data to the same period in the previous year" S %=2 D YN^DICN W:%Y["?" "ANSWER 'Y'ES OR 'N'O" G Q:%<0,5:%'>0 S SDPRE='(%-1)
W !!,"Report will cover the period from: ",SDB1," through ",SDE1 W:SDPRE !,"Comparison will be done against the same period for the previous year" W !!
ST S DGPGM="6^SDCWL",DGVAR="VAUTC#^VAUTD#^SDALL^SDCL#^SDB^SDB1^SDBD^SDE^SDE1^SDED^SDF^SDRT^SDS^SDADD^SDNAM^SDPRE" K IOP D ZIS^DGUTQ G:POP Q U IO D 6,CLOSE^DGUTQ Q
6 S (SDOB,SDPG,SDHR,SD1)=0,%DT="R",X="N" D ^%DT
S SDNOW=$TR($$FMTE^XLFDT(Y,"5DF")," ","0")_"@"_$P(Y,".",2)
F I=0:0 S I=$S(SDS="S"!VAUTC:$O(^SC(I)),1:$O(VAUTC(I))) Q:'I D SET^SDCWL3
;
IF SDADD D SCAN
I (SDRT="B"!SDPRE)&'$D(SDFL) S SDBD=SDBD-10000,SDED=SDED-10000,SDFL=1 G 6
I '$D(^TMP($J,"CL")),'$D(^("SC")) D NONE^SDCWL3 G Q
G Q:'$D(^TMP($J)) D:SDRT="E"&($D(^TMP($J,1))!$D(^("SC"))) ^SDCWL1,LEG^SDCWL3 D ERR^SDCWL3:$D(^TMP($J,"ERR")),PREV^SDCWL2:SDPRE!(SDRT="B")
Q W ! K ^TMP($J),%,%DT,%Y,BEGDATE,DFN,DGPGM,DGVAR,DIV,ENDDATE,I,I1,J,J1,K,K1,L,L1,M,M1,N,N1,P,P1,POP,Q,Q1,R,S,SD1,SDADD,SDAED,SDALL,SDAPT,SDAS,SDB,SDBD,SDBO,SDCA,SDCL,SDCR,SDCUR,SDD,SDDIV,SDE,SDED,SDEO,SDF,SDF1,SDFL,SDHK,SDHR
K SDF2,SDI,SDIN,SDN,SDNAM,SDNM,SDNOW,SDNS,SDNUM,SDOB,SDOLD,SDP,SDPG,SDPN,SDPRE,SDRT,SDS,SDSC,SDSCC,SDSCH,SDSCI,SDSCN,SDSCO,SDSCS,SDSCU,SDSSN,SDST,SDSTAT,SDSUB,SDT,SDTOT,SDUN,SDV,VAUTC,VAUTD,VAUTNI,X,Y,Z,SDE1,SDB1 Q
;
SCAN ; -- scan ^SCE for date range
N SDT,SDOE,SDOE0,SDSC,SDPAR,SDORG
S SDT=SDBD
F S SDT=$O(^SCE("B",SDT)) Q:'SDT!(SDT>SDED) D
. S SDOE=0
. F S SDOE=$O(^SCE("B",SDT,SDOE)) Q:'SDOE D
. . S SDOE0=$G(^SCE(SDOE,0))
. . S SDSC=+$P($G(^DIC(40.7,+$P(SDOE0,U,3),0)),U,2)
. . S SDPAR=+$P(SDOE0,U,6)
. . S SDORG=+$P(SDOE0,U,8)
. . ;
. . ; -- do checks
. . IF SDORG'=2 Q ; -- must be a/e
. . IF SDPAR Q ; -- must not have parent
. . IF '$$OKAE^SDVSIT2(SDOE) Q ; -- must be checked out
. . IF 'SDSC Q ; -- must be a vaild stop code
. . ;
. . D ADDON^SDCWL2
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCWL 4267 printed Apr 09, 2024@21:55:59 Page 2
SDCWL ;ALB/MLI - CLINIC WORKLOAD REPORT ; 18 APRIL 88
+1 ;;5.3;Scheduling;**140,132**;Aug 13, 1993
+2 DO Q
SET U="^"
DO ASK2^SDDIV
if Y<0
GOTO Q
SET (VAUTC,SDADD,SDALL,SDNAM,SDPRE)=0
DO DATE^SDUTL
if POP
GOTO Q
DO WKL^SDAMQ2(SDBD,SDED)
if ($EXTRACT(SDBD,6,7)&$EXTRACT(SDED,6,7))
GOTO DT
+3 if '$EXTRACT(SDBD,4,5)
SET SDBD=$EXTRACT(SDBD,1,3)_"0101"
if '$EXTRACT(SDED,4,5)
SET SDED=$EXTRACT(SDED,1,3)_"1231"
if '$EXTRACT(SDBD,6,7)
SET SDBD=$EXTRACT(SDBD,1,5)_"01"
if '$EXTRACT(SDED,6,7)
SET SDED=$EXTRACT(SDED,1,5)_"31"
DT SET SDB1=$TRANSLATE($$FMTE^XLFDT(SDBD,"5DF")," ","0")
SET SDE1=$TRANSLATE($$FMTE^XLFDT(SDED,"5DF")," ","0")
+1 SET SDB=$TRANSLATE($$FMTE^XLFDT(SDBD,"2FD")," ","0")
SET SDE=$TRANSLATE($$FMTE^XLFDT(SDED,"2FD")," ","0")
+2 SET SDBD=SDBD-.1
SET SDED=SDED+.9
+3 IF SDED<2871001
SET SDS="C"
SET VAUTNI=2
DO CLINIC^VAUTOMA
if Y<0
GOTO Q
GOTO RT
1 READ !,"Totals by (C)LINIC or (S)TOP CODE?: C//",X:DTIME
if (X="^")!'$TEST
GOTO Q
SET Z="^CLINIC^STOP CODE"
if X["?"
WRITE !,"Type:",!?10,"'C' for CLINIC totals only, or",!?10,"'S' for STOP CODE and CLINIC totals",!
IF X=""
SET X="C"
WRITE X
+1 DO IN^DGHELP
if %=-1
GOTO 1
SET SDS=X
IF SDS="C"
SET VAUTNI=2
DO CLINIC^VAUTOMA
if Y<0
GOTO Q
GOTO RT
2 FOR SDI=1:0
if SDI>20
QUIT
WRITE !,"Enter Stop Code: "
if '$DATA(SDCL)
WRITE "ALL//"
READ X:DTIME
if (X="^")!'$TEST!(X="")
QUIT
if X["?"
WRITE !,"Enter a stop code or return when all stop codes have been entered"
DO CL^SDSCP
+1 if X="^"!('$TEST&(SDI<20))
GOTO Q
IF X=""
IF '$DATA(SDCL)
SET SDCL=""
SET SDALL=1
ADD IF SDS="S"
WRITE !,"Do you want to include add/edits"
SET %=2
DO YN^DICN
if %Y["?"
WRITE !,"Answer 'Y'es to see add/edits entered through the ADD/EDIT STOP CODES option or",!,"'N'o to leave them out"
if %<0
GOTO Q
if %'>0
GOTO ADD
SET SDADD='(%-1)
RT IF SDS="S"&((SDBD-10000)<2871000)
SET SDRT="E"
GOTO 3
+1 READ !,"Brief or Expanded Report? E//",X:DTIME
if X="^"!'$TEST
GOTO Q
SET Z="^BRIEF^EXPANDED"
if X["?"
WRITE !,"Enter 'B'rief to see a comparison of data to previous year only",!,"or 'E'xpanded to see patient breakdown by clinic/stop code"
IF X=""
SET X="E"
WRITE X
+2 DO IN^DGHELP
SET SDRT=X
if %=-1
GOTO RT
if X="B"
GOTO ST
3 WRITE !,"(D)ETAIL BY DAY or (S)UMMARY BY MONTH?: D//"
READ X:DTIME
if (X="^")!'$TEST
GOTO Q
if X["?"
WRITE !,"TYPE:",!?10,"'D' for report by individual clinic meeting",!?10,"'S' for report by month"
IF X=""
SET X="D"
WRITE X
+1 SET Z="^DETAIL BY DAY^SUMMARY BY MONTH"
DO IN^DGHELP
if %=-1
GOTO 3
SET SDF=X
PN IF SDF="D"
WRITE !,"Do you want to see patient names"
SET %=2
DO YN^DICN
if %Y["?"
WRITE "ANSWER 'Y'ES OR 'N'O"
if %<0
GOTO Q
if %'>0
GOTO PN
SET SDNAM='(%-1)
5 IF SDS="C"!((SDBD-10000)>2871000)
WRITE !,"Do you want to compare this data to the same period in the previous year"
SET %=2
DO YN^DICN
if %Y["?"
WRITE "ANSWER 'Y'ES OR 'N'O"
if %<0
GOTO Q
if %'>0
GOTO 5
SET SDPRE='(%-1)
+1 WRITE !!,"Report will cover the period from: ",SDB1," through ",SDE1
if SDPRE
WRITE !,"Comparison will be done against the same period for the previous year"
WRITE !!
ST SET DGPGM="6^SDCWL"
SET DGVAR="VAUTC#^VAUTD#^SDALL^SDCL#^SDB^SDB1^SDBD^SDE^SDE1^SDED^SDF^SDRT^SDS^SDADD^SDNAM^SDPRE"
KILL IOP
DO ZIS^DGUTQ
if POP
GOTO Q
USE IO
DO 6
DO CLOSE^DGUTQ
QUIT
6 SET (SDOB,SDPG,SDHR,SD1)=0
SET %DT="R"
SET X="N"
DO ^%DT
+1 SET SDNOW=$TRANSLATE($$FMTE^XLFDT(Y,"5DF")," ","0")_"@"_$PIECE(Y,".",2)
+2 FOR I=0:0
SET I=$SELECT(SDS="S"!VAUTC:$ORDER(^SC(I)),1:$ORDER(VAUTC(I)))
if 'I
QUIT
DO SET^SDCWL3
+3 ;
+4 IF SDADD
DO SCAN
+5 IF (SDRT="B"!SDPRE)&'$DATA(SDFL)
SET SDBD=SDBD-10000
SET SDED=SDED-10000
SET SDFL=1
GOTO 6
+6 IF '$DATA(^TMP($JOB,"CL"))
IF '$DATA(^("SC"))
DO NONE^SDCWL3
GOTO Q
+7 if '$DATA(^TMP($JOB))
GOTO Q
if SDRT="E"&($DATA(^TMP($JOB,1))!$DATA(^("SC")))
DO ^SDCWL1
DO LEG^SDCWL3
if $DATA(^TMP($JOB,"ERR"))
DO ERR^SDCWL3
if SDPRE!(SDRT="B")
DO PREV^SDCWL2
Q WRITE !
KILL ^TMP($JOB),%,%DT,%Y,BEGDATE,DFN,DGPGM,DGVAR,DIV,ENDDATE,I,I1,J,J1,K,K1,L,L1,M,M1,N,N1,P,P1,POP,Q,Q1,R,S,SD1,SDADD,SDAED,SDALL,SDAPT,SDAS,SDB,SDBD,SDBO,SDCA,SDCL,SDCR,SDCUR,SDD,SDDIV,SDE,SDED,SDEO,SDF,SDF1,SDFL,SDHK,SDHR
+1 KILL SDF2,SDI,SDIN,SDN,SDNAM,SDNM,SDNOW,SDNS,SDNUM,SDOB,SDOLD,SDP,SDPG,SDPN,SDPRE,SDRT,SDS,SDSC,SDSCC,SDSCH,SDSCI,SDSCN,SDSCO,SDSCS,SDSCU,SDSSN,SDST,SDSTAT,SDSUB,SDT,SDTOT,SDUN,SDV,VAUTC,VAUTD,VAUTNI,X,Y,Z,SDE1,SDB1
QUIT
+2 ;
SCAN ; -- scan ^SCE for date range
+1 NEW SDT,SDOE,SDOE0,SDSC,SDPAR,SDORG
+2 SET SDT=SDBD
+3 FOR
SET SDT=$ORDER(^SCE("B",SDT))
if 'SDT!(SDT>SDED)
QUIT
Begin DoDot:1
+4 SET SDOE=0
+5 FOR
SET SDOE=$ORDER(^SCE("B",SDT,SDOE))
if 'SDOE
QUIT
Begin DoDot:2
+6 SET SDOE0=$GET(^SCE(SDOE,0))
+7 SET SDSC=+$PIECE($GET(^DIC(40.7,+$PIECE(SDOE0,U,3),0)),U,2)
+8 SET SDPAR=+$PIECE(SDOE0,U,6)
+9 SET SDORG=+$PIECE(SDOE0,U,8)
+10 ;
+11 ; -- do checks
+12 ; -- must be a/e
IF SDORG'=2
QUIT
+13 ; -- must not have parent
IF SDPAR
QUIT
+14 ; -- must be checked out
IF '$$OKAE^SDVSIT2(SDOE)
QUIT
+15 ; -- must be a vaild stop code
IF 'SDSC
QUIT
+16 ;
+17 DO ADDON^SDCWL2
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
