- TIUASRPT ; SLC/JMH - Review unsigned additional signer Documents by DIVISION ; [12/2/04 11:50am]
- ;;1.0;TEXT INTEGRATION UTILITIES;**157**;Jun 20, 1997
- 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
- ;
- DEV ; Device selection
- I TIURPT="F" D
- . W !!,"This report should be sent to a 132 Column Device"
- S %ZIS="Q" W ! D ^%ZIS I POP K POP G EXIT
- I $D(IO("Q")) D G EXIT
- . S ZTRTN="BUILD^TIUASRPT"
- . S ZTSAVE("TIUDI(")="",ZTSAVE("TIURPT")=""
- . S ZTSAVE("TIUSTDT")="",ZTSAVE("TIUENDT")=""
- . S ZTSAVE("TIUSVCS")="",ZTSAVE("TIUSVCS(")=""
- . S ZTDESC="TIU PENDING ADD. SIGNATURES 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
- ;
- 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=TIUSTDT
- F S TIUTP=$O(^TIU(8925.7,"AC",TIUTP)) Q:'TIUTP!(TIUTP>(TIUENDT+1)) D
- . N TIUIEN S TIUIEN=0
- . F S TIUIEN=$O(^TIU(8925.7,"AC",TIUTP,TIUIEN)) Q:'TIUIEN D
- . . I $P($G(^TIU(8925,TIUIEN,12)),U,12)'=TIUIFP Q
- . . D ADDELMNT(TIUIEN,.TIUSVCS)
- Q
- ;
- ADDELMNT(TIUDA,TIUSVCS) ; Add each element to the list
- ; Input -- TIUDA TIU DOCUMENT file (#8925) IEN
- ; TIUSVCS Service Selection Array
- ; Output -- None
- N TIUASREC,TIUSVC,TIUEDT,TIUD12,TIUIFP,TIUSTAT
- S TIUSTAT=$P($G(^TIU(8925,TIUDA,0)),U,5)
- I TIUSTAT>8 Q
- S TIUASREC=0
- S TIUD12=$G(^TIU(8925,TIUDA,12))
- S TIUEDT=+$P(TIUD12,U),TIUIFP=+$P(TIUD12,U,12)
- F S TIUASREC=$O(^TIU(8925.7,"B",TIUDA,TIUASREC)) Q:'TIUASREC D
- . N TIUAS,TIUASSVC
- . S TIUAS=$P(^TIU(8925.7,TIUASREC,0),U,3)
- . I 'TIUAS!$P(^TIU(8925.7,TIUASREC,0),U,4) Q
- . S TIUASSVC=$$PROVSVC^TIULV(TIUAS)
- . I $G(TIUSVCS)="ALL"!($D(TIUSVCS(+TIUASSVC))) D
- . . S TIUAS=$$PERSNAME^TIULC1(TIUAS)
- . . I $P(TIUASSVC,U,2)]"" S TIUASSVC=$P(TIUASSVC,U,2)
- . . E S TIUASSVC="UNKNOWN"
- . . I TIUAS'="UNKNOWN" S TIUAS=$$NAME^TIULS(TIUAS,"LAST, FI MI")
- . . S ^TMP("TIUD",$J,TIUIFP,TIUASSVC,TIUAS,TIUEDT)=TIUDA
- 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)
- DHDR(TIUFP,TIUSTDT,TIUENDT) ;
- ;DIVISION HEADER
- N TIUR,TIURNG,TIUINST
- 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,"Pending Additional Signature Documents for "_TIUINST
- W " on "_$$FMTE^XLFDT($$NOW^XLFDT)
- W !,?10,TIURNG,?70,"Page: "_+$G(TIUPG)
- I TIURPT'="F" D
- . W !,"------------------------------------------------------------------------------"
- I TIURPT="F" D
- . W !,"------------------------------------------------------------------------------------------------------------------------------------"
- . W !,"IDENT. SIGNER",?17,"PATIENT",?27,"STATUS",?35,"ENTRY DATE"
- . W ?54,"DOCUMENT TITLE",?81,"DOCUMENT IEN"
- . W !,"------------------------------------------------------------------------------------------------------------------------------------"
- Q
- SHDR(TIUSVC) ;
- ; SERVICE HEADER
- W !!?10,"SERVICE: ",TIUSVC
- Q
- PRINT ;
- N TIUPG,TIUIFP,TIUOUT,TIUTOT
- S (TIUPG,TIUIFP,TIUOUT,TIUTOT)=0
- F S TIUIFP=$O(^TMP("TIUD",$J,TIUIFP)) Q:'TIUIFP!(TIUOUT) D
- . N TIUSVC,TIUDCNT
- . S (TIUSVC,TIUDCNT)=0
- . D DHDR(TIUIFP,TIUSTDT,TIUENDT)
- . F S TIUSVC=$O(^TMP("TIUD",$J,TIUIFP,TIUSVC)) Q:TIUSVC=""!(TIUOUT) D
- . . N TIUAS,TIUSVCNT
- . . S (TIUAS,TIUSVCNT)=0
- . . I $Y>(IOSL-5) D ASK Q:TIUOUT D DHDR(TIUIFP,TIUSTDT,TIUENDT)
- . . I TIURPT="F" D SHDR(TIUSVC)
- . . F S TIUAS=$O(^TMP("TIUD",$J,TIUIFP,TIUSVC,TIUAS)) Q:TIUAS=""!(TIUOUT) D
- . . . N TIUEDT
- . . . S TIUEDT=""
- . . . F S TIUEDT=$O(^TMP("TIUD",$J,TIUIFP,TIUSVC,TIUAS,TIUEDT)) Q:'TIUEDT!(TIUOUT) D
- . . . . N TIUDA
- . . . . S TIUDA=^TMP("TIUD",$J,TIUIFP,TIUSVC,TIUAS,TIUEDT)
- . . . . I TIURPT="F" D PRNTITEM(TIUDA,TIUAS,TIUEDT)
- . . . . I $Y>(IOSL-5) D ASK Q:TIUOUT D DHDR(TIUIFP,TIUSTDT,TIUENDT)
- . . . . S TIUSVCNT=TIUSVCNT+1,TIUDCNT=TIUDCNT+1
- . . W !," Totals for Service ",TIUSVC,": ",?55,TIUSVCNT
- . . I $Y>(IOSL-5) D ASK Q:TIUOUT D DHDR(TIUIFP,TIUSTDT,TIUENDT)
- . Q:TIUOUT
- . N TIUDVSTR S TIUDVSTR=$E($P($$NS^XUAF4(TIUIFP),U),1,25)
- . W !,"Totals for Division ",TIUDVSTR,": ",?55,TIUDCNT
- . I $O(^TMP("TIUD",$J,TIUIFP)) D ASK Q:TIUOUT
- . S TIUTOT=TIUTOT+TIUDCNT
- Q:TIUOUT
- W !,"Totals for all Divisions: ",?55,TIUTOT
- Q
- PRNTITEM(TIUDA,TIUAS,TIUEDT) ;
- N TIUPRNT,TIUPAT,TIUSTAT,TIUTYP,TIUD0,TIUD12,TIULST4,TIUDATE
- S TIUPRNT=$$PRNT(TIUDA)
- S TIUD0=$G(^TIU(8925,TIUDA,0))
- S TIULST4=$E($$GET1^DIQ(2,$G(TIUPAT),.09),6,9)
- S TIUPAT=$$PATPRNT($P($G(TIUD0),U,2))
- S TIUSTAT=$P($G(TIUD0),U,5)
- S TIUSTAT=$S(TIUSTAT:$E($$EXTERNAL^DILFD(8925,.05,"",TIUSTAT),1,11),1:"UNKNOWN")
- S TIUSTAT=$$STATXFER(TIUSTAT)
- S TIUTYP=+TIUD0
- S TIUTYP=$E($P($G(^TIU(8925.1,TIUTYP,0)),U),1,25)
- S TIUDATE=$$FMTE^XLFDT(TIUEDT,2)
- W !,TIUAS,?17,$G(TIUPAT),?27," "_TIUSTAT,?35,$G(TIUDATE)
- W ?54,$G(TIUTYP),?81,TIUDA
- I +$G(TIUPRNT) W " PARENT = "_TIUPRNT
- Q
- ASK ;
- 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
- STATXFER(TIUSTAT) ;format a small status string
- I TIUSTAT="COMPLETED"!(TIUSTAT="completed") Q "com"
- I TIUSTAT="UNSIGNED"!(TIUSTAT="unsigned") Q "uns"
- I TIUSTAT="UNCOSIGNED"!(TIUSTAT="uncosigned") Q "uncos"
- I TIUSTAT="UNDICTATED"!(TIUSTAT="undictated") Q "undic"
- I TIUSTAT="UNTRANSCRIBED"!(TIUSTAT="untranscribed") Q "untr"
- I TIUSTAT="UNRELEASED"!(TIUSTAT="unreleased") Q "unrel"
- I TIUSTAT="UNVERIFIED"!(TIUSTAT="unverified") Q "unver"
- I TIUSTAT="AMENDED"!(TIUSTAT="amended") Q "amend"
- Q "???"
- PATPRNT(TIUPAT) ; format patient as initials and then last 6 SSN
- N PAT,LST4,INIT
- I 'TIUPAT Q ""
- S PAT=$$EXTERNAL^DILFD(8925,.02,"",TIUPAT)
- S LST4=$E($$GET1^DIQ(2,$G(TIUPAT),.09),4,9)
- S INIT=$E($P(PAT,",",2))_$E($P(PAT,","))
- Q INIT_LST4
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUASRPT 8586 printed Feb 19, 2025@00:05:24 Page 2
- TIUASRPT ; SLC/JMH - Review unsigned additional signer Documents by DIVISION ; [12/2/04 11:50am]
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**157**;Jun 20, 1997
- 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
- +22 ;
- DEV ; Device selection
- +1 IF TIURPT="F"
- Begin DoDot:1
- +2 WRITE !!,"This report should be sent to a 132 Column Device"
- End DoDot:1
- +3 SET %ZIS="Q"
- WRITE !
- DO ^%ZIS
- IF POP
- KILL POP
- GOTO EXIT
- +4 IF $DATA(IO("Q"))
- Begin DoDot:1
- +5 SET ZTRTN="BUILD^TIUASRPT"
- +6 SET ZTSAVE("TIUDI(")=""
- SET ZTSAVE("TIURPT")=""
- +7 SET ZTSAVE("TIUSTDT")=""
- SET ZTSAVE("TIUENDT")=""
- +8 SET ZTSAVE("TIUSVCS")=""
- SET ZTSAVE("TIUSVCS(")=""
- +9 SET ZTDESC="TIU PENDING ADD. SIGNATURES BY DIV"
- +10 DO ^%ZTLOAD
- WRITE !,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Cancelled!")
- +11 KILL ZTSK,ZTDESC,ZTRTN,ZTSAVE,%ZIS,TIUDIV,TIURPT,TIUIFP
- +12 DO HOME^%ZIS
- End DoDot:1
- GOTO EXIT
- +13 USE IO
- DO BUILD
- DO ^%ZISC
- +14 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
- +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=TIUSTDT
- +9 FOR
- SET TIUTP=$ORDER(^TIU(8925.7,"AC",TIUTP))
- if 'TIUTP!(TIUTP>(TIUENDT+1))
- QUIT
- Begin DoDot:1
- +10 NEW TIUIEN
- SET TIUIEN=0
- +11 FOR
- SET TIUIEN=$ORDER(^TIU(8925.7,"AC",TIUTP,TIUIEN))
- if 'TIUIEN
- QUIT
- Begin DoDot:2
- +12 IF $PIECE($GET(^TIU(8925,TIUIEN,12)),U,12)'=TIUIFP
- QUIT
- +13 DO ADDELMNT(TIUIEN,.TIUSVCS)
- End DoDot:2
- End DoDot:1
- +14 QUIT
- +15 ;
- ADDELMNT(TIUDA,TIUSVCS) ; Add each element to the list
- +1 ; Input -- TIUDA TIU DOCUMENT file (#8925) IEN
- +2 ; TIUSVCS Service Selection Array
- +3 ; Output -- None
- +4 NEW TIUASREC,TIUSVC,TIUEDT,TIUD12,TIUIFP,TIUSTAT
- +5 SET TIUSTAT=$PIECE($GET(^TIU(8925,TIUDA,0)),U,5)
- +6 IF TIUSTAT>8
- QUIT
- +7 SET TIUASREC=0
- +8 SET TIUD12=$GET(^TIU(8925,TIUDA,12))
- +9 SET TIUEDT=+$PIECE(TIUD12,U)
- SET TIUIFP=+$PIECE(TIUD12,U,12)
- +10 FOR
- SET TIUASREC=$ORDER(^TIU(8925.7,"B",TIUDA,TIUASREC))
- if 'TIUASREC
- QUIT
- Begin DoDot:1
- +11 NEW TIUAS,TIUASSVC
- +12 SET TIUAS=$PIECE(^TIU(8925.7,TIUASREC,0),U,3)
- +13 IF 'TIUAS!$PIECE(^TIU(8925.7,TIUASREC,0),U,4)
- QUIT
- +14 SET TIUASSVC=$$PROVSVC^TIULV(TIUAS)
- +15 IF $GET(TIUSVCS)="ALL"!($DATA(TIUSVCS(+TIUASSVC)))
- Begin DoDot:2
- +16 SET TIUAS=$$PERSNAME^TIULC1(TIUAS)
- +17 IF $PIECE(TIUASSVC,U,2)]""
- SET TIUASSVC=$PIECE(TIUASSVC,U,2)
- +18 IF '$TEST
- SET TIUASSVC="UNKNOWN"
- +19 IF TIUAS'="UNKNOWN"
- SET TIUAS=$$NAME^TIULS(TIUAS,"LAST, FI MI")
- +20 SET ^TMP("TIUD",$JOB,TIUIFP,TIUASSVC,TIUAS,TIUEDT)=TIUDA
- End DoDot:2
- End DoDot:1
- +21 QUIT
- +22 ;
- 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)
- DHDR(TIUFP,TIUSTDT,TIUENDT) ;
- +1 ;DIVISION HEADER
- +2 NEW TIUR,TIURNG,TIUINST
- +3 SET TIUPG=(+$GET(TIUPG))+1
- +4 DO DT^DILF("ET","NOW",.TIUR)
- +5 SET TIURNG=$$FMTE^XLFDT(TIUSTDT)_" thru "_$$FMTE^XLFDT(TIUENDT)
- +6 SET TIUINST=$SELECT(TIUIFP:$PIECE($$NS^XUAF4(TIUIFP),U),1:"ALL DIVISIONS")
- +7 WRITE @IOF,"Pending Additional Signature Documents for "_TIUINST
- +8 WRITE " on "_$$FMTE^XLFDT($$NOW^XLFDT)
- +9 WRITE !,?10,TIURNG,?70,"Page: "_+$GET(TIUPG)
- +10 IF TIURPT'="F"
- Begin DoDot:1
- +11 WRITE !,"------------------------------------------------------------------------------"
- End DoDot:1
- +12 IF TIURPT="F"
- Begin DoDot:1
- +13 WRITE !,"------------------------------------------------------------------------------------------------------------------------------------"
- +14 WRITE !,"IDENT. SIGNER",?17,"PATIENT",?27,"STATUS",?35,"ENTRY DATE"
- +15 WRITE ?54,"DOCUMENT TITLE",?81,"DOCUMENT IEN"
- +16 WRITE !,"------------------------------------------------------------------------------------------------------------------------------------"
- End DoDot:1
- +17 QUIT
- SHDR(TIUSVC) ;
- +1 ; SERVICE HEADER
- +2 WRITE !!?10,"SERVICE: ",TIUSVC
- +3 QUIT
- PRINT ;
- +1 NEW TIUPG,TIUIFP,TIUOUT,TIUTOT
- +2 SET (TIUPG,TIUIFP,TIUOUT,TIUTOT)=0
- +3 FOR
- SET TIUIFP=$ORDER(^TMP("TIUD",$JOB,TIUIFP))
- if 'TIUIFP!(TIUOUT)
- QUIT
- Begin DoDot:1
- +4 NEW TIUSVC,TIUDCNT
- +5 SET (TIUSVC,TIUDCNT)=0
- +6 DO DHDR(TIUIFP,TIUSTDT,TIUENDT)
- +7 FOR
- SET TIUSVC=$ORDER(^TMP("TIUD",$JOB,TIUIFP,TIUSVC))
- if TIUSVC=""!(TIUOUT)
- QUIT
- Begin DoDot:2
- +8 NEW TIUAS,TIUSVCNT
- +9 SET (TIUAS,TIUSVCNT)=0
- +10 IF $Y>(IOSL-5)
- DO ASK
- if TIUOUT
- QUIT
- DO DHDR(TIUIFP,TIUSTDT,TIUENDT)
- +11 IF TIURPT="F"
- DO SHDR(TIUSVC)
- +12 FOR
- SET TIUAS=$ORDER(^TMP("TIUD",$JOB,TIUIFP,TIUSVC,TIUAS))
- if TIUAS=""!(TIUOUT)
- QUIT
- Begin DoDot:3
- +13 NEW TIUEDT
- +14 SET TIUEDT=""
- +15 FOR
- SET TIUEDT=$ORDER(^TMP("TIUD",$JOB,TIUIFP,TIUSVC,TIUAS,TIUEDT))
- if 'TIUEDT!(TIUOUT)
- QUIT
- Begin DoDot:4
- +16 NEW TIUDA
- +17 SET TIUDA=^TMP("TIUD",$JOB,TIUIFP,TIUSVC,TIUAS,TIUEDT)
- +18 IF TIURPT="F"
- DO PRNTITEM(TIUDA,TIUAS,TIUEDT)
- +19 IF $Y>(IOSL-5)
- DO ASK
- if TIUOUT
- QUIT
- DO DHDR(TIUIFP,TIUSTDT,TIUENDT)
- +20 SET TIUSVCNT=TIUSVCNT+1
- SET TIUDCNT=TIUDCNT+1
- End DoDot:4
- End DoDot:3
- +21 WRITE !," Totals for Service ",TIUSVC,": ",?55,TIUSVCNT
- +22 IF $Y>(IOSL-5)
- DO ASK
- if TIUOUT
- QUIT
- DO DHDR(TIUIFP,TIUSTDT,TIUENDT)
- End DoDot:2
- +23 if TIUOUT
- QUIT
- +24 NEW TIUDVSTR
- SET TIUDVSTR=$EXTRACT($PIECE($$NS^XUAF4(TIUIFP),U),1,25)
- +25 WRITE !,"Totals for Division ",TIUDVSTR,": ",?55,TIUDCNT
- +26 IF $ORDER(^TMP("TIUD",$JOB,TIUIFP))
- DO ASK
- if TIUOUT
- QUIT
- +27 SET TIUTOT=TIUTOT+TIUDCNT
- End DoDot:1
- +28 if TIUOUT
- QUIT
- +29 WRITE !,"Totals for all Divisions: ",?55,TIUTOT
- +30 QUIT
- PRNTITEM(TIUDA,TIUAS,TIUEDT) ;
- +1 NEW TIUPRNT,TIUPAT,TIUSTAT,TIUTYP,TIUD0,TIUD12,TIULST4,TIUDATE
- +2 SET TIUPRNT=$$PRNT(TIUDA)
- +3 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
- +4 SET TIULST4=$EXTRACT($$GET1^DIQ(2,$GET(TIUPAT),.09),6,9)
- +5 SET TIUPAT=$$PATPRNT($PIECE($GET(TIUD0),U,2))
- +6 SET TIUSTAT=$PIECE($GET(TIUD0),U,5)
- +7 SET TIUSTAT=$SELECT(TIUSTAT:$EXTRACT($$EXTERNAL^DILFD(8925,.05,"",TIUSTAT),1,11),1:"UNKNOWN")
- +8 SET TIUSTAT=$$STATXFER(TIUSTAT)
- +9 SET TIUTYP=+TIUD0
- +10 SET TIUTYP=$EXTRACT($PIECE($GET(^TIU(8925.1,TIUTYP,0)),U),1,25)
- +11 SET TIUDATE=$$FMTE^XLFDT(TIUEDT,2)
- +12 WRITE !,TIUAS,?17,$GET(TIUPAT),?27," "_TIUSTAT,?35,$GET(TIUDATE)
- +13 WRITE ?54,$GET(TIUTYP),?81,TIUDA
- +14 IF +$GET(TIUPRNT)
- WRITE " PARENT = "_TIUPRNT
- +15 QUIT
- ASK ;
- +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
- STATXFER(TIUSTAT) ;format a small status string
- +1 IF TIUSTAT="COMPLETED"!(TIUSTAT="completed")
- QUIT "com"
- +2 IF TIUSTAT="UNSIGNED"!(TIUSTAT="unsigned")
- QUIT "uns"
- +3 IF TIUSTAT="UNCOSIGNED"!(TIUSTAT="uncosigned")
- QUIT "uncos"
- +4 IF TIUSTAT="UNDICTATED"!(TIUSTAT="undictated")
- QUIT "undic"
- +5 IF TIUSTAT="UNTRANSCRIBED"!(TIUSTAT="untranscribed")
- QUIT "untr"
- +6 IF TIUSTAT="UNRELEASED"!(TIUSTAT="unreleased")
- QUIT "unrel"
- +7 IF TIUSTAT="UNVERIFIED"!(TIUSTAT="unverified")
- QUIT "unver"
- +8 IF TIUSTAT="AMENDED"!(TIUSTAT="amended")
- QUIT "amend"
- +9 QUIT "???"
- PATPRNT(TIUPAT) ; format patient as initials and then last 6 SSN
- +1 NEW PAT,LST4,INIT
- +2 IF 'TIUPAT
- QUIT ""
- +3 SET PAT=$$EXTERNAL^DILFD(8925,.02,"",TIUPAT)
- +4 SET LST4=$EXTRACT($$GET1^DIQ(2,$GET(TIUPAT),.09),4,9)
- +5 SET INIT=$EXTRACT($PIECE(PAT,",",2))_$EXTRACT($PIECE(PAT,","))
- +6 QUIT INIT_LST4