ORWSR ;SLC/REV-Surgery RPCs ;10/03/19 15:19
;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,116,132,148,160,190,274,347,377**;Dec 17, 1997;Build 582
;
SHOWSURG(ORY) ;is Surgery ES patch installed?
S ORY=$$PATCH^XPDUTL("SR*3.0*100")
Q:+ORY=0
S ORY=$$GET^XPAR("ALL","ORWOR SHOW SURGERY TAB",1)
Q
LIST(ORY,ORDFN,ORBDT,OREDT,ORCTXT,ORMAX,ORFHIE) ;RETURN LIST OF SURGERY CASES FOR A PATIENT
Q:'$$PATCH^XPDUTL("SR*3.0*100")
N I,J,X,SHOWADD,SHOWDOCS
S ORY=$NA(^TMP("ORLIST",$J))
Q:'+ORDFN
S:'$G(ORCTXT) ORCTXT=-1
S:'$G(ORBDT) ORBDT=""
S:'$G(OREDT) OREDT=""
S:'$G(ORMAX) ORMAX=""
S (SHOWDOCS,SHOWADD)=1
D LIST^SROESTV(.ORY,ORDFN,ORBDT,OREDT,ORMAX,SHOWDOCS)
S I=0
F S I=$O(@ORY@(I)) Q:+I=0 D
. S X=@ORY@(I),J=0
. S $P(X,U,6)=$$NON^SROESTV(+X)
. S $P(X,U,14)=ORCTXT
. S $P(X,U,13)=$P(X,U,5),$P(X,U,5)=""
. S @ORY@(I)=X
. F S J=$O(@ORY@(I,J)) Q:+J=0 D
. . S X=@ORY@(I,J)
. . ; S:(($P(X,U,14)=ORCTXT)!($P(X,U,14)="")) $P(X,U,14)=+$P(X,U,10)
. . S $P(X,U,14)=+$P(X,U,10)
. . S @ORY@(I,J)=X
Q
CASELIST(ORY,ORDFN) ; retrieve list of cases, but no documents
Q:'$$PATCH^XPDUTL("SR*3.0*100")
Q:'+ORDFN
N ORBDT,OREDT,ORMAX,I,SHOWDOCS S (ORBDT,OREDT,ORMAX)="",SHOWDOCS=0
S ORY=$NA(^TMP("ORLIST",$J))
D LIST^SROESTV(.ORY,ORDFN,ORBDT,OREDT,ORMAX,SHOWDOCS)
S I=0
F S I=$O(@ORY@(I)) Q:+I=0 D
. S $P(@ORY@(I),U,4)=$P($P(@ORY@(I),U,4),";",2)
Q
GTSURCTX(Y,ORUSER) ; Returns current Notes view context for user
N OCCLIM,SHOWSUB
S Y=$$GET^XPAR("ALL","ORCH CONTEXT SURGERY",1)
Q
SVSURCTX(Y,ORCTXT) ; Save new Notes view preferences for user
N TMP
S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT SURGERY",1)
I TMP'="" D Q
. D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT SURGERY",1,ORCTXT)
D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT SURGERY",1,ORCTXT)
Q
;
ONECASE(ORY,ORTIUDA) ;Given a TIU document, return the case and related documents
Q:'$$PATCH^XPDUTL("SR*3.0*100")!(+$G(ORTIUDA)=0)
N ORCASE
D GET1405^TIUSRVR(.ORCASE,ORTIUDA)
I +ORCASE'>0 S ORY=ORCASE Q
D GETONE(.ORY,+ORCASE)
Q
GETONE(ORY,ORCASE) ; called by ONECASE and RPTTEXT
;Q:'$$PATCH^XPDUTL("SR*3.0*100")
N ORTMP,J,SHOWADD,ORCTXT,X ; *377 ajb added X
S SHOWADD=1,ORCTXT=-1
D ONE^SROESTV("ORY",+ORCASE)
S X=ORY(+ORCASE),J=0
S $P(X,U,6)=$$NON^SROESTV(+X)
S $P(X,U,14)=ORCTXT
S $P(X,U,13)=$P(X,U,5),$P(X,U,5)=""
S ORTMP(0)=X
F S J=$O(ORY(+ORCASE,J)) Q:+J=0 D
. S X=ORY(+ORCASE,J)
. ; S:(($P(X,U,14)=ORCTXT)!($P(X,U,14)="")) $P(X,U,14)=+$P(X,U,10)
. S $P(X,U,14)=+$P(X,U,10)
. S ORTMP(J)=X
K ORY M ORY=ORTMP
Q
SHOWOPTP(ORY,ORCASE) ;Should OpTop be displayed on signature?
I '$$PATCH^XPDUTL("SR*3.0*100") S ORY=0 Q
S ORY=$$OPTOP^SROESTV(+ORCASE)
Q
ISNONOR(ORY,ORCASE) ;Is the procedure a non-OR procedure?
I '$$PATCH^XPDUTL("SR*3.0*100") S ORY=0 Q
S ORY=$$NON^SROESTV(+ORCASE)
Q
RPTLIST(ORY,ORDFN) ;Return list of surgery reports for reports tab
;I '$$PATCH^XPDUTL("SR*3.0*100") D NOTYET(.ORY) Q
Q:'$$PATCH^XPDUTL("SR*3.0*100")
Q:'+ORDFN
N ORBDT,OREDT,ORMAX,I,SHOWDOCS,X,SITE,Z,SPEC,GMN,STATUS,DCTDTM,TRSDTM,Y,ORLW
S (ORBDT,OREDT,ORMAX)="",SHOWDOCS=0
S ORY=$NA(^TMP("ORLIST",$J))
S SITE=$$SITE^VASITE,SITE=$P(SITE,"^",2)_";"_$P(SITE,"^",3)
D LIST^SROESTV(.ORY,ORDFN,ORBDT,OREDT,ORMAX,SHOWDOCS)
S I=0
F S I=$O(@ORY@(I)) Q:+I=0 D
. N C ; *377 ajb NEW'd C
. S X=$P(@ORY@(I),U,2),$P(@ORY@(I),U,2)=$P(@ORY@(I),U,3),$P(@ORY@(I),U,3)=X
. S $P(@ORY@(I),U,4)=$P($P(@ORY@(I),U,4),";",2)
. S GMN=$P(@ORY@(I),U)
. ;*347 Use Fileman calls.
. K ORLW D GETS^DIQ(130,GMN,"49","","ORLW") S Z=$Q(ORLW) S:Z']"" Z="Z" S $P(@ORY@(I),U,6)="LAB WORK-"_$S($D(@Z)>1:"Yes",1:"No") ; Lab work
. D STATUS^GMTSROB S:'$D(STATUS) STATUS="UNKNOWN"
. S $P(@ORY@(I),U,7)="STATUS-"_STATUS ; op status
. S Z=$$GET1^DIQ(130,GMN,.04,"I") I Z>0 S Y=Z,C=$P(^DD(130,.04,0),U,2) D Y^DIQ S SPEC=Y K Y ; *377 ajb C not NEW'd see above
. S $P(@ORY@(I),U,8)="SPEC-"_$G(SPEC) ; Surgical specialty
. S Z=$$GET1^DIQ(130,GMN,15,"I") S:Z>0 DCTDTM=$$DATE^ORDVU(Z)
. S $P(@ORY@(I),U,9)="DICT-"_$G(DCTDTM) ; Dictation Time
. S Z=$$GET1^DIQ(130,GMN,39,"I") S:Z>0 TRSDTM=$$DATE^ORDVU(Z)
. S $P(@ORY@(I),U,10)="TRANS-"_$G(TRSDTM) ; Transcription Time
. ;*347 Reset variables for each item.
. K SPEC,DCTDTM,TRSDTM,STATUS,Y,Z
. S @ORY@(I)=SITE_U_@ORY@(I)
Q
RPTTEXT(ROOT,DFN,ORID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- return surgery report
;I '$$PATCH^XPDUTL("SR*3.0*100") D NOTYET(.ROOT) Q
Q:'$$PATCH^XPDUTL("SR*3.0*100")
Q:+ORID=0
N X,ORI,J,ORDOC,ORCASE,CNT,LINES,ORSEP,ORTMP
S (X,ORI)="",$P(ORSEP,"=",74)=""
S ROOT=$NA(^TMP("ORXPND",$J))
K @ROOT
S CNT=0
D GETONE(.ORCASE,ORID)
S (ORI,J)=""
F S ORI=$O(ORCASE(ORI)) Q:ORI="" D
. S ORTMP(ORID,ORI)=ORCASE(ORI)
K ORCASE M ORCASE=ORTMP
S ORI=""
F S ORI=$O(ORCASE(ORID,ORI)) Q:ORI="" D
. Q:'$L($P(ORCASE(ORID,ORI),U,10))
. Q:$E($P(ORCASE(ORID,ORI),U,2),1,8)="Addendum"
. D TGET^TIUSRVR1(.ORDOC,+ORCASE(ORID,ORI),"VIEW")
. S J="",LINES=0
. F S J=$O(@ORDOC@(J)) Q:J="" D
. . I $D(@ORDOC@(J))=10 D
. . . S @ROOT@(J+CNT,0)=@ORDOC@(J,0),LINES=LINES+1
. . E S @ROOT@(J+CNT,0)=@ORDOC@(J),LINES=LINES+1
. K ORDOC,ORY(ORID) S CNT=CNT+LINES+1
. S @ROOT@(CNT,0)=ORSEP,CNT=CNT+1
I CNT=0 S @ROOT@(CNT,0)="No reports are available for this case."
Q
NOTYET(ROOT) ; -- standard not available display text
D SETITEM(.ROOT,"Report not available at this time.")
Q
SETITEM(ROOT,X) ; -- set item in list
S @ROOT@($O(@ROOT@(9999),-1)+1)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWSR 5528 printed Dec 13, 2024@02:37:28 Page 2
ORWSR ;SLC/REV-Surgery RPCs ;10/03/19 15:19
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,116,132,148,160,190,274,347,377**;Dec 17, 1997;Build 582
+2 ;
SHOWSURG(ORY) ;is Surgery ES patch installed?
+1 SET ORY=$$PATCH^XPDUTL("SR*3.0*100")
+2 if +ORY=0
QUIT
+3 SET ORY=$$GET^XPAR("ALL","ORWOR SHOW SURGERY TAB",1)
+4 QUIT
LIST(ORY,ORDFN,ORBDT,OREDT,ORCTXT,ORMAX,ORFHIE) ;RETURN LIST OF SURGERY CASES FOR A PATIENT
+1 if '$$PATCH^XPDUTL("SR*3.0*100")
QUIT
+2 NEW I,J,X,SHOWADD,SHOWDOCS
+3 SET ORY=$NAME(^TMP("ORLIST",$JOB))
+4 if '+ORDFN
QUIT
+5 if '$GET(ORCTXT)
SET ORCTXT=-1
+6 if '$GET(ORBDT)
SET ORBDT=""
+7 if '$GET(OREDT)
SET OREDT=""
+8 if '$GET(ORMAX)
SET ORMAX=""
+9 SET (SHOWDOCS,SHOWADD)=1
+10 DO LIST^SROESTV(.ORY,ORDFN,ORBDT,OREDT,ORMAX,SHOWDOCS)
+11 SET I=0
+12 FOR
SET I=$ORDER(@ORY@(I))
if +I=0
QUIT
Begin DoDot:1
+13 SET X=@ORY@(I)
SET J=0
+14 SET $PIECE(X,U,6)=$$NON^SROESTV(+X)
+15 SET $PIECE(X,U,14)=ORCTXT
+16 SET $PIECE(X,U,13)=$PIECE(X,U,5)
SET $PIECE(X,U,5)=""
+17 SET @ORY@(I)=X
+18 FOR
SET J=$ORDER(@ORY@(I,J))
if +J=0
QUIT
Begin DoDot:2
+19 SET X=@ORY@(I,J)
+20 ; S:(($P(X,U,14)=ORCTXT)!($P(X,U,14)="")) $P(X,U,14)=+$P(X,U,10)
+21 SET $PIECE(X,U,14)=+$PIECE(X,U,10)
+22 SET @ORY@(I,J)=X
End DoDot:2
End DoDot:1
+23 QUIT
CASELIST(ORY,ORDFN) ; retrieve list of cases, but no documents
+1 if '$$PATCH^XPDUTL("SR*3.0*100")
QUIT
+2 if '+ORDFN
QUIT
+3 NEW ORBDT,OREDT,ORMAX,I,SHOWDOCS
SET (ORBDT,OREDT,ORMAX)=""
SET SHOWDOCS=0
+4 SET ORY=$NAME(^TMP("ORLIST",$JOB))
+5 DO LIST^SROESTV(.ORY,ORDFN,ORBDT,OREDT,ORMAX,SHOWDOCS)
+6 SET I=0
+7 FOR
SET I=$ORDER(@ORY@(I))
if +I=0
QUIT
Begin DoDot:1
+8 SET $PIECE(@ORY@(I),U,4)=$PIECE($PIECE(@ORY@(I),U,4),";",2)
End DoDot:1
+9 QUIT
GTSURCTX(Y,ORUSER) ; Returns current Notes view context for user
+1 NEW OCCLIM,SHOWSUB
+2 SET Y=$$GET^XPAR("ALL","ORCH CONTEXT SURGERY",1)
+3 QUIT
SVSURCTX(Y,ORCTXT) ; Save new Notes view preferences for user
+1 NEW TMP
+2 SET TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT SURGERY",1)
+3 IF TMP'=""
Begin DoDot:1
+4 DO CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT SURGERY",1,ORCTXT)
End DoDot:1
QUIT
+5 DO ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT SURGERY",1,ORCTXT)
+6 QUIT
+7 ;
ONECASE(ORY,ORTIUDA) ;Given a TIU document, return the case and related documents
+1 if '$$PATCH^XPDUTL("SR*3.0*100")!(+$GET(ORTIUDA)=0)
QUIT
+2 NEW ORCASE
+3 DO GET1405^TIUSRVR(.ORCASE,ORTIUDA)
+4 IF +ORCASE'>0
SET ORY=ORCASE
QUIT
+5 DO GETONE(.ORY,+ORCASE)
+6 QUIT
GETONE(ORY,ORCASE) ; called by ONECASE and RPTTEXT
+1 ;Q:'$$PATCH^XPDUTL("SR*3.0*100")
+2 ; *377 ajb added X
NEW ORTMP,J,SHOWADD,ORCTXT,X
+3 SET SHOWADD=1
SET ORCTXT=-1
+4 DO ONE^SROESTV("ORY",+ORCASE)
+5 SET X=ORY(+ORCASE)
SET J=0
+6 SET $PIECE(X,U,6)=$$NON^SROESTV(+X)
+7 SET $PIECE(X,U,14)=ORCTXT
+8 SET $PIECE(X,U,13)=$PIECE(X,U,5)
SET $PIECE(X,U,5)=""
+9 SET ORTMP(0)=X
+10 FOR
SET J=$ORDER(ORY(+ORCASE,J))
if +J=0
QUIT
Begin DoDot:1
+11 SET X=ORY(+ORCASE,J)
+12 ; S:(($P(X,U,14)=ORCTXT)!($P(X,U,14)="")) $P(X,U,14)=+$P(X,U,10)
+13 SET $PIECE(X,U,14)=+$PIECE(X,U,10)
+14 SET ORTMP(J)=X
End DoDot:1
+15 KILL ORY
MERGE ORY=ORTMP
+16 QUIT
SHOWOPTP(ORY,ORCASE) ;Should OpTop be displayed on signature?
+1 IF '$$PATCH^XPDUTL("SR*3.0*100")
SET ORY=0
QUIT
+2 SET ORY=$$OPTOP^SROESTV(+ORCASE)
+3 QUIT
ISNONOR(ORY,ORCASE) ;Is the procedure a non-OR procedure?
+1 IF '$$PATCH^XPDUTL("SR*3.0*100")
SET ORY=0
QUIT
+2 SET ORY=$$NON^SROESTV(+ORCASE)
+3 QUIT
RPTLIST(ORY,ORDFN) ;Return list of surgery reports for reports tab
+1 ;I '$$PATCH^XPDUTL("SR*3.0*100") D NOTYET(.ORY) Q
+2 if '$$PATCH^XPDUTL("SR*3.0*100")
QUIT
+3 if '+ORDFN
QUIT
+4 NEW ORBDT,OREDT,ORMAX,I,SHOWDOCS,X,SITE,Z,SPEC,GMN,STATUS,DCTDTM,TRSDTM,Y,ORLW
+5 SET (ORBDT,OREDT,ORMAX)=""
SET SHOWDOCS=0
+6 SET ORY=$NAME(^TMP("ORLIST",$JOB))
+7 SET SITE=$$SITE^VASITE
SET SITE=$PIECE(SITE,"^",2)_";"_$PIECE(SITE,"^",3)
+8 DO LIST^SROESTV(.ORY,ORDFN,ORBDT,OREDT,ORMAX,SHOWDOCS)
+9 SET I=0
+10 FOR
SET I=$ORDER(@ORY@(I))
if +I=0
QUIT
Begin DoDot:1
+11 ; *377 ajb NEW'd C
NEW C
+12 SET X=$PIECE(@ORY@(I),U,2)
SET $PIECE(@ORY@(I),U,2)=$PIECE(@ORY@(I),U,3)
SET $PIECE(@ORY@(I),U,3)=X
+13 SET $PIECE(@ORY@(I),U,4)=$PIECE($PIECE(@ORY@(I),U,4),";",2)
+14 SET GMN=$PIECE(@ORY@(I),U)
+15 ;*347 Use Fileman calls.
+16 ; Lab work
KILL ORLW
DO GETS^DIQ(130,GMN,"49","","ORLW")
SET Z=$QUERY(ORLW)
if Z']""
SET Z="Z"
SET $PIECE(@ORY@(I),U,6)="LAB WORK-"_$SELECT($DATA(@Z)>1:"Yes",1:"No")
+17 DO STATUS^GMTSROB
if '$DATA(STATUS)
SET STATUS="UNKNOWN"
+18 ; op status
SET $PIECE(@ORY@(I),U,7)="STATUS-"_STATUS
+19 ; *377 ajb C not NEW'd see above
SET Z=$$GET1^DIQ(130,GMN,.04,"I")
IF Z>0
SET Y=Z
SET C=$PIECE(^DD(130,.04,0),U,2)
DO Y^DIQ
SET SPEC=Y
KILL Y
+20 ; Surgical specialty
SET $PIECE(@ORY@(I),U,8)="SPEC-"_$GET(SPEC)
+21 SET Z=$$GET1^DIQ(130,GMN,15,"I")
if Z>0
SET DCTDTM=$$DATE^ORDVU(Z)
+22 ; Dictation Time
SET $PIECE(@ORY@(I),U,9)="DICT-"_$GET(DCTDTM)
+23 SET Z=$$GET1^DIQ(130,GMN,39,"I")
if Z>0
SET TRSDTM=$$DATE^ORDVU(Z)
+24 ; Transcription Time
SET $PIECE(@ORY@(I),U,10)="TRANS-"_$GET(TRSDTM)
+25 ;*347 Reset variables for each item.
+26 KILL SPEC,DCTDTM,TRSDTM,STATUS,Y,Z
+27 SET @ORY@(I)=SITE_U_@ORY@(I)
End DoDot:1
+28 QUIT
RPTTEXT(ROOT,DFN,ORID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- return surgery report
+1 ;I '$$PATCH^XPDUTL("SR*3.0*100") D NOTYET(.ROOT) Q
+2 if '$$PATCH^XPDUTL("SR*3.0*100")
QUIT
+3 if +ORID=0
QUIT
+4 NEW X,ORI,J,ORDOC,ORCASE,CNT,LINES,ORSEP,ORTMP
+5 SET (X,ORI)=""
SET $PIECE(ORSEP,"=",74)=""
+6 SET ROOT=$NAME(^TMP("ORXPND",$JOB))
+7 KILL @ROOT
+8 SET CNT=0
+9 DO GETONE(.ORCASE,ORID)
+10 SET (ORI,J)=""
+11 FOR
SET ORI=$ORDER(ORCASE(ORI))
if ORI=""
QUIT
Begin DoDot:1
+12 SET ORTMP(ORID,ORI)=ORCASE(ORI)
End DoDot:1
+13 KILL ORCASE
MERGE ORCASE=ORTMP
+14 SET ORI=""
+15 FOR
SET ORI=$ORDER(ORCASE(ORID,ORI))
if ORI=""
QUIT
Begin DoDot:1
+16 if '$LENGTH($PIECE(ORCASE(ORID,ORI),U,10))
QUIT
+17 if $EXTRACT($PIECE(ORCASE(ORID,ORI),U,2),1,8)="Addendum"
QUIT
+18 DO TGET^TIUSRVR1(.ORDOC,+ORCASE(ORID,ORI),"VIEW")
+19 SET J=""
SET LINES=0
+20 FOR
SET J=$ORDER(@ORDOC@(J))
if J=""
QUIT
Begin DoDot:2
+21 IF $DATA(@ORDOC@(J))=10
Begin DoDot:3
+22 SET @ROOT@(J+CNT,0)=@ORDOC@(J,0)
SET LINES=LINES+1
End DoDot:3
+23 IF '$TEST
SET @ROOT@(J+CNT,0)=@ORDOC@(J)
SET LINES=LINES+1
End DoDot:2
+24 KILL ORDOC,ORY(ORID)
SET CNT=CNT+LINES+1
+25 SET @ROOT@(CNT,0)=ORSEP
SET CNT=CNT+1
End DoDot:1
+26 IF CNT=0
SET @ROOT@(CNT,0)="No reports are available for this case."
+27 QUIT
NOTYET(ROOT) ; -- standard not available display text
+1 DO SETITEM(.ROOT,"Report not available at this time.")
+2 QUIT
SETITEM(ROOT,X) ; -- set item in list
+1 SET @ROOT@($ORDER(@ROOT@(9999),-1)+1)=X
+2 QUIT
