Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIURDIV

TIURDIV.m

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