BTIUCHLP ; IHS/ITSC/LJF - Help for Clinician ;
;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004
; IHS subroutines called by ^TIUCHLP and ^BTIUVSIT and Field Trip Note title
;
CHEKPN(X) ;EP; Display/validate demographic/visit information
; called by TIUCHLP
W !!,"PCC Visit Identifiers..."
W !?14,"Patient Name: ",$S($G(X("PNM"))]"":$G(X("PNM")),1:"UNKNOWN")
W !?14,"Patient HRCN: ",$S($G(X("HRCN"))]"":$G(X("HRCN")),1:"UNKNOWN")
W !?8,"Date/time of Visit: "
W $S(+$G(X("VISIT")):$$DATE^TIULS($P(X("VISIT"),U,2),"MM/DD/YY HR:MIN"),+$G(X("EDT")):$$DATE^TIULS(X("EDT"),"MM/DD/YY HR:MIN"),1:"UNKNOWN")
W ?50,$P($G(X("CAT")),U,2)
I $P($G(X("CAT")),U)="H" W ! D
. I $G(X("LDT")) W ?12,"Discharge Date: ",$$DATE^TIULS(+X("LDT"),"MM/DD/YY HR:MIN")
. W ?50,$P($G(X("WARD")),U,2),?57,$P($G(X("TS")),U,2),!
. I ($$PNAME^TIULC1(TIUTYPE)="OPERATIVE REPORTS")!($$PNAME^TIULC1(+$$DOCCLASS^TIULC1(TIUTYPE))="OPERATIVE REPORTS") D SURG
E D
. W !?50,$P($G(^DIC(40.7,+$P($G(^AUPNVSIT(+X("VISIT"),0)),U,8),0)),U),!
. I ($$PNAME^TIULC1(TIUTYPE)="OPERATIVE REPORTS")!($$PNAME^TIULC1(+$$DOCCLASS^TIULC1(TIUTYPE))="OPERATIVE REPORTS") D SURG
Q
;
SURG ;- -- finds surgeries for hospitalization
NEW ORDT,END,IEN,ARR
S ORDT=+$P(X("EDT"),".")-.0001
S END=$S($P($G(X("CAT")),U)'="H":X("EDT")_".2400",+$G(X("LDT")):+X("LDT"),1:DT)
F S ORDT=$O(^SRF("AIHS4",ORDT)) Q:'ORDT!(ORDT>END) D
. Q:'$D(^SRF("AIHS4",ORDT,DFN))
. W ?15,"Surgery on ",$$DATE^TIULS(ORDT,"MM/DD/YY")
. S IEN=0 F S IEN=$O(^SRF("AIHS4",ORDT,DFN,IEN)) Q:'IEN D
.. K ARR D ENP^XBDIQ1(130,IEN,".14;.15;17;26;68","ARR(")
.. I ARR(17)]"" W ?38,"Cancelled" Q
.. W ?38,$E(ARR(.14),1,15)
.. I ARR(.15)]"" W "/",$E(ARR(.15),1,15)
.. W !?20,$E($S(ARR(26)]"":ARR(26),1:ARR(68)),1,58)
. W !
Q
;
GETEVNT ;EP ; Help get Fields for PN Dictation/Error Resolution
;called by field trip title which needs universal patient lookup and event visit
N Y,TIU,DFN,TIUY,TITLE
NEW AUPNLK S AUPNLK("ALL")=1
S DFN=+$$PATIENT^TIULA Q:+DFN'>0
S Y=$$READ^TIUU("YO","Okay to create Event visit for this patient")
Q:'Y
;
S TIUVST=$$ADDEVNT(DFN) Q:'TIUVST ;create event visit
;
D ENPN^TIUVSIT(.TIU,+DFN,1)
I '$D(TIU) Q
S TIUY=$$CHEKPN^TIUCHLP(.TIU)
I 'TIUY Q
D MAKE^TIUPEFIX(.SUCCESS,DFN,.TITLE,.TIU,$S(+$G(XQADATA):+$G(XQADATA),+$G(BUFDA):+$G(BUFDA),1:""))
I +SUCCESS S TIUDONE=1
Q
;
ADDEVNT(DFN) ;EP -- returns visit ien for event visit created
; -- create event visit based on user responses; called by ^BTIUVSIT
NEW TIUFAC,TIUVDT,TIUVST
S TIUFAC=$$READ^TIUU("P^9999999.06:EMZ","Visit Facility")
I TIUFAC S TIUVDT=$$READ^TIUU("D^:NOW:EX","Visit Date")
I $G(TIUVDT) S TIUVST=$$EVENT^BTIUPUTP(DFN,+TIUFAC,TIUVDT)
Q $G(TIUVST)
BTIUCHLP ; IHS/ITSC/LJF - Help for Clinician ;
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004
+2 ; IHS subroutines called by ^TIUCHLP and ^BTIUVSIT and Field Trip Note title
+3 ;
CHEKPN(X) ;EP; Display/validate demographic/visit information
+1 ; called by TIUCHLP
+2 WRITE !!,"PCC Visit Identifiers..."
+3 WRITE !?14,"Patient Name: ",$SELECT($GET(X("PNM"))]"":$GET(X("PNM")),1:"UNKNOWN")
+4 WRITE !?14,"Patient HRCN: ",$SELECT($GET(X("HRCN"))]"":$GET(X("HRCN")),1:"UNKNOWN")
+5 WRITE !?8,"Date/time of Visit: "
+6 WRITE $SELECT(+$GET(X("VISIT")):$$DATE^TIULS($PIECE(X("VISIT"),U,2),"MM/DD/YY HR:MIN"),+$GET(X("EDT")):$$DATE^TIULS(X("EDT"),"MM/DD/YY HR:MIN"),1:"UNKNOWN")
+7 WRITE ?50,$PIECE($GET(X("CAT")),U,2)
+8 IF $PIECE($GET(X("CAT")),U)="H"
WRITE !
Begin DoDot:1
+9 IF $GET(X("LDT"))
WRITE ?12,"Discharge Date: ",$$DATE^TIULS(+X("LDT"),"MM/DD/YY HR:MIN")
+10 WRITE ?50,$PIECE($GET(X("WARD")),U,2),?57,$PIECE($GET(X("TS")),U,2),!
+11 IF ($$PNAME^TIULC1(TIUTYPE)="OPERATIVE REPORTS")!($$PNAME^TIULC1(+$$DOCCLASS^TIULC1(TIUTYPE))="OPERATIVE REPORTS")
DO SURG
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 WRITE !?50,$PIECE($GET(^DIC(40.7,+$PIECE($GET(^AUPNVSIT(+X("VISIT"),0)),U,8),0)),U),!
+14 IF ($$PNAME^TIULC1(TIUTYPE)="OPERATIVE REPORTS")!($$PNAME^TIULC1(+$$DOCCLASS^TIULC1(TIUTYPE))="OPERATIVE REPORTS")
DO SURG
End DoDot:1
+15 QUIT
+16 ;
SURG ;- -- finds surgeries for hospitalization
+1 NEW ORDT,END,IEN,ARR
+2 SET ORDT=+$PIECE(X("EDT"),".")-.0001
+3 SET END=$SELECT($PIECE($GET(X("CAT")),U)'="H":X("EDT")_".2400",+$GET(X("LDT")):+X("LDT"),1:DT)
+4 FOR
SET ORDT=$ORDER(^SRF("AIHS4",ORDT))
IF 'ORDT!(ORDT>END)
QUIT
Begin DoDot:1
+5 IF '$DATA(^SRF("AIHS4",ORDT,DFN))
QUIT
+6 WRITE ?15,"Surgery on ",$$DATE^TIULS(ORDT,"MM/DD/YY")
+7 SET IEN=0
FOR
SET IEN=$ORDER(^SRF("AIHS4",ORDT,DFN,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+8 KILL ARR
DO ENP^XBDIQ1(130,IEN,".14;.15;17;26;68","ARR(")
+9 IF ARR(17)]""
WRITE ?38,"Cancelled"
QUIT
+10 WRITE ?38,$EXTRACT(ARR(.14),1,15)
+11 IF ARR(.15)]""
WRITE "/",$EXTRACT(ARR(.15),1,15)
+12 WRITE !?20,$EXTRACT($SELECT(ARR(26)]"":ARR(26),1:ARR(68)),1,58)
End DoDot:2
+13 WRITE !
End DoDot:1
+14 QUIT
+15 ;
GETEVNT ;EP ; Help get Fields for PN Dictation/Error Resolution
+1 ;called by field trip title which needs universal patient lookup and event visit
+2 NEW Y,TIU,DFN,TIUY,TITLE
+3 NEW AUPNLK
SET AUPNLK("ALL")=1
+4 SET DFN=+$$PATIENT^TIULA
IF +DFN'>0
QUIT
+5 SET Y=$$READ^TIUU("YO","Okay to create Event visit for this patient")
+6 IF 'Y
QUIT
+7 ;
+8 ;create event visit
SET TIUVST=$$ADDEVNT(DFN)
IF 'TIUVST
QUIT
+9 ;
+10 DO ENPN^TIUVSIT(.TIU,+DFN,1)
+11 IF '$DATA(TIU)
QUIT
+12 SET TIUY=$$CHEKPN^TIUCHLP(.TIU)
+13 IF 'TIUY
QUIT
+14 DO MAKE^TIUPEFIX(.SUCCESS,DFN,.TITLE,.TIU,$SELECT(+$GET(XQADATA):+$GET(XQADATA),+$GET(BUFDA):+$GET(BUFDA),1:""))
+15 IF +SUCCESS
SET TIUDONE=1
+16 QUIT
+17 ;
ADDEVNT(DFN) ;EP -- returns visit ien for event visit created
+1 ; -- create event visit based on user responses; called by ^BTIUVSIT
+2 NEW TIUFAC,TIUVDT,TIUVST
+3 SET TIUFAC=$$READ^TIUU("P^9999999.06:EMZ","Visit Facility")
+4 IF TIUFAC
SET TIUVDT=$$READ^TIUU("D^:NOW:EX","Visit Date")
+5 IF $GET(TIUVDT)
SET TIUVST=$$EVENT^BTIUPUTP(DFN,+TIUFAC,TIUVDT)
+6 QUIT $GET(TIUVST)
