TIURDIV ; SLC/JAK - Review unsig/uncosig Documents by DIVISION ;04/27/11 13:14
;;1.0;TEXT INTEGRATION UTILITIES;**113,259**;Jun 20, 1997;Build 4
; Multidivisional Enhancements - from BUF/DCN - modified by SLC/JAK
;
BEGIN ; Select Division(s), Entry Date Range, Service, Type of Report
N TIUI,TIUSTDT,TIUENDT,TIUSVCS
D SELDIV^TIULA Q:SELDIV'>0
I $D(TIUDI) D
. S TIUI=0 F S TIUI=$O(TIUDI(TIUI)) Q:'TIUI D
. . S TIUDI("ENTRIES")=$G(TIUDI("ENTRIES"))_TIUI_";"
E D
. S TIUDI("ENTRIES")="ALL DIVISIONS"
;
;Ask Date Range, exit if timeout, '^' or no selection
Q:'$$ASKRNG(.TIUSTDT,.TIUENDT)
;
;Select Service, exit if timeout, '^' or no selection
Q:'$$SELSVC^TIULA(.TIUSVCS)
;
N DIR,DIRUT,DTOUT,DUOUT,TIURPT
S DIR(0)="S^F:FULL;S:SUMMARY",DIR("A")="Type of Report"
S DIR("?",1)="Summary lists the number of documents by author's"
S DIR("?",2)="service/section. Full lists detailed document"
S DIR("?",3)="information by author's service/section."
S DIR("?")="Enter ""^"", or a RETURN to quit."
D ^DIR Q:$D(DIRUT) S TIURPT=Y K Y
I TIURPT="F" W !!,"This report must be sent to a 132-column device.",!
;
DEV ; Device selection
S %ZIS="Q" W ! D ^%ZIS I POP K POP G EXIT
I TIURPT="F",IOM'>131 W !!,"You must select a 132-column device." G DEV
I $D(IO("Q")) D G EXIT
. S ZTRTN="BUILD^TIURDIV"
. S ZTSAVE("TIUDI(")="",ZTSAVE("TIURPT")=""
. S ZTSAVE("TIUSTDT")="",ZTSAVE("TIUENDT")=""
. S ZTSAVE("TIUSVCS")="",ZTSAVE("TIUSVCS(")=""
. S ZTDESC="TIU UNSIG/UNCOSIG DOCS BY DIV"
. D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!")
. K ZTSK,ZTDESC,ZTRTN,ZTSAVE,%ZIS,TIUDIV,TIURPT,TIUIFP
. D HOME^%ZIS
U IO D BUILD,^%ZISC
Q
BUILD ; Build list
N TIUIFP,TIUK
K ^TMP("TIUD",$J)
I $D(ZTQUEUED) S ZTREQ="@"
I +$G(TIUDI("ENTRIES")) D
. S TIUK=0 F S TIUK=$O(TIUDI(TIUK)) Q:'TIUK D
. . S TIUIFP=$G(TIUDI(TIUK))
. . D GATHER(TIUIFP,TIUSTDT,TIUENDT,.TIUSVCS)
E D
. S TIUIFP=0
. F S TIUIFP=$O(^TIU(8925,"ADIV",TIUIFP)) Q:+TIUIFP'>0 D
. . D GATHER(TIUIFP,TIUSTDT,TIUENDT,.TIUSVCS)
D PRINT(TIUSTDT,TIUENDT)
;
EXIT ; Clean up and exit
K SELDIV,TIUDI,TIUSTDT,TIUENDT,TIUSVCS K ^TMP("TIUD",$J)
Q
GATHER(TIUIFP,TIUSTDT,TIUENDT,TIUSVCS) ; Find records for the list
; Input -- TIUIFP INSTITUTION file (#4) IEN
; (0 = gather all divisions)
; TIUSTDT Start Date
; TIUENDT End Date
; TIUSVCS Service Selection Array
; Output -- None
N TIUDA,TIUJ,TIUS,TIUTP
S TIUTP=0
F S TIUTP=$O(^TIU(8925,"ADIV",TIUIFP,TIUTP)) Q:+TIUTP'>0 D
. S TIUS=4
. F S TIUS=$O(^TIU(8925,"ADIV",TIUIFP,TIUTP,TIUS)) Q:+TIUS'>0!(+TIUS>6) D
. . S TIUJ=0
. . F S TIUJ=$O(^TIU(8925,"ADIV",TIUIFP,TIUTP,TIUS,TIUJ)) Q:+TIUJ'>0 D
. . . S TIUDA=0
. . . F S TIUDA=$O(^TIU(8925,"ADIV",TIUIFP,TIUTP,TIUS,TIUJ,TIUDA)) Q:+TIUDA'>0 D
. . . . D ADDELMNT(TIUDA,TIUSTDT,TIUENDT,.TIUSVCS)
Q
;
ADDELMNT(TIUDA,TIUSTDT,TIUENDT,TIUSVCS) ; Add each element to the list
; Input -- TIUDA TIU DOCUMENT file (#8925) IEN
; TIUSTDT Start Date
; TIUENDT End Date
; TIUSVCS Service Selection Array
; Output -- None
N TIUAU,TIUD12,TIUEDT,TIUIFP,TIUSVC
N TIUD0,TIUECS,TIUAUECS,TIUS
Q:'$G(^TIU(8925,TIUDA,0))
S TIUD0=^TIU(8925,TIUDA,0),TIUS=$P(TIUD0,U,5)
S TIUD12=$G(^TIU(8925,TIUDA,12)),TIUAU=+$P(TIUD12,U,2),TIUECS=+$P(TIUD12,U,8)
S TIUAUECS=$S(TIUS=6:TIUECS,1:TIUAU) Q:TIUAUECS']0
S TIUEDT=+$P(TIUD12,U),TIUIFP=+$P(TIUD12,U,12)
;Check Date Range
I TIUEDT,TIUEDT>TIUSTDT,TIUEDT<TIUENDT D
. S TIUSVC=$$PROVSVC^TIULV(TIUAUECS)
. ;Check Service
. I $G(TIUSVCS)="ALL"!($D(TIUSVCS(+TIUSVC))) D
. . S TIUAUECS=$$PERSNAME^TIULC1(TIUAUECS)
. . I $P(TIUSVC,U,2)]"" D
. . . S TIUSVC=$P(TIUSVC,U,2)
. . E D
. . . S TIUSVC="UNKNOWN"
. . I TIUAUECS'="UNKNOWN" S TIUAUECS=$$NAME^TIULS(TIUAUECS,"LAST, FI MI")
. . S ^TMP("TIUD",$J,TIUIFP,TIUSVC,TIUAUECS,TIUEDT)=TIUDA
Q
;
PRINT(TIUSTDT,TIUENDT) ; Display/print the output
; Input -- TIUSTDT Start Date
; TIUENDT End Date
; Output -- None
N GTCT,ICT,SCT,TIUAU,TIUDA,TIUECS,TIUEDT
N TIUIFP,TIULST4,TIUOUT,TIUPG,TIUPT,TIUSVC,TIUTP
N TIUAUECS
S (GTCT(5),GTCT(6),TIUIFP,TIUPG,TIUOUT)=0
I '$D(^TMP("TIUD",$J)) W !!,"NO Unsigned/Uncosigned Documents!!" Q
F S TIUIFP=$O(^TMP("TIUD",$J,TIUIFP)) Q:TIUIFP=""!(TIUOUT) D HDR(TIUIFP,TIUSTDT,TIUENDT) D
. S (ICT(TIUIFP,5),ICT(TIUIFP,6))=0 S TIUSVC=""
. F S TIUSVC=$O(^TMP("TIUD",$J,TIUIFP,TIUSVC)) Q:TIUSVC=""!(TIUOUT) D
. . I $Y>(IOSL-5) D ASK Q:TIUOUT D HDR(TIUIFP,TIUSTDT,TIUENDT)
. . D FHDR(TIUSVC):TIURPT="F"
. . S (SCT(TIUIFP,TIUSVC,5),SCT(TIUIFP,TIUSVC,6))=0 S TIUAUECS=""
. . F S TIUAUECS=$O(^TMP("TIUD",$J,TIUIFP,TIUSVC,TIUAUECS)) Q:TIUAUECS=""!(TIUOUT) D
. . . S TIUEDT=0
. . . F S TIUEDT=$O(^TMP("TIUD",$J,TIUIFP,TIUSVC,TIUAUECS,TIUEDT)) Q:TIUEDT=""!(TIUOUT) D
. . . . S TIUDA=+$G(^TMP("TIUD",$J,TIUIFP,TIUSVC,TIUAUECS,TIUEDT))
. . . . D PRTELMNT(TIUDA,TIUIFP,TIUSVC,TIUAUECS,TIUEDT,TIUSTDT,TIUENDT)
. . . . ;
. . Q:TIUOUT
. . I $Y>(IOSL-5) D ASK Q:TIUOUT D HDR(TIUIFP,TIUSTDT,TIUENDT),FHDR(TIUSVC):TIURPT="F"
. . W !!," Totals for Service: ",$E(TIUSVC,1,25),"---"
. . W " UNSIGNED: ",$G(SCT(TIUIFP,TIUSVC,5))
. . W " UNCOSIGNED: ",$G(SCT(TIUIFP,TIUSVC,6))
. Q:TIUOUT
. I $Y>(IOSL-5) D ASK Q:TIUOUT D HDR(TIUIFP,TIUSTDT,TIUENDT)
. W !!,"Totals for Division: ",$E($P($$NS^XUAF4(TIUIFP),U),1,25),"---"
. W " UNSIGNED: ",$G(ICT(TIUIFP,5))
. W " UNCOSIGNED: ",$G(ICT(TIUIFP,6))
. S GTCT(5)=GTCT(5)+ICT(TIUIFP,5),GTCT(6)=GTCT(6)+ICT(TIUIFP,6)
. D ASK Q:TIUOUT
Q:TIUOUT
S TIUIFP="ALL" D HDR(TIUIFP,TIUSTDT,TIUENDT)
W !!,"GRAND Totals (All Divisions)--- UNSIGNED: ",+$G(GTCT(5))
W " UNCOSIGNED: ",+$G(GTCT(6))
Q
PRTELMNT(TIUDA,TIUIFP,TIUSVC,TIUAUECS,TIUEDT,TIUSTDT,TIUENDT) ; Print each element
; Input -- TIUDA TIU DOCUMENT file (#8925) IEN
; TIUIFP INSTITUTION file (#4) IEN
; TIUSVC SERVICE/SECTION file (#49) NAME
; TIUAUECS AUTHOR/ExpCos NAME
; TIUEDT Inverse REFERENCE DATE
; TIUSTDT Start Date
; TIUENDT End Date
; Output -- None
N TIUD0,TIUD12,TIUS
S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD12=$G(^TIU(8925,TIUDA,12))
S TIUS=+$P(TIUD0,U,5) I TIUS'=5,TIUS'=6 Q
S ICT(TIUIFP,TIUS)=ICT(TIUIFP,TIUS)+1
S SCT(TIUIFP,TIUSVC,TIUS)=SCT(TIUIFP,TIUSVC,TIUS)+1
I $Y>(IOSL-5) D ASK Q:TIUOUT D HDR(TIUIFP,TIUSTDT,TIUENDT),FHDR(TIUSVC):TIURPT="F"
I TIURPT="F" D
. S TIUPT=+$P(TIUD0,U,2),TIULST4=$E($$GET1^DIQ(2,TIUPT,.09),6,9)
. S TIUTP=+$P(TIUD0,U),TIUECS=+$P(TIUD12,U,8),TIUAU=+$P(TIUD12,U,2)
. ;I TIUS=6 S TIUAUECS="["_TIUAUECS_"]"
. W !,$G(TIUAUECS)
. W ?17,$S(TIUPT:$E($$EXTERNAL^DILFD(8925,.02,"",TIUPT),1,14),1:"UNK")
. W ?32,$S(TIULST4]"":$G(TIULST4),1:"UNK")
. W ?39,$E($$EXTERNAL^DILFD(8925,.05,"",TIUS),1,10)
. ;W ?53,$S(TIUEDT>0:$$FMTE^XLFDT(TIUEDT,2),1:"UNK")
. W ?50,$S(TIUEDT>0:$$DATE^TIULS(TIUEDT,"MM/DD/YY"),1:"UNK")
. ;W ?71,$G(TIUDA)
. W ?60,$G(TIUDA)
. W ?74,$S(TIUTP:$E($$EXTERNAL^DILFD(8925,.01,"",TIUTP),1,15),1:"UNK")
. I TIUS=5,TIUECS>0 S TIUECS=$E($$EXTERNAL^DILFD(8925,1208,"",TIUECS),1,13) W ?91,TIUECS
. I TIUS=6 S TIUAU=$E($$EXTERNAL^DILFD(8925,1202,"",TIUAU),1,13) W ?104,TIUAU
. ;W ?102,$S((TIUS=5)&(TIUECS]""):TIUECS,TIUS=6:TIUAU,1:"")
. W ?119,$$PRNT(TIUDA)
Q
ASK ; End of page
I IO=IO(0),$E(IOST)="C" D
. W ! N DIR,Y S DIR(0)="E" D ^DIR K DIR
. I Y=""!(Y=0) S TIUOUT=1
Q
HDR(TIUIFP,TIUSTDT,TIUENDT) ; Page (Division) Header
; Input -- TIUIFP INSTITUTION file (#4) IEN
; TIUSTDT Start Date
; TIUENDT End Date
; Output -- None
N LNE,TIUR,TIUINST,TIURNG
S TIUPG=(+$G(TIUPG))+1
D DT^DILF("ET","NOW",.TIUR)
S TIURNG=$$FMTE^XLFDT(TIUSTDT)_" thru "_$$FMTE^XLFDT(TIUENDT)
S TIUINST=$S(TIUIFP:$P($$NS^XUAF4(TIUIFP),U),1:"ALL DIVISIONS")
W @IOF,?26,"Unsigned and Uncosigned Documents "_TIURNG,?(IOM-10)
W "Page ",+$G(TIUPG),!,"PRINTED:",?26,"for ",TIUINST,!,TIUR(0)
W ! S LNE="",$P(LNE,"-",(IOM-1))="" W LNE
I TIURPT="F" D
. W !,"AUTHOR/EXP COS",?17,"PATIENT",?25,"LAST4",?39,"STATUS"
. W ?50,"ENTRY DT",?60,"IEN",?74,"DOC TYPE"
. W ?91,"EXP COSGNR",?104,"AUTHOR",?119,"PARENT IEN",!,LNE
Q
FHDR(TIUSVC) ; Service Header
; Input -- TIUSVC SERVICE/SECTION file (#49) NAME
; Output -- None
W !!?10,"SERVICE: ",TIUSVC
Q
PRNT(TIUDA) ; Does document have a parent?
; Input -- TIUDA TIU Document file (#8925) IEN
; Output -- TIUPRNT Null= TIU Document file (#8925) entry does
; not have a parent
; Exists= TIU Document file (#8925) entry is
; an addendum or ID child.
; Value: Parent TIU Document file
; (#8925) IEN
N ADDMPRNT,IDPRNT,TIUPRNT
S TIUPRNT=""
S ADDMPRNT=+$P($G(^TIU(8925,TIUDA,0)),U,6) ; Addm parent
I '$D(^TIU(8925,ADDMPRNT,0)) S ADDMPRNT=0
I ADDMPRNT D
. S TIUPRNT=ADDMPRNT
E D
. S IDPRNT=+$G(^TIU(8925,TIUDA,21)) ; ID parent
. I '$D(^TIU(8925,IDPRNT,0)) S IDPRNT=0
. I IDPRNT D
. . S TIUPRNT=IDPRNT
Q TIUPRNT
;
ASKRNG(STDT,ENDT) ;Prompt for entry date range
; Input -- None
; Output -- 1=Successful and 0=Failure
; STDT Start Date
; ENDT End Date
N DIRUT,DTOUT,DUOUT,Y
W !!,"Please specify an Entry Date Range:",!
S STDT=+$$READ^TIUU("DA^:DT:E"," Start Entry Date: ")
I $D(DIRUT)!(STDT'>0) G ASKRNGQ
S ENDT=+$$READ^TIUU("DA^"_STDT_":DT:E","Ending Entry Date: ")_"."_235959
I $D(DIRUT)!(ENDT'>0) G ASKRNGQ
S Y=1
ASKRNGQ Q +$G(Y)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURDIV 9685 printed Dec 13, 2024@02:45:12 Page 2
TIURDIV ; SLC/JAK - Review unsig/uncosig Documents by DIVISION ;04/27/11 13:14
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**113,259**;Jun 20, 1997;Build 4
+2 ; Multidivisional Enhancements - from BUF/DCN - modified by SLC/JAK
+3 ;
BEGIN ; Select Division(s), Entry Date Range, Service, Type of Report
+1 NEW TIUI,TIUSTDT,TIUENDT,TIUSVCS
+2 DO SELDIV^TIULA
if SELDIV'>0
QUIT
+3 IF $DATA(TIUDI)
Begin DoDot:1
+4 SET TIUI=0
FOR
SET TIUI=$ORDER(TIUDI(TIUI))
if 'TIUI
QUIT
Begin DoDot:2
+5 SET TIUDI("ENTRIES")=$GET(TIUDI("ENTRIES"))_TIUI_";"
End DoDot:2
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 SET TIUDI("ENTRIES")="ALL DIVISIONS"
End DoDot:1
+8 ;
+9 ;Ask Date Range, exit if timeout, '^' or no selection
+10 if '$$ASKRNG(.TIUSTDT,.TIUENDT)
QUIT
+11 ;
+12 ;Select Service, exit if timeout, '^' or no selection
+13 if '$$SELSVC^TIULA(.TIUSVCS)
QUIT
+14 ;
+15 NEW DIR,DIRUT,DTOUT,DUOUT,TIURPT
+16 SET DIR(0)="S^F:FULL;S:SUMMARY"
SET DIR("A")="Type of Report"
+17 SET DIR("?",1)="Summary lists the number of documents by author's"
+18 SET DIR("?",2)="service/section. Full lists detailed document"
+19 SET DIR("?",3)="information by author's service/section."
+20 SET DIR("?")="Enter ""^"", or a RETURN to quit."
+21 DO ^DIR
if $DATA(DIRUT)
QUIT
SET TIURPT=Y
KILL Y
+22 IF TIURPT="F"
WRITE !!,"This report must be sent to a 132-column device.",!
+23 ;
DEV ; Device selection
+1 SET %ZIS="Q"
WRITE !
DO ^%ZIS
IF POP
KILL POP
GOTO EXIT
+2 IF TIURPT="F"
IF IOM'>131
WRITE !!,"You must select a 132-column device."
GOTO DEV
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 SET ZTRTN="BUILD^TIURDIV"
+5 SET ZTSAVE("TIUDI(")=""
SET ZTSAVE("TIURPT")=""
+6 SET ZTSAVE("TIUSTDT")=""
SET ZTSAVE("TIUENDT")=""
+7 SET ZTSAVE("TIUSVCS")=""
SET ZTSAVE("TIUSVCS(")=""
+8 SET ZTDESC="TIU UNSIG/UNCOSIG DOCS BY DIV"
+9 DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Cancelled!")
+10 KILL ZTSK,ZTDESC,ZTRTN,ZTSAVE,%ZIS,TIUDIV,TIURPT,TIUIFP
+11 DO HOME^%ZIS
End DoDot:1
GOTO EXIT
+12 USE IO
DO BUILD
DO ^%ZISC
+13 QUIT
BUILD ; Build list
+1 NEW TIUIFP,TIUK
+2 KILL ^TMP("TIUD",$JOB)
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 IF +$GET(TIUDI("ENTRIES"))
Begin DoDot:1
+5 SET TIUK=0
FOR
SET TIUK=$ORDER(TIUDI(TIUK))
if 'TIUK
QUIT
Begin DoDot:2
+6 SET TIUIFP=$GET(TIUDI(TIUK))
+7 DO GATHER(TIUIFP,TIUSTDT,TIUENDT,.TIUSVCS)
End DoDot:2
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 SET TIUIFP=0
+10 FOR
SET TIUIFP=$ORDER(^TIU(8925,"ADIV",TIUIFP))
if +TIUIFP'>0
QUIT
Begin DoDot:2
+11 DO GATHER(TIUIFP,TIUSTDT,TIUENDT,.TIUSVCS)
End DoDot:2
End DoDot:1
+12 DO PRINT(TIUSTDT,TIUENDT)
+13 ;
EXIT ; Clean up and exit
+1 KILL SELDIV,TIUDI,TIUSTDT,TIUENDT,TIUSVCS
KILL ^TMP("TIUD",$JOB)
+2 QUIT
GATHER(TIUIFP,TIUSTDT,TIUENDT,TIUSVCS) ; Find records for the list
+1 ; Input -- TIUIFP INSTITUTION file (#4) IEN
+2 ; (0 = gather all divisions)
+3 ; TIUSTDT Start Date
+4 ; TIUENDT End Date
+5 ; TIUSVCS Service Selection Array
+6 ; Output -- None
+7 NEW TIUDA,TIUJ,TIUS,TIUTP
+8 SET TIUTP=0
+9 FOR
SET TIUTP=$ORDER(^TIU(8925,"ADIV",TIUIFP,TIUTP))
if +TIUTP'>0
QUIT
Begin DoDot:1
+10 SET TIUS=4
+11 FOR
SET TIUS=$ORDER(^TIU(8925,"ADIV",TIUIFP,TIUTP,TIUS))
if +TIUS'>0!(+TIUS>6)
QUIT
Begin DoDot:2
+12 SET TIUJ=0
+13 FOR
SET TIUJ=$ORDER(^TIU(8925,"ADIV",TIUIFP,TIUTP,TIUS,TIUJ))
if +TIUJ'>0
QUIT
Begin DoDot:3
+14 SET TIUDA=0
+15 FOR
SET TIUDA=$ORDER(^TIU(8925,"ADIV",TIUIFP,TIUTP,TIUS,TIUJ,TIUDA))
if +TIUDA'>0
QUIT
Begin DoDot:4
+16 DO ADDELMNT(TIUDA,TIUSTDT,TIUENDT,.TIUSVCS)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
ADDELMNT(TIUDA,TIUSTDT,TIUENDT,TIUSVCS) ; Add each element to the list
+1 ; Input -- TIUDA TIU DOCUMENT file (#8925) IEN
+2 ; TIUSTDT Start Date
+3 ; TIUENDT End Date
+4 ; TIUSVCS Service Selection Array
+5 ; Output -- None
+6 NEW TIUAU,TIUD12,TIUEDT,TIUIFP,TIUSVC
+7 NEW TIUD0,TIUECS,TIUAUECS,TIUS
+8 if '$GET(^TIU(8925,TIUDA,0))
QUIT
+9 SET TIUD0=^TIU(8925,TIUDA,0)
SET TIUS=$PIECE(TIUD0,U,5)
+10 SET TIUD12=$GET(^TIU(8925,TIUDA,12))
SET TIUAU=+$PIECE(TIUD12,U,2)
SET TIUECS=+$PIECE(TIUD12,U,8)
+11 SET TIUAUECS=$SELECT(TIUS=6:TIUECS,1:TIUAU)
if TIUAUECS']0
QUIT
+12 SET TIUEDT=+$PIECE(TIUD12,U)
SET TIUIFP=+$PIECE(TIUD12,U,12)
+13 ;Check Date Range
+14 IF TIUEDT
IF TIUEDT>TIUSTDT
IF TIUEDT<TIUENDT
Begin DoDot:1
+15 SET TIUSVC=$$PROVSVC^TIULV(TIUAUECS)
+16 ;Check Service
+17 IF $GET(TIUSVCS)="ALL"!($DATA(TIUSVCS(+TIUSVC)))
Begin DoDot:2
+18 SET TIUAUECS=$$PERSNAME^TIULC1(TIUAUECS)
+19 IF $PIECE(TIUSVC,U,2)]""
Begin DoDot:3
+20 SET TIUSVC=$PIECE(TIUSVC,U,2)
End DoDot:3
+21 IF '$TEST
Begin DoDot:3
+22 SET TIUSVC="UNKNOWN"
End DoDot:3
+23 IF TIUAUECS'="UNKNOWN"
SET TIUAUECS=$$NAME^TIULS(TIUAUECS,"LAST, FI MI")
+24 SET ^TMP("TIUD",$JOB,TIUIFP,TIUSVC,TIUAUECS,TIUEDT)=TIUDA
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
PRINT(TIUSTDT,TIUENDT) ; Display/print the output
+1 ; Input -- TIUSTDT Start Date
+2 ; TIUENDT End Date
+3 ; Output -- None
+4 NEW GTCT,ICT,SCT,TIUAU,TIUDA,TIUECS,TIUEDT
+5 NEW TIUIFP,TIULST4,TIUOUT,TIUPG,TIUPT,TIUSVC,TIUTP
+6 NEW TIUAUECS
+7 SET (GTCT(5),GTCT(6),TIUIFP,TIUPG,TIUOUT)=0
+8 IF '$DATA(^TMP("TIUD",$JOB))
WRITE !!,"NO Unsigned/Uncosigned Documents!!"
QUIT
+9 FOR
SET TIUIFP=$ORDER(^TMP("TIUD",$JOB,TIUIFP))
if TIUIFP=""!(TIUOUT)
QUIT
DO HDR(TIUIFP,TIUSTDT,TIUENDT)
Begin DoDot:1
+10 SET (ICT(TIUIFP,5),ICT(TIUIFP,6))=0
SET TIUSVC=""
+11 FOR
SET TIUSVC=$ORDER(^TMP("TIUD",$JOB,TIUIFP,TIUSVC))
if TIUSVC=""!(TIUOUT)
QUIT
Begin DoDot:2
+12 IF $Y>(IOSL-5)
DO ASK
if TIUOUT
QUIT
DO HDR(TIUIFP,TIUSTDT,TIUENDT)
+13 if TIURPT="F"
DO FHDR(TIUSVC)
+14 SET (SCT(TIUIFP,TIUSVC,5),SCT(TIUIFP,TIUSVC,6))=0
SET TIUAUECS=""
+15 FOR
SET TIUAUECS=$ORDER(^TMP("TIUD",$JOB,TIUIFP,TIUSVC,TIUAUECS))
if TIUAUECS=""!(TIUOUT)
QUIT
Begin DoDot:3
+16 SET TIUEDT=0
+17 FOR
SET TIUEDT=$ORDER(^TMP("TIUD",$JOB,TIUIFP,TIUSVC,TIUAUECS,TIUEDT))
if TIUEDT=""!(TIUOUT)
QUIT
Begin DoDot:4
+18 SET TIUDA=+$GET(^TMP("TIUD",$JOB,TIUIFP,TIUSVC,TIUAUECS,TIUEDT))
+19 DO PRTELMNT(TIUDA,TIUIFP,TIUSVC,TIUAUECS,TIUEDT,TIUSTDT,TIUENDT)
+20 ;
End DoDot:4
End DoDot:3
+21 if TIUOUT
QUIT
+22 IF $Y>(IOSL-5)
DO ASK
if TIUOUT
QUIT
DO HDR(TIUIFP,TIUSTDT,TIUENDT)
if TIURPT="F"
DO FHDR(TIUSVC)
+23 WRITE !!," Totals for Service: ",$EXTRACT(TIUSVC,1,25),"---"
+24 WRITE " UNSIGNED: ",$GET(SCT(TIUIFP,TIUSVC,5))
+25 WRITE " UNCOSIGNED: ",$GET(SCT(TIUIFP,TIUSVC,6))
End DoDot:2
+26 if TIUOUT
QUIT
+27 IF $Y>(IOSL-5)
DO ASK
if TIUOUT
QUIT
DO HDR(TIUIFP,TIUSTDT,TIUENDT)
+28 WRITE !!,"Totals for Division: ",$EXTRACT($PIECE($$NS^XUAF4(TIUIFP),U),1,25),"---"
+29 WRITE " UNSIGNED: ",$GET(ICT(TIUIFP,5))
+30 WRITE " UNCOSIGNED: ",$GET(ICT(TIUIFP,6))
+31 SET GTCT(5)=GTCT(5)+ICT(TIUIFP,5)
SET GTCT(6)=GTCT(6)+ICT(TIUIFP,6)
+32 DO ASK
if TIUOUT
QUIT
End DoDot:1
+33 if TIUOUT
QUIT
+34 SET TIUIFP="ALL"
DO HDR(TIUIFP,TIUSTDT,TIUENDT)
+35 WRITE !!,"GRAND Totals (All Divisions)--- UNSIGNED: ",+$GET(GTCT(5))
+36 WRITE " UNCOSIGNED: ",+$GET(GTCT(6))
+37 QUIT
PRTELMNT(TIUDA,TIUIFP,TIUSVC,TIUAUECS,TIUEDT,TIUSTDT,TIUENDT) ; Print each element
+1 ; Input -- TIUDA TIU DOCUMENT file (#8925) IEN
+2 ; TIUIFP INSTITUTION file (#4) IEN
+3 ; TIUSVC SERVICE/SECTION file (#49) NAME
+4 ; TIUAUECS AUTHOR/ExpCos NAME
+5 ; TIUEDT Inverse REFERENCE DATE
+6 ; TIUSTDT Start Date
+7 ; TIUENDT End Date
+8 ; Output -- None
+9 NEW TIUD0,TIUD12,TIUS
+10 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
SET TIUD12=$GET(^TIU(8925,TIUDA,12))
+11 SET TIUS=+$PIECE(TIUD0,U,5)
IF TIUS'=5
IF TIUS'=6
QUIT
+12 SET ICT(TIUIFP,TIUS)=ICT(TIUIFP,TIUS)+1
+13 SET SCT(TIUIFP,TIUSVC,TIUS)=SCT(TIUIFP,TIUSVC,TIUS)+1
+14 IF $Y>(IOSL-5)
DO ASK
if TIUOUT
QUIT
DO HDR(TIUIFP,TIUSTDT,TIUENDT)
if TIURPT="F"
DO FHDR(TIUSVC)
+15 IF TIURPT="F"
Begin DoDot:1
+16 SET TIUPT=+$PIECE(TIUD0,U,2)
SET TIULST4=$EXTRACT($$GET1^DIQ(2,TIUPT,.09),6,9)
+17 SET TIUTP=+$PIECE(TIUD0,U)
SET TIUECS=+$PIECE(TIUD12,U,8)
SET TIUAU=+$PIECE(TIUD12,U,2)
+18 ;I TIUS=6 S TIUAUECS="["_TIUAUECS_"]"
+19 WRITE !,$GET(TIUAUECS)
+20 WRITE ?17,$SELECT(TIUPT:$EXTRACT($$EXTERNAL^DILFD(8925,.02,"",TIUPT),1,14),1:"UNK")
+21 WRITE ?32,$SELECT(TIULST4]"":$GET(TIULST4),1:"UNK")
+22 WRITE ?39,$EXTRACT($$EXTERNAL^DILFD(8925,.05,"",TIUS),1,10)
+23 ;W ?53,$S(TIUEDT>0:$$FMTE^XLFDT(TIUEDT,2),1:"UNK")
+24 WRITE ?50,$SELECT(TIUEDT>0:$$DATE^TIULS(TIUEDT,"MM/DD/YY"),1:"UNK")
+25 ;W ?71,$G(TIUDA)
+26 WRITE ?60,$GET(TIUDA)
+27 WRITE ?74,$SELECT(TIUTP:$EXTRACT($$EXTERNAL^DILFD(8925,.01,"",TIUTP),1,15),1:"UNK")
+28 IF TIUS=5
IF TIUECS>0
SET TIUECS=$EXTRACT($$EXTERNAL^DILFD(8925,1208,"",TIUECS),1,13)
WRITE ?91,TIUECS
+29 IF TIUS=6
SET TIUAU=$EXTRACT($$EXTERNAL^DILFD(8925,1202,"",TIUAU),1,13)
WRITE ?104,TIUAU
+30 ;W ?102,$S((TIUS=5)&(TIUECS]""):TIUECS,TIUS=6:TIUAU,1:"")
+31 WRITE ?119,$$PRNT(TIUDA)
End DoDot:1
+32 QUIT
ASK ; End of page
+1 IF IO=IO(0)
IF $EXTRACT(IOST)="C"
Begin DoDot:1
+2 WRITE !
NEW DIR,Y
SET DIR(0)="E"
DO ^DIR
KILL DIR
+3 IF Y=""!(Y=0)
SET TIUOUT=1
End DoDot:1
+4 QUIT
HDR(TIUIFP,TIUSTDT,TIUENDT) ; Page (Division) Header
+1 ; Input -- TIUIFP INSTITUTION file (#4) IEN
+2 ; TIUSTDT Start Date
+3 ; TIUENDT End Date
+4 ; Output -- None
+5 NEW LNE,TIUR,TIUINST,TIURNG
+6 SET TIUPG=(+$GET(TIUPG))+1
+7 DO DT^DILF("ET","NOW",.TIUR)
+8 SET TIURNG=$$FMTE^XLFDT(TIUSTDT)_" thru "_$$FMTE^XLFDT(TIUENDT)
+9 SET TIUINST=$SELECT(TIUIFP:$PIECE($$NS^XUAF4(TIUIFP),U),1:"ALL DIVISIONS")
+10 WRITE @IOF,?26,"Unsigned and Uncosigned Documents "_TIURNG,?(IOM-10)
+11 WRITE "Page ",+$GET(TIUPG),!,"PRINTED:",?26,"for ",TIUINST,!,TIUR(0)
+12 WRITE !
SET LNE=""
SET $PIECE(LNE,"-",(IOM-1))=""
WRITE LNE
+13 IF TIURPT="F"
Begin DoDot:1
+14 WRITE !,"AUTHOR/EXP COS",?17,"PATIENT",?25,"LAST4",?39,"STATUS"
+15 WRITE ?50,"ENTRY DT",?60,"IEN",?74,"DOC TYPE"
+16 WRITE ?91,"EXP COSGNR",?104,"AUTHOR",?119,"PARENT IEN",!,LNE
End DoDot:1
+17 QUIT
FHDR(TIUSVC) ; Service Header
+1 ; Input -- TIUSVC SERVICE/SECTION file (#49) NAME
+2 ; Output -- None
+3 WRITE !!?10,"SERVICE: ",TIUSVC
+4 QUIT
PRNT(TIUDA) ; Does document have a parent?
+1 ; Input -- TIUDA TIU Document file (#8925) IEN
+2 ; Output -- TIUPRNT Null= TIU Document file (#8925) entry does
+3 ; not have a parent
+4 ; Exists= TIU Document file (#8925) entry is
+5 ; an addendum or ID child.
+6 ; Value: Parent TIU Document file
+7 ; (#8925) IEN
+8 NEW ADDMPRNT,IDPRNT,TIUPRNT
+9 SET TIUPRNT=""
+10 ; Addm parent
SET ADDMPRNT=+$PIECE($GET(^TIU(8925,TIUDA,0)),U,6)
+11 IF '$DATA(^TIU(8925,ADDMPRNT,0))
SET ADDMPRNT=0
+12 IF ADDMPRNT
Begin DoDot:1
+13 SET TIUPRNT=ADDMPRNT
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 ; ID parent
SET IDPRNT=+$GET(^TIU(8925,TIUDA,21))
+16 IF '$DATA(^TIU(8925,IDPRNT,0))
SET IDPRNT=0
+17 IF IDPRNT
Begin DoDot:2
+18 SET TIUPRNT=IDPRNT
End DoDot:2
End DoDot:1
+19 QUIT TIUPRNT
+20 ;
ASKRNG(STDT,ENDT) ;Prompt for entry date range
+1 ; Input -- None
+2 ; Output -- 1=Successful and 0=Failure
+3 ; STDT Start Date
+4 ; ENDT End Date
+5 NEW DIRUT,DTOUT,DUOUT,Y
+6 WRITE !!,"Please specify an Entry Date Range:",!
+7 SET STDT=+$$READ^TIUU("DA^:DT:E"," Start Entry Date: ")
+8 IF $DATA(DIRUT)!(STDT'>0)
GOTO ASKRNGQ
+9 SET ENDT=+$$READ^TIUU("DA^"_STDT_":DT:E","Ending Entry Date: ")_"."_235959
+10 IF $DATA(DIRUT)!(ENDT'>0)
GOTO ASKRNGQ
+11 SET Y=1
ASKRNGQ QUIT +$GET(Y)
