- 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 Jan 18, 2025@03:46:21 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)