BTIUDOC ; IHS/ITSC/LJF - DICTATION OP REPORT COUNTS ;
;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004
;
;
NEW TIUEDT,TIUBDT
S TIUBDT=$$EDATE^TIULA("Operation",""," ") Q:TIUBDT<1
S TIUEDT=$$LDATE^TIULA("Operation",""," ") Q:TIUEDT<1
D ZIS^BTIUU("PQ","EN^BTIUDOC","OP RPT DICT COUNTS","TIUBDT;TIUEDT")
Q
;
EN ; -- main entry point for BTIU OP RPT COUNTS
NEW VALMCNT
I IOST'["C-" D GATHER(TIUBDT,TIUEDT),PRINT Q
D TERM^VALM0
D EN^VALM("BTIU IC OP STATUS")
Q
;
HDR ;EP; -- header code
Q
;
INIT ;EP; -- init variables and list array
NEW TIULN
D MSG^BTIUU("Building/Updating Display. . .Please wait.",2,0,0)
D GATHER(TIUBDT,TIUEDT)
S VALMCNT=TIULN
Q
;
INIT2 ;EP; -- init variables and list array
NEW TIULN,VALMCNT
S VALMCNT=$O(^TMP("BTIUDOC",$J,""),-1)
Q
;
HELP ;EP; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ;EP; -- exit code
K VALMCNT
K ^TMP("BTIUDOC",$J),^TMP("BTIUDOC2",$J)
Q
;
EXIT2 ;EP; -- exit code for patient listing
K VALMCNT Q
;
EXPND ; -- expand code
Q
;
GATHER(TIUBDT,TIUEDT) ; -- create display array
NEW X,TIUCNT,TIUCD,DFN,DSC,TIUOPN,CD,DSCH,LINE,TIUN,TIUSRV
K ^TMP("BTIUDOC",$J),^TMP("BTIUDOC1",$J),^TMP("BTIUDOC2",$J)
K ^TMP("BTIUDOC3",$J)
S (TIUCNT,TIULN)=0
S DATE=TIUBDT-.0001,END=TIUEDT+.2400
F S DATE=$O(^SRF("AC",DATE)) Q:'DATE!(DATE>END) D
. S TIUOPN=0 F S TIUOPN=$O(^SRF("AC",DATE,TIUOPN)) Q:'TIUOPN D
.. S DFN=^SRF("AC",DATE,TIUOPN)
.. Q:$$GET1^DIQ(130,TIUOPN,17)]"" ;cancelled
.. S TIUVST=$$GET1^DIQ(130,TIUOPN,9999999.01,"I") Q:'TIUVST
.. S TIUSRV=$$GET1^DIQ(130,TIUOPN,.04) I TIUSRV="" S TIUSRV="??"
.. S TIUOPDT=$$GET1^DIQ(130,TIUOPN,.09,"I") ;op date
.. ;
.. NEW TIUDICT,TIUAUTH
.. S TIU=0,TIUAUTH=""
.. F S TIU=$O(^TIU(8925,"V",TIUVST,TIU)) Q:'TIU!($G(TIUDICT)) D
... I '$$CLASS(+$G(^TIU(8925,TIU,0)),TIU) Q ;not op rpt
... S TIUDICT=$$GET1^DIQ(8925,TIU,1307,"I") ;dictation date
... S TIUAUTH=$$GET1^DIQ(8925,TIU,1202) ;dictated by
.. ;
.. S LINE=$$DATA(DFN,TIUOPN,TIUOPDT,$G(TIUDICT)) ;create display line
.. S ^TMP("BTIUDOC3",$J,TIUSRV,TIUOPDT,TIUOPN)=LINE
.. D TOT(TIUSRV,$$DPRV(TIUOPN,$G(TIUAUTH)),TIUOPDT,$G(TIUDICT))
;
; -- put listing in order by service and op date
S TIULN=0,S=0 F S S=$O(^TMP("BTIUDOC3",$J,S)) Q:S="" D
. D SET("",.TIULN),SET("SERVICE: "_S,.TIULN)
. S D=0 F S D=$O(^TMP("BTIUDOC3",$J,S,D)) Q:D="" D
.. S N=0 F S N=$O(^TMP("BTIUDOC3",$J,S,D,N)) Q:'N D
... S X=^TMP("BTIUDOC3",$J,S,D,N) D SET(X,.TIULN)
;
; -- put totals in order by service and provider
NEW TOTAL S TOTAL=0
S TIULN=0,S=0 F S S=$O(^TMP("BTIUDOC1",$J,S)) Q:S="" D
. S X=^TMP("BTIUDOC1",$J,S),LINE=$$LINE2(S,"",X)
. D TOTL(X,.TOTAL) ;increment grand total
. D SET2("",.TIULN),SET2(LINE,.TIULN)
. S P=0 F S P=$O(^TMP("BTIUDOC1",$J,S,P)) Q:P="" D
.. S X=^TMP("BTIUDOC1",$J,S,P),LINE=$$LINE2("",P,X) D SET2(LINE,.TIULN)
;
S LINE=$$REPEAT^XLFSTR("=",79) D SET2("",.TIULN),SET2(LINE,.TIULN)
S LINE=$$LINE2("GRAND TOTAL","",TOTAL) D SET2(LINE,.TIULN)
S LINE=$$LINE3(TOTAL) D SET2(LINE,.TIULN),SET2("",.TIULN)
K ^TMP("BTIUDOC1",$J),^TMP("BTIUDOC3",$J)
Q
;
;
DATA(DFN,OPN,OPDT,DICT) ; -- returns display line
NEW X,TIUY
S TIUY=$$PAD($$PAT(DFN),27)_" "
S TIUY=TIUY_$$PAD($$DPRV(OPN,TIUAUTH),15)
S TIUY=TIUY_$$PAD($J($$FMTE^XLFDT(OPDT,"2D"),10),12)
S TIUY=TIUY_$$PAD($J($$FMTE^XLFDT(DICT,"2"),10),13)
S TIUY=TIUY_$$STATUS(DICT\1,OPDT\1)
Q TIUY
;
PAT(DFN) ; -- returns patient chart # and last name
NEW X,Y
S X=$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
S Y=$P($G(^DPT(DFN,0)),U)
Q $J(X,7)_" "_$E(Y,1,18)
;
STATUS(DICT,OPDT) ; -- returns whether dictated on time or not
I +DICT=0 Q "NOT DONE"
I DICT=OPDT Q "ON TIME"
Q "LATE"
;
CLASS(TYPE,IEN) ; -- returns 1 if doc is in op report dic class
I $$GET1^DIQ(8925.1,TYPE,.01)="ADDENDUM" S TYPE=$$GET1^DIQ(8925,IEN,.04,"I")
I $$PNAME^TIULC1(+$$DOCCLASS^TIULC1(TYPE))="OPERATIVE REPORTS" Q 1
Q 0
;
DPRV(IEN,AUTH) ; -- author or surgeon if not dictated yet
I AUTH]"" Q AUTH
NEW X S X=$$GET1^DIQ(130,IEN,.14) ;surgeon
Q $S(X]"":X,1:"??")
;
;
SET(LINE,TIULN) ; -- sets ^tmp
S TIULN=TIULN+1
S ^TMP("BTIUDOC",$J,TIULN,0)=LINE
Q
;
SET2(LINE,TIULN) ; -- sets ^tmp
S TIULN=TIULN+1
S ^TMP("BTIUDOC2",$J,TIULN,0)=LINE
Q
;
PRINT ; -- print lists to paper
NEW TIUX,TIUL,TIUPG
D INIT^BTIUU
F TIUX="BTIUDOC2","BTIUDOC" D
. D HDG
. S TIUL=0 F S TIUL=$O(^TMP(TIUX,$J,TIUL)) Q:'TIUL D
.. I $Y>(IOSL-4) D HDG
.. D MSG^BTIUU(^TMP(TIUX,$J,TIUL,0),1,0,0)
D ^%ZISC,PRTKL^BTIUU,EXIT
Q
;
HDG ; -- prints 2nd half of heading
S TIUPG=$G(TIUPG)+1 I TIUPG>1 W @IOF
W !,TIUTIME,?16,$$CONFID^BTIUU,?71,"Page: ",TIUPG
W !,TIUDATE,?24,"OPERATIVE REPORTS DICTATION STATISTICS",?76,TIUUSR
W !?($L(TIUFAC\2)),TIUFAC,!,$$REPEAT^XLFSTR("-",80)
;
I TIUX="BTIUDOC2" S X=" Service"_$$SP(13)_"Provider"_$$SP(12)_"#Sur Dict: On Time Late Not Done"
E S X=" HRCN Patient Name"_$$SP(8)_"Provider"_$$SP(5)_"Surgery Dictated Status"
W !,X,!,$$REPEAT^XLFSTR("=",80)
Q
;
TOT(SRV,PRV,DSC,DICT) ; -- increment ^tmp for totals
NEW X,Y
S X=$G(^TMP("BTIUDOC1",$J,SRV,PRV)),Y=$G(^TMP("BTIUDOC1",$J,SRV))
D INCREM
S ^TMP("BTIUDOC1",$J,SRV)=Y,^TMP("BTIUDOC1",$J,SRV,PRV)=X
Q
;
TOTL(DATA,TOTAL) ; increment grand total
F I=1:1:4 S $P(TOTAL,U,I)=$P(TOTAL,U,I)+$P(DATA,U,I)
Q
;
INCREM ; -- increment # discharges,dictated on time, late or not at all
S $P(X,U)=$P(X,U)+1,$P(Y,U)=$P(Y,U)+1 ;total surgeries
I DICT="" S $P(X,U,4)=$P(X,U,4)+1,$P(Y,U,4)=$P(Y,U,4)+1 Q ;not dict
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
S $P(X,U,3)=$P(X,U,3)+1,$P(Y,U,3)=$P(Y,U,3)+1 ;dict late
Q
;
LINE2(SRV,PRV,DATA) ; -- sets up display line for totals
NEW X
S X=" "_$$PAD(SRV,18)_" "_$$PAD($E(PRV,1,18),21)
S X=X_$$PAD($J($P(DATA,U),3),15)_$$PAD($J($P(DATA,U,2),3),7)
S X=X_$$PAD($J($P(DATA,U,3),3),7)_$J($P(DATA,U,4),3)
Q X
;
LINE3(DATA) ; -- sets up display line for totals
NEW X,T,OT,LT,ND
S T=$P(DATA,U) I 'T S (OT,LT,ND)=0
E S OT=$P(DATA,U,2)/T*100,LT=$P(DATA,U,3)/T*100,ND=$P(DATA,U,4)/T*100
S X=$$SP(57)_$$PAD($J(OT,3,0)_"%",7)
S X=X_$$PAD($J(LT,3,0)_"%",7)_$J(ND,3,0)_"%"
Q X
;
GETIC ; -- select item from list
NEW X,Y,Z,VALMY
D FULL^VALM1
S TIUICN=0
D EN^VALM2(XQORNOD(0),"OS")
I '$D(VALMY) Q
S X=$O(VALMY(0))
S Y=0 F S Y=$O(^TMP("TIUZICL",$J,"IDX",Y)) Q:Y="" Q:TIUICN>0 D
. S Z=$O(^TMP("TIUZICL",$J,"IDX",Y,0))
. Q:^TMP("TIUZICL",$J,"IDX",Y,Z)=""
. I Z=X S TIUICN=^TMP("TIUZICL",$J,"IDX",Y,Z)
Q
;
ICE ;EP; -- action to edit IC file
NEW TIUICN,DIE,DA,DR
D GETIC I 'TIUICN D RESET2 Q
S DIE="^BDGIC(",DA=+TIUICN,DR="[BTIU ICE UPDATE]" D ^DIE
Q
;
ICP ;EP; -- action to print chart copy
NEW TIUICN
D GETIC Q:'TIUICN S TIUDA=$P(TIUICN,U,2) I TIUDA="" Q
D PRINT1^TIURA
Q
;
RESET ;EP; -- action to rebuild display
D TERM^VALM0 S VALMBCK="R"
D INIT,HDR Q
;
RESET2 ;EP; -- action to rebuild display
D TERM^VALM0 S VALMBCK="R"
D HDR S VALMCNT=$O(^TMP("BTIUDOC2",$J,""),-1) Q
;
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
;
SP(NUM) ; -- SUBRTN to pad spaces
Q $$PAD(" ",NUM)
;
PROV() ; -- ask for provider
Q $$READ^TIUU("PO^200","Select PROVIDER NAME")
BTIUDOC ; IHS/ITSC/LJF - DICTATION OP REPORT COUNTS ;
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004
+2 ;
+3 ;
+4 NEW TIUEDT,TIUBDT
+5 SET TIUBDT=$$EDATE^TIULA("Operation",""," ")
IF TIUBDT<1
QUIT
+6 SET TIUEDT=$$LDATE^TIULA("Operation",""," ")
IF TIUEDT<1
QUIT
+7 DO ZIS^BTIUU("PQ","EN^BTIUDOC","OP RPT DICT COUNTS","TIUBDT;TIUEDT")
+8 QUIT
+9 ;
EN ; -- main entry point for BTIU OP RPT COUNTS
+1 NEW VALMCNT
+2 IF IOST'["C-"
DO GATHER(TIUBDT,TIUEDT)
DO PRINT
QUIT
+3 DO TERM^VALM0
+4 DO EN^VALM("BTIU IC OP STATUS")
+5 QUIT
+6 ;
HDR ;EP; -- header code
+1 QUIT
+2 ;
INIT ;EP; -- init variables and list array
+1 NEW TIULN
+2 DO MSG^BTIUU("Building/Updating Display. . .Please wait.",2,0,0)
+3 DO GATHER(TIUBDT,TIUEDT)
+4 SET VALMCNT=TIULN
+5 QUIT
+6 ;
INIT2 ;EP; -- init variables and list array
+1 NEW TIULN,VALMCNT
+2 SET VALMCNT=$ORDER(^TMP("BTIUDOC",$JOB,""),-1)
+3 QUIT
+4 ;
HELP ;EP; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ;EP; -- exit code
+1 KILL VALMCNT
+2 KILL ^TMP("BTIUDOC",$JOB),^TMP("BTIUDOC2",$JOB)
+3 QUIT
+4 ;
EXIT2 ;EP; -- exit code for patient listing
+1 KILL VALMCNT
QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
GATHER(TIUBDT,TIUEDT) ; -- create display array
+1 NEW X,TIUCNT,TIUCD,DFN,DSC,TIUOPN,CD,DSCH,LINE,TIUN,TIUSRV
+2 KILL ^TMP("BTIUDOC",$JOB),^TMP("BTIUDOC1",$JOB),^TMP("BTIUDOC2",$JOB)
+3 KILL ^TMP("BTIUDOC3",$JOB)
+4 SET (TIUCNT,TIULN)=0
+5 SET DATE=TIUBDT-.0001
SET END=TIUEDT+.2400
+6 FOR
SET DATE=$ORDER(^SRF("AC",DATE))
IF 'DATE!(DATE>END)
QUIT
Begin DoDot:1
+7 SET TIUOPN=0
FOR
SET TIUOPN=$ORDER(^SRF("AC",DATE,TIUOPN))
IF 'TIUOPN
QUIT
Begin DoDot:2
+8 SET DFN=^SRF("AC",DATE,TIUOPN)
+9 ;cancelled
IF $$GET1^DIQ(130,TIUOPN,17)]""
QUIT
+10 SET TIUVST=$$GET1^DIQ(130,TIUOPN,9999999.01,"I")
IF 'TIUVST
QUIT
+11 SET TIUSRV=$$GET1^DIQ(130,TIUOPN,.04)
IF TIUSRV=""
SET TIUSRV="??"
+12 ;op date
SET TIUOPDT=$$GET1^DIQ(130,TIUOPN,.09,"I")
+13 ;
+14 NEW TIUDICT,TIUAUTH
+15 SET TIU=0
SET TIUAUTH=""
+16 FOR
SET TIU=$ORDER(^TIU(8925,"V",TIUVST,TIU))
IF 'TIU!($GET(TIUDICT))
QUIT
Begin DoDot:3
+17 ;not op rpt
IF '$$CLASS(+$GET(^TIU(8925,TIU,0)),TIU)
QUIT
+18 ;dictation date
SET TIUDICT=$$GET1^DIQ(8925,TIU,1307,"I")
+19 ;dictated by
SET TIUAUTH=$$GET1^DIQ(8925,TIU,1202)
End DoDot:3
+20 ;
+21 ;create display line
SET LINE=$$DATA(DFN,TIUOPN,TIUOPDT,$GET(TIUDICT))
+22 SET ^TMP("BTIUDOC3",$JOB,TIUSRV,TIUOPDT,TIUOPN)=LINE
+23 DO TOT(TIUSRV,$$DPRV(TIUOPN,$GET(TIUAUTH)),TIUOPDT,$GET(TIUDICT))
End DoDot:2
End DoDot:1
+24 ;
+25 ; -- put listing in order by service and op date
+26 SET TIULN=0
SET S=0
FOR
SET S=$ORDER(^TMP("BTIUDOC3",$JOB,S))
IF S=""
QUIT
Begin DoDot:1
+27 DO SET("",.TIULN)
DO SET("SERVICE: "_S,.TIULN)
+28 SET D=0
FOR
SET D=$ORDER(^TMP("BTIUDOC3",$JOB,S,D))
IF D=""
QUIT
Begin DoDot:2
+29 SET N=0
FOR
SET N=$ORDER(^TMP("BTIUDOC3",$JOB,S,D,N))
IF 'N
QUIT
Begin DoDot:3
+30 SET X=^TMP("BTIUDOC3",$JOB,S,D,N)
DO SET(X,.TIULN)
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;
+32 ; -- put totals in order by service and provider
+33 NEW TOTAL
SET TOTAL=0
+34 SET TIULN=0
SET S=0
FOR
SET S=$ORDER(^TMP("BTIUDOC1",$JOB,S))
IF S=""
QUIT
Begin DoDot:1
+35 SET X=^TMP("BTIUDOC1",$JOB,S)
SET LINE=$$LINE2(S,"",X)
+36 ;increment grand total
DO TOTL(X,.TOTAL)
+37 DO SET2("",.TIULN)
DO SET2(LINE,.TIULN)
+38 SET P=0
FOR
SET P=$ORDER(^TMP("BTIUDOC1",$JOB,S,P))
IF P=""
QUIT
Begin DoDot:2
+39 SET X=^TMP("BTIUDOC1",$JOB,S,P)
SET LINE=$$LINE2("",P,X)
DO SET2(LINE,.TIULN)
End DoDot:2
End DoDot:1
+40 ;
+41 SET LINE=$$REPEAT^XLFSTR("=",79)
DO SET2("",.TIULN)
DO SET2(LINE,.TIULN)
+42 SET LINE=$$LINE2("GRAND TOTAL","",TOTAL)
DO SET2(LINE,.TIULN)
+43 SET LINE=$$LINE3(TOTAL)
DO SET2(LINE,.TIULN)
DO SET2("",.TIULN)
+44 KILL ^TMP("BTIUDOC1",$JOB),^TMP("BTIUDOC3",$JOB)
+45 QUIT
+46 ;
+47 ;
DATA(DFN,OPN,OPDT,DICT) ; -- returns display line
+1 NEW X,TIUY
+2 SET TIUY=$$PAD($$PAT(DFN),27)_" "
+3 SET TIUY=TIUY_$$PAD($$DPRV(OPN,TIUAUTH),15)
+4 SET TIUY=TIUY_$$PAD($JUSTIFY($$FMTE^XLFDT(OPDT,"2D"),10),12)
+5 SET TIUY=TIUY_$$PAD($JUSTIFY($$FMTE^XLFDT(DICT,"2"),10),13)
+6 SET TIUY=TIUY_$$STATUS(DICT\1,OPDT\1)
+7 QUIT TIUY
+8 ;
PAT(DFN) ; -- returns patient chart # and last name
+1 NEW X,Y
+2 SET X=$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
+3 SET Y=$PIECE($GET(^DPT(DFN,0)),U)
+4 QUIT $JUSTIFY(X,7)_" "_$EXTRACT(Y,1,18)
+5 ;
STATUS(DICT,OPDT) ; -- returns whether dictated on time or not
+1 IF +DICT=0
QUIT "NOT DONE"
+2 IF DICT=OPDT
QUIT "ON TIME"
+3 QUIT "LATE"
+4 ;
CLASS(TYPE,IEN) ; -- returns 1 if doc is in op report dic class
+1 IF $$GET1^DIQ(8925.1,TYPE,.01)="ADDENDUM"
SET TYPE=$$GET1^DIQ(8925,IEN,.04,"I")
+2 IF $$PNAME^TIULC1(+$$DOCCLASS^TIULC1(TYPE))="OPERATIVE REPORTS"
QUIT 1
+3 QUIT 0
+4 ;
DPRV(IEN,AUTH) ; -- author or surgeon if not dictated yet
+1 IF AUTH]""
QUIT AUTH
+2 ;surgeon
NEW X
SET X=$$GET1^DIQ(130,IEN,.14)
+3 QUIT $SELECT(X]"":X,1:"??")
+4 ;
+5 ;
SET(LINE,TIULN) ; -- sets ^tmp
+1 SET TIULN=TIULN+1
+2 SET ^TMP("BTIUDOC",$JOB,TIULN,0)=LINE
+3 QUIT
+4 ;
SET2(LINE,TIULN) ; -- sets ^tmp
+1 SET TIULN=TIULN+1
+2 SET ^TMP("BTIUDOC2",$JOB,TIULN,0)=LINE
+3 QUIT
+4 ;
PRINT ; -- print lists to paper
+1 NEW TIUX,TIUL,TIUPG
+2 DO INIT^BTIUU
+3 FOR TIUX="BTIUDOC2","BTIUDOC"
Begin DoDot:1
+4 DO HDG
+5 SET TIUL=0
FOR
SET TIUL=$ORDER(^TMP(TIUX,$JOB,TIUL))
IF 'TIUL
QUIT
Begin DoDot:2
+6 IF $Y>(IOSL-4)
DO HDG
+7 DO MSG^BTIUU(^TMP(TIUX,$JOB,TIUL,0),1,0,0)
End DoDot:2
End DoDot:1
+8 DO ^%ZISC
DO PRTKL^BTIUU
DO EXIT
+9 QUIT
+10 ;
HDG ; -- prints 2nd half of heading
+1 SET TIUPG=$GET(TIUPG)+1
IF TIUPG>1
WRITE @IOF
+2 WRITE !,TIUTIME,?16,$$CONFID^BTIUU,?71,"Page: ",TIUPG
+3 WRITE !,TIUDATE,?24,"OPERATIVE REPORTS DICTATION STATISTICS",?76,TIUUSR
+4 WRITE !?($LENGTH(TIUFAC\2)),TIUFAC,!,$$REPEAT^XLFSTR("-",80)
+5 ;
+6 IF TIUX="BTIUDOC2"
SET X=" Service"_$$SP(13)_"Provider"_$$SP(12)_"#Sur Dict: On Time Late Not Done"
+7 IF '$TEST
SET X=" HRCN Patient Name"_$$SP(8)_"Provider"_$$SP(5)_"Surgery Dictated Status"
+8 WRITE !,X,!,$$REPEAT^XLFSTR("=",80)
+9 QUIT
+10 ;
TOT(SRV,PRV,DSC,DICT) ; -- increment ^tmp for totals
+1 NEW X,Y
+2 SET X=$GET(^TMP("BTIUDOC1",$JOB,SRV,PRV))
SET Y=$GET(^TMP("BTIUDOC1",$JOB,SRV))
+3 DO INCREM
+4 SET ^TMP("BTIUDOC1",$JOB,SRV)=Y
SET ^TMP("BTIUDOC1",$JOB,SRV,PRV)=X
+5 QUIT
+6 ;
TOTL(DATA,TOTAL) ; increment grand total
+1 FOR I=1:1:4
SET $PIECE(TOTAL,U,I)=$PIECE(TOTAL,U,I)+$PIECE(DATA,U,I)
+2 QUIT
+3 ;
INCREM ; -- increment # discharges,dictated on time, late or not at all
+1 ;total surgeries
SET $PIECE(X,U)=$PIECE(X,U)+1
SET $PIECE(Y,U)=$PIECE(Y,U)+1
+2 ;not dict
IF DICT=""
SET $PIECE(X,U,4)=$PIECE(X,U,4)+1
SET $PIECE(Y,U,4)=$PIECE(Y,U,4)+1
QUIT
+3 ;on time
IF DICT'>DSC
SET $PIECE(X,U,2)=$PIECE(X,U,2)+1
SET $PIECE(Y,U,2)=$PIECE(Y,U,2)+1
QUIT
+4 ;dict late
SET $PIECE(X,U,3)=$PIECE(X,U,3)+1
SET $PIECE(Y,U,3)=$PIECE(Y,U,3)+1
+5 QUIT
+6 ;
LINE2(SRV,PRV,DATA) ; -- sets up display line for totals
+1 NEW X
+2 SET X=" "_$$PAD(SRV,18)_" "_$$PAD($EXTRACT(PRV,1,18),21)
+3 SET X=X_$$PAD($JUSTIFY($PIECE(DATA,U),3),15)_$$PAD($JUSTIFY($PIECE(DATA,U,2),3),7)
+4 SET X=X_$$PAD($JUSTIFY($PIECE(DATA,U,3),3),7)_$JUSTIFY($PIECE(DATA,U,4),3)
+5 QUIT X
+6 ;
LINE3(DATA) ; -- sets up display line for totals
+1 NEW X,T,OT,LT,ND
+2 SET T=$PIECE(DATA,U)
IF 'T
SET (OT,LT,ND)=0
+3 IF '$TEST
SET OT=$PIECE(DATA,U,2)/T*100
SET LT=$PIECE(DATA,U,3)/T*100
SET ND=$PIECE(DATA,U,4)/T*100
+4 SET X=$$SP(57)_$$PAD($JUSTIFY(OT,3,0)_"%",7)
+5 SET X=X_$$PAD($JUSTIFY(LT,3,0)_"%",7)_$JUSTIFY(ND,3,0)_"%"
+6 QUIT X
+7 ;
GETIC ; -- select item from list
+1 NEW X,Y,Z,VALMY
+2 DO FULL^VALM1
+3 SET TIUICN=0
+4 DO EN^VALM2(XQORNOD(0),"OS")
+5 IF '$DATA(VALMY)
QUIT
+6 SET X=$ORDER(VALMY(0))
+7 SET Y=0
FOR
SET Y=$ORDER(^TMP("TIUZICL",$JOB,"IDX",Y))
IF Y=""
QUIT
IF TIUICN>0
QUIT
Begin DoDot:1
+8 SET Z=$ORDER(^TMP("TIUZICL",$JOB,"IDX",Y,0))
+9 IF ^TMP("TIUZICL",$JOB,"IDX",Y,Z)=""
QUIT
+10 IF Z=X
SET TIUICN=^TMP("TIUZICL",$JOB,"IDX",Y,Z)
End DoDot:1
+11 QUIT
+12 ;
ICE ;EP; -- action to edit IC file
+1 NEW TIUICN,DIE,DA,DR
+2 DO GETIC
IF 'TIUICN
DO RESET2
QUIT
+3 SET DIE="^BDGIC("
SET DA=+TIUICN
SET DR="[BTIU ICE UPDATE]"
DO ^DIE
+4 QUIT
+5 ;
ICP ;EP; -- action to print chart copy
+1 NEW TIUICN
+2 DO GETIC
IF 'TIUICN
QUIT
SET TIUDA=$PIECE(TIUICN,U,2)
IF TIUDA=""
QUIT
+3 DO PRINT1^TIURA
+4 QUIT
+5 ;
RESET ;EP; -- action to rebuild display
+1 DO TERM^VALM0
SET VALMBCK="R"
+2 DO INIT
DO HDR
QUIT
+3 ;
RESET2 ;EP; -- action to rebuild display
+1 DO TERM^VALM0
SET VALMBCK="R"
+2 DO HDR
SET VALMCNT=$ORDER(^TMP("BTIUDOC2",$JOB,""),-1)
QUIT
+3 ;
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
+1 QUIT $EXTRACT(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
+2 ;
SP(NUM) ; -- SUBRTN to pad spaces
+1 QUIT $$PAD(" ",NUM)
+2 ;
PROV() ; -- ask for provider
+1 QUIT $$READ^TIUU("PO^200","Select PROVIDER NAME")
