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

BTIUDSC.m

Go to the documentation of this file. 
  1. BTIUDSC ; IHS/ITSC/LJF - DICTATION COUNTS ;15-Jul-2013 09:58;DU
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**1011**;NOV 04, 2004;Build 13
  1.  ;
  1.  ;
  1.  D ^XBCLS
  1.  S Y=$$READ^TIUU("SO^1:DISCHARGE SUMMARY DICTATIONS;2:OPERATIVE REPORT DICTATIONS","Select REPORT TYPE") Q:'Y
  1.  I +Y=2 D ^BTIUDOC Q
  1.  ;
  1.  NEW TIUEDT,TIUBDT
  1.  S TIUBDT=$$EDATE^TIULA("Discharge",""," ") Q:TIUBDT<1
  1.  S TIUEDT=$$LDATE^TIULA("Discharge",""," ") Q:TIUEDT<1
  1.  D ZIS^BTIUU("PQ","EN^BTIUDSC","DSUM DICT COUNTS","TIUBDT;TIUEDT")
  1.  Q
  1.  ;
  1. EN ; -- main entry point for BTIU DSUM COUNTS
  1.  NEW VALMCNT
  1.  I IOST'["C-" D GATHER(TIUBDT,TIUEDT),PRINT Q
  1.  D TERM^VALM0
  1.  D EN^VALM("BTIU IC DICT STATUS")
  1.  Q
  1.  ;
  1. HDR ;EP; -- header code
  1.  Q
  1.  ;
  1. INIT ;EP; -- init variables and list array
  1.  NEW TIULN
  1.  D MSG^BTIUU("Building/Updating Display. . .Please wait.",2,0,0)
  1.  D GATHER(TIUBDT,TIUEDT)
  1.  S VALMCNT=TIULN
  1.  Q
  1.  ;
  1. INIT2 ;EP; -- init variables and list array
  1.  NEW TIULN
  1.  S VALMCNT=+$O(^TMP("BTIUDSC",$J,""),-1)
  1.  Q
  1.  ;
  1. HELP ;EP; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ;EP; -- exit code
  1.  K VALMCNT
  1.  K ^TMP("BTIUDSC",$J),^TMP("BTIUDSC2",$J)
  1.  Q
  1.  ;
  1. EXIT2 ;EP; -- exit code for patient listing
  1.  K VALMCNT Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. GATHER(TIUBDT,TIUEDT) ; -- create display array
  1.  NEW X,TIUCNT,TIUCD,DFN,DSC,IEN,CD,DSCH,LINE,TIUN,TIUSRV,D,N,X,P,DDATE,DAYS,END,I,S
  1.  K ^TMP("BTIUDSC",$J),^TMP("BTIUDSC1",$J),^TMP("BTIUDSC2",$J)
  1.  K ^TMP("BTIUDSC3",$J)
  1.  S (TIUCNT,TIULN)=0
  1.  S DDATE=TIUBDT-.0001,END=TIUEDT+.2400
  1.  F  S DDATE=$O(^DGPM("ATT3",DDATE)) Q:'DDATE!(DDATE>END)  D
  1.  . S IEN=0 F  S IEN=$O(^DGPM("ATT3",DDATE,IEN)) Q:'IEN  D
  1.  .. S DFN=$P(^DGPM(IEN,0),U,3),TIUCA=$P(^DGPM(IEN,0),U,14)
  1.  .. S TIUDSDT=+^DGPM(IEN,0),TIUADDT=+^DGPM(TIUCA,0)
  1.  .. Q:TIUDSDT=""
  1.  .. S TIUVST=$$GET1^DIQ(405,TIUCA,.27,"I") I TIUVST<1 D ERR(1) Q
  1.  .. S TIUSRV=$$DSRV(TIUCA) Q:TIUSRV["OBSERVATION"
  1.  .. Q:TIUSRV=""
  1.  .. S DAYS=$S(TIUSRV="NEWBORN":5,1:3)               ;anmc parameter for req dis summ
  1.  .. I $$FMDIFF^XLFDT(TIUDSDT,TIUADDT,1)<DAYS Q      ;LOS<3 or 4 or 5 days
  1.  .. ;
  1.  .. NEW TIUDICT,TIUAUTH
  1.  .. S TIU=0,TIUAUTH="",TIUDICT=""
  1.  .. F  S TIU=$O(^TIU(8925,"V",TIUVST,TIU)) Q:'TIU!($G(TIUDICT))  D
  1.  ... I '$$CLASS(+$G(^TIU(8925,TIU,0))) Q      ;not dsum
  1.  ... S TIUDICT=$$GET1^DIQ(8925,TIU,1307,"I")  ;dictation date
  1.  ... S TIUAUTH=$$GET1^DIQ(8925,TIU,1202)      ;dictated by
  1.  ..  S LINE=$$DATA(DFN,TIUDSDT,$G(TIUDICT))    ;create display line
  1.  ..  I LINE'="" S ^TMP("BTIUDSC3",$J,TIUSRV,TIUDSDT,IEN)=LINE
  1.  .. D TOT(TIUSRV,$$DPRV(TIUCA,TIUAUTH),TIUDSDT,TIUDICT)
  1.  ;
  1.  ; -- put listing in order by service and dsch date
  1.  S TIULN=0,S=0 F  S S=$O(^TMP("BTIUDSC3",$J,S)) Q:S=""  D
  1.  . D SET("",.TIULN),SET("SERVICE:  "_S,.TIULN)
  1.  . S D=0 F  S D=$O(^TMP("BTIUDSC3",$J,S,D)) Q:D=""  D
  1.  .. S N=0 F  S N=$O(^TMP("BTIUDSC3",$J,S,D,N)) Q:'N  D
  1.  ... S X=^TMP("BTIUDSC3",$J,S,D,N) D SET(X,.TIULN)
  1.  ;
  1.  ; -- put totals in order by service and provider
  1.  NEW TOTAL S TOTAL=0
  1.  S TIULN=0,S=0 F  S S=$O(^TMP("BTIUDSC1",$J,S)) Q:S=""  D
  1.  . S X=^TMP("BTIUDSC1",$J,S),LINE=$$LINE2(S,"",X)
  1.  . D TOTL(X,.TOTAL)  ;increment grand total
  1.  . D SET2("",.TIULN),SET2(LINE,.TIULN)
  1.  . S P=0 F  S P=$O(^TMP("BTIUDSC1",$J,S,P)) Q:P=""  D
  1.  .. S X=^TMP("BTIUDSC1",$J,S,P),LINE=$$LINE2("",P,X) D SET2(LINE,.TIULN)
  1.  ;
  1.  S LINE=$$REPEAT^XLFSTR("=",79) D SET2("",.TIULN),SET2(LINE,.TIULN)
  1.  S LINE=$$LINE2("GRAND TOTAL","",TOTAL) D SET2(LINE,.TIULN)
  1.  S LINE=$$LINE3(TOTAL) D SET2(LINE,.TIULN),SET2("",.TIULN)
  1.  K ^TMP("BTIUDSC1",$J),^TMP("BTIUDSC3",$J)
  1.  Q
  1.  ;
  1.  ;
  1. DATA(DFN,DSDT,DICT) ; -- returns display line
  1.  NEW X,TIUY
  1.  ;S TIUCNT=TIUCNT+1,TIUY=$J(TIUCNT,3)
  1.  S TIUY=$$PAD($$PAT(DFN),27)_"  "
  1.  S TIUY=TIUY_$$PAD($$DPRV(TIUCA,TIUAUTH),15)
  1.  S TIUY=TIUY_$$PAD($J($$FMTE^XLFDT(DSDT,"2D"),10),12)
  1.  S TIUY=TIUY_$$PAD($J($$FMTE^XLFDT(DICT,"2"),10),13)
  1.  S TIUY=TIUY_$$STATUS(DICT\1,DSDT)
  1.  Q TIUY
  1.  ;
  1. PAT(DFN) ; -- returns patient chart # and last name
  1.  NEW X,Y
  1.  S X=$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
  1.  S Y=$P($G(^DPT(DFN,0)),U)
  1.  Q $J(X,7)_"  "_$E(Y,1,18)
  1.  ;
  1. STATUS(DICT,DSCH) ; -- returns whether dictated on time or not
  1.  I +DICT=0 Q "NOT DONE"
  1.  I DICT'>DSCH Q "ON TIME"
  1.  Q "LATE"
  1.  ;
  1. CLASS(TYPE) ; -- returns 1 if doc is in dsch summ dic class (244)
  1.  I $$GET1^DIQ(8925.1,TYPE,.01)="ADDENDUM" S TYPE=$$GET1^DIQ(8925,IEN,.04,"I")
  1.  I $$DOCCLASS^TIULC1(TYPE)=244 Q 1
  1.  Q 0
  1.  ;
  1. DSRV(CA) ; -- discharge service
  1.  I $L($T(^BDGF1)) Q $$LASTSRVN^BDGF1(CA,DFN)    ;PIMS V5.3
  1.  NEW X,Y
  1.  S Y=9999999.9999999-$G(^DGPM(+$P(^DGPM(CA,0),U,17),0)) Q:'Y 0
  1.  S X=$O(^DGPM("ATID6",+DFN,+$O(^DGPM("ATID6",+DFN,Y)),0))
  1.  S X=$P($G(^DGPM(+X,0)),U,9)
  1.  Q $$GET1^DIQ(45.7,X,.01)
  1.  ;
  1. DPRV(CA,AUTH) ; -- discharge provider
  1.  I AUTH]"" Q AUTH
  1.  I $L($T(^BDGF1)) Q $$LASTPRV^BDGF1(CA,DFN,"")  ;PIMS V5.3
  1.  NEW W,X,Y,Z,AP
  1.  S X="",Y=0 F  S Y=$O(^DGPM("ATS",DFN,TIUCA,Y)) Q:'Y!(X]"")  D
  1.  . S Z=0 F  S Z=$O(^DGPM("ATS",DFN,TIUCA,Y,Z)) Q:'Z!(X]"")  D
  1.  .. S W=0 F  S W=$O(^DGPM("ATS",DFN,TIUCA,Y,Z,W)) Q:'W!(X]"")  D
  1.  ... S X=$$GET1^DIQ(405,W,.19)             ;attending
  1.  ... I X="" S AP=$$GET1^DIQ(405,W,.08)     ;admitting
  1.  I X="" S X=$S($G(AP)]"":AP,1:"??")
  1.  Q X
  1.  ;
  1.  ;
  1. SET(LINE,TIULN) ; -- sets ^tmp
  1.  S TIULN=TIULN+1
  1.  S ^TMP("BTIUDSC",$J,TIULN,0)=LINE
  1.  Q
  1.  ;
  1. SET2(LINE,TIULN) ; -- sets ^tmp
  1.  S TIULN=TIULN+1
  1.  S ^TMP("BTIUDSC2",$J,TIULN,0)=LINE
  1.  Q
  1.  ;
  1. PRINT ; -- print lists to paper
  1.  NEW TIUX,TIUL,TIUPG
  1.  U IO D INIT^BTIUU
  1.  F TIUX="BTIUDSC2","BTIUDSC" D
  1.  . D HDG
  1.  . S TIUL=0 F  S TIUL=$O(^TMP(TIUX,$J,TIUL)) Q:'TIUL  D
  1.  .. I $Y>(IOSL-4) D HDG
  1.  .. W !,^TMP(TIUX,$J,TIUL,0)
  1.  D ^%ZISC,PRTKL^BTIUU,EXIT
  1.  Q
  1.  ;
  1. HDG ; -- prints 2nd half of heading
  1.  S TIUPG=$G(TIUPG)+1 I TIUPG>1 W @IOF
  1.  W !,TIUTIME,?16,$$CONFID^BTIUU,?71,"Page: ",TIUPG
  1.  W !,TIUDATE,?24,"DISCHARGE SUMMARY DICTATION STATISTICS",?76,TIUUSR
  1.  W !?($L(TIUFAC\2)),TIUFAC,!,$$REPEAT^XLFSTR("-",80)
  1.  ;
  1.  I TIUX="BTIUDSC2" S X=" Service"_$$SP(13)_"Provider"_$$SP(12)_"#DSCH  Dict:  On Time  Late  Not Done"
  1.  E  S X="  HRCN   Patient Name"_$$SP(8)_"Provider"_$$SP(5)_"Dschargd   Dictated    Status"
  1.  W !,X,!,$$REPEAT^XLFSTR("=",80)
  1.  Q
  1.  ;
  1. TOT(SRV,PRV,DSC,DICT) ; -- increment ^tmp for totals
  1.  NEW X,Y
  1.  S X=$G(^TMP("BTIUDSC1",$J,SRV,PRV)),Y=$G(^TMP("BTIUDSC1",$J,SRV))
  1.  D INCREM
  1.  S ^TMP("BTIUDSC1",$J,SRV)=Y,^TMP("BTIUDSC1",$J,SRV,PRV)=X
  1.  Q
  1.  ;
  1. TOTL(DATA,TOTAL) ; increment grand total
  1.  F I=1:1:4 S $P(TOTAL,U,I)=$P(TOTAL,U,I)+$P(DATA,U,I)
  1.  Q
  1.  ;
  1. INCREM ; -- increment # discharges,dictated on time, late or not at all
  1.  S $P(X,U)=$P(X,U)+1,$P(Y,U)=$P(Y,U)+1  ;total dsch
  1.  I DICT="" S $P(X,U,4)=$P(X,U,4)+1,$P(Y,U,4)=$P(Y,U,4)+1 Q    ;not dict
  1.  I DICT'>DSC S $P(X,U,2)=$P(X,U,2)+1,$P(Y,U,2)=$P(Y,U,2)+1 Q  ;on time
  1.  S $P(X,U,3)=$P(X,U,3)+1,$P(Y,U,3)=$P(Y,U,3)+1                ;dict late
  1.  Q
  1.  ;
  1. LINE2(SRV,PRV,DATA) ; -- sets up display line for totals
  1.  NEW X
  1.  S X=" "_$$PAD(SRV,18)_"  "_$$PAD($E(PRV,1,18),21)
  1.  S X=X_$$PAD($J($P(DATA,U),3),15)_$$PAD($J($P(DATA,U,2),3),7)
  1.  S X=X_$$PAD($J($P(DATA,U,3),3),7)_$J($P(DATA,U,4),3)
  1.  Q X
  1.  ;
  1. LINE3(DATA) ; -- sets up display line for totals
  1.  NEW X,T,OT,LT,ND
  1.  S T=$P(DATA,U) I 'T S (OT,LT,ND)=0
  1.  E  S OT=$P(DATA,U,2)/T*100,LT=$P(DATA,U,3)/T*100,ND=$P(DATA,U,4)/T*100
  1.  S X=$$SP(57)_$$PAD($J(OT,3,0)_"%",7)
  1.  S X=X_$$PAD($J(LT,3,0)_"%",7)_$J(ND,3,0)_"%"
  1.  Q X
  1.  ;
  1. GETIC ; -- select item from list
  1.  NEW X,Y,Z,VALMY
  1.  D FULL^VALM1
  1.  S TIUICN=0
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  I '$D(VALMY) Q
  1.  S X=$O(VALMY(0))
  1.  S Y=0 F  S Y=$O(^TMP("TIUZICL",$J,"IDX",Y)) Q:Y=""  Q:TIUICN>0  D
  1.  . S Z=$O(^TMP("TIUZICL",$J,"IDX",Y,0))
  1.  . Q:^TMP("TIUZICL",$J,"IDX",Y,Z)=""
  1.  . I Z=X S TIUICN=^TMP("TIUZICL",$J,"IDX",Y,Z)
  1.  Q
  1.  ;
  1. ICE ;EP; -- action to edit IC file
  1.  NEW TIUICN,DIE,DA,DR
  1.  D GETIC I 'TIUICN D RESET2 Q
  1.  S DIE="^BDGIC(",DA=+TIUICN,DR="[BTIU ICE UPDATE]" D ^DIE
  1.  Q
  1.  ;
  1. ICP ;EP; -- action to print chart copy
  1.  NEW TIUICN
  1.  D GETIC Q:'TIUICN  S TIUDA=$P(TIUICN,U,2) I TIUDA="" Q
  1.  D PRINT1^TIURA
  1.  Q
  1.  ;
  1. RESET ;EP; -- action to rebuild display
  1.  D TERM^VALM0 S VALMBCK="R"
  1.  D INIT,HDR Q
  1.  ;
  1. RESET2 ;EP; -- action to rebuild display
  1.  D TERM^VALM0 S VALMBCK="R"
  1.  D HDR S VALMCNT=$O(^TMP("BTIUDSC2",$J,""),-1) Q
  1.  ;
  1. PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
  1.  Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
  1.  ;
  1. SP(NUM) ; -- SUBRTN to pad spaces
  1.  Q $$PAD(" ",NUM)
  1.  ;
  1. PROV() ; -- ask for provider
  1.  Q $$READ^TIUU("PO^200","Select PROVIDER NAME")
  1.  ;
  1. ERR(NUM) ; -- sets errors
  1.  S LINE="ERROR MESSAGE:  DFN="_DFN_"  TIUCA="_TIUCA_"  NO VISIT"
  1.  D SET(LINE,.TIULN)
  1.  Q