- 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 Feb 19, 2025@00:04 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