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

BTIUDOC.m

Go to the documentation of this file. 
  1. BTIUDOC ; IHS/ITSC/LJF - DICTATION OP REPORT COUNTS ;
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004
  1.  ;
  1.  ;
  1.  NEW TIUEDT,TIUBDT
  1.  S TIUBDT=$$EDATE^TIULA("Operation",""," ") Q:TIUBDT<1
  1.  S TIUEDT=$$LDATE^TIULA("Operation",""," ") Q:TIUEDT<1
  1.  D ZIS^BTIUU("PQ","EN^BTIUDOC","OP RPT DICT COUNTS","TIUBDT;TIUEDT")
  1.  Q
  1.  ;
  1. EN ; -- main entry point for BTIU OP RPT COUNTS
  1.  NEW VALMCNT
  1.  I IOST'["C-" D GATHER(TIUBDT,TIUEDT),PRINT Q
  1.  D TERM^VALM0
  1.  D EN^VALM("BTIU IC OP 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,VALMCNT
  1.  S VALMCNT=$O(^TMP("BTIUDOC",$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("BTIUDOC",$J),^TMP("BTIUDOC2",$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,TIUOPN,CD,DSCH,LINE,TIUN,TIUSRV
  1.  K ^TMP("BTIUDOC",$J),^TMP("BTIUDOC1",$J),^TMP("BTIUDOC2",$J)
  1.  K ^TMP("BTIUDOC3",$J)
  1.  S (TIUCNT,TIULN)=0
  1.  S DATE=TIUBDT-.0001,END=TIUEDT+.2400
  1.  F  S DATE=$O(^SRF("AC",DATE)) Q:'DATE!(DATE>END)  D
  1.  . S TIUOPN=0 F  S TIUOPN=$O(^SRF("AC",DATE,TIUOPN)) Q:'TIUOPN  D
  1.  .. S DFN=^SRF("AC",DATE,TIUOPN)
  1.  .. Q:$$GET1^DIQ(130,TIUOPN,17)]""                                 ;cancelled
  1.  .. S TIUVST=$$GET1^DIQ(130,TIUOPN,9999999.01,"I") Q:'TIUVST
  1.  .. S TIUSRV=$$GET1^DIQ(130,TIUOPN,.04) I TIUSRV="" S TIUSRV="??"
  1.  .. S TIUOPDT=$$GET1^DIQ(130,TIUOPN,.09,"I")                       ;op date
  1.  .. ;
  1.  .. NEW TIUDICT,TIUAUTH
  1.  .. S TIU=0,TIUAUTH=""
  1.  .. F  S TIU=$O(^TIU(8925,"V",TIUVST,TIU)) Q:'TIU!($G(TIUDICT))  D
  1.  ... I '$$CLASS(+$G(^TIU(8925,TIU,0)),TIU) Q      ;not op rpt
  1.  ... S TIUDICT=$$GET1^DIQ(8925,TIU,1307,"I")      ;dictation date
  1.  ... S TIUAUTH=$$GET1^DIQ(8925,TIU,1202)          ;dictated by
  1.  .. ;
  1.  .. S LINE=$$DATA(DFN,TIUOPN,TIUOPDT,$G(TIUDICT)) ;create display line
  1.  .. S ^TMP("BTIUDOC3",$J,TIUSRV,TIUOPDT,TIUOPN)=LINE
  1.  .. D TOT(TIUSRV,$$DPRV(TIUOPN,$G(TIUAUTH)),TIUOPDT,$G(TIUDICT))
  1.  ;
  1.  ; -- put listing in order by service and op date
  1.  S TIULN=0,S=0 F  S S=$O(^TMP("BTIUDOC3",$J,S)) Q:S=""  D
  1.  . D SET("",.TIULN),SET("SERVICE:  "_S,.TIULN)
  1.  . S D=0 F  S D=$O(^TMP("BTIUDOC3",$J,S,D)) Q:D=""  D
  1.  .. S N=0 F  S N=$O(^TMP("BTIUDOC3",$J,S,D,N)) Q:'N  D
  1.  ... S X=^TMP("BTIUDOC3",$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("BTIUDOC1",$J,S)) Q:S=""  D
  1.  . S X=^TMP("BTIUDOC1",$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("BTIUDOC1",$J,S,P)) Q:P=""  D
  1.  .. S X=^TMP("BTIUDOC1",$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("BTIUDOC1",$J),^TMP("BTIUDOC3",$J)
  1.  Q
  1.  ;
  1.  ;
  1. DATA(DFN,OPN,OPDT,DICT) ; -- returns display line
  1.  NEW X,TIUY
  1.  S TIUY=$$PAD($$PAT(DFN),27)_"  "
  1.  S TIUY=TIUY_$$PAD($$DPRV(OPN,TIUAUTH),15)
  1.  S TIUY=TIUY_$$PAD($J($$FMTE^XLFDT(OPDT,"2D"),10),12)
  1.  S TIUY=TIUY_$$PAD($J($$FMTE^XLFDT(DICT,"2"),10),13)
  1.  S TIUY=TIUY_$$STATUS(DICT\1,OPDT\1)
  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,OPDT) ; -- returns whether dictated on time or not
  1.  I +DICT=0 Q "NOT DONE"
  1.  I DICT=OPDT Q "ON TIME"
  1.  Q "LATE"
  1.  ;
  1. CLASS(TYPE,IEN) ; -- returns 1 if doc is in op report dic class
  1.  I $$GET1^DIQ(8925.1,TYPE,.01)="ADDENDUM" S TYPE=$$GET1^DIQ(8925,IEN,.04,"I")
  1.  I $$PNAME^TIULC1(+$$DOCCLASS^TIULC1(TYPE))="OPERATIVE REPORTS" Q 1
  1.  Q 0
  1.  ;
  1. DPRV(IEN,AUTH) ; -- author or surgeon if not dictated yet
  1.  I AUTH]"" Q AUTH
  1.  NEW X S X=$$GET1^DIQ(130,IEN,.14)  ;surgeon
  1.  Q $S(X]"":X,1:"??")
  1.  ;
  1.  ;
  1. SET(LINE,TIULN) ; -- sets ^tmp
  1.  S TIULN=TIULN+1
  1.  S ^TMP("BTIUDOC",$J,TIULN,0)=LINE
  1.  Q
  1.  ;
  1. SET2(LINE,TIULN) ; -- sets ^tmp
  1.  S TIULN=TIULN+1
  1.  S ^TMP("BTIUDOC2",$J,TIULN,0)=LINE
  1.  Q
  1.  ;
  1. PRINT ; -- print lists to paper
  1.  NEW TIUX,TIUL,TIUPG
  1.  D INIT^BTIUU
  1.  F TIUX="BTIUDOC2","BTIUDOC" 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.  .. D MSG^BTIUU(^TMP(TIUX,$J,TIUL,0),1,0,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,"OPERATIVE REPORTS DICTATION STATISTICS",?76,TIUUSR
  1.  W !?($L(TIUFAC\2)),TIUFAC,!,$$REPEAT^XLFSTR("-",80)
  1.  ;
  1.  I TIUX="BTIUDOC2" S X=" Service"_$$SP(13)_"Provider"_$$SP(12)_"#Sur   Dict:  On Time  Late  Not Done"
  1.  E  S X="  HRCN   Patient Name"_$$SP(8)_"Provider"_$$SP(5)_"Surgery    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("BTIUDOC1",$J,SRV,PRV)),Y=$G(^TMP("BTIUDOC1",$J,SRV))
  1.  D INCREM
  1.  S ^TMP("BTIUDOC1",$J,SRV)=Y,^TMP("BTIUDOC1",$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 surgeries
  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("BTIUDOC2",$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")