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

ORWSR.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. SHOWSURG(ORY) ;is Surgery ES patch installed?
  1. S ORY=$$PATCH^XPDUTL("SR*3.0*100")
  1. Q:+ORY=0
  1. S ORY=$$GET^XPAR("ALL","ORWOR SHOW SURGERY TAB",1)
  1. Q
  1. LIST(ORY,ORDFN,ORBDT,OREDT,ORCTXT,ORMAX,ORFHIE) ;RETURN LIST OF SURGERY CASES FOR A PATIENT
  1. Q:'$$PATCH^XPDUTL("SR*3.0*100")
  1. N I,J,X,SHOWADD,SHOWDOCS
  1. S ORY=$NA(^TMP("ORLIST",$J))
  1. Q:'+ORDFN
  1. S:'$G(ORCTXT) ORCTXT=-1
  1. S:'$G(ORBDT) ORBDT=""
  1. S:'$G(OREDT) OREDT=""
  1. S:'$G(ORMAX) ORMAX=""
  1. S (SHOWDOCS,SHOWADD)=1
  1. D LIST^SROESTV(.ORY,ORDFN,ORBDT,OREDT,ORMAX,SHOWDOCS)
  1. S I=0
  1. F S I=$O(@ORY@(I)) Q:+I=0 D
  1. . S X=@ORY@(I),J=0
  1. . S $P(X,U,6)=$$NON^SROESTV(+X)
  1. . S $P(X,U,14)=ORCTXT
  1. . S $P(X,U,13)=$P(X,U,5),$P(X,U,5)=""
  1. . S @ORY@(I)=X
  1. . F S J=$O(@ORY@(I,J)) Q:+J=0 D
  1. . . S X=@ORY@(I,J)
  1. . . ; S:(($P(X,U,14)=ORCTXT)!($P(X,U,14)="")) $P(X,U,14)=+$P(X,U,10)
  1. . . S $P(X,U,14)=+$P(X,U,10)
  1. . . S @ORY@(I,J)=X
  1. Q
  1. CASELIST(ORY,ORDFN) ; retrieve list of cases, but no documents
  1. Q:'$$PATCH^XPDUTL("SR*3.0*100")
  1. Q:'+ORDFN
  1. N ORBDT,OREDT,ORMAX,I,SHOWDOCS S (ORBDT,OREDT,ORMAX)="",SHOWDOCS=0
  1. S ORY=$NA(^TMP("ORLIST",$J))
  1. D LIST^SROESTV(.ORY,ORDFN,ORBDT,OREDT,ORMAX,SHOWDOCS)
  1. S I=0
  1. F S I=$O(@ORY@(I)) Q:+I=0 D
  1. . S $P(@ORY@(I),U,4)=$P($P(@ORY@(I),U,4),";",2)
  1. Q
  1. GTSURCTX(Y,ORUSER) ; Returns current Notes view context for user
  1. N OCCLIM,SHOWSUB
  1. S Y=$$GET^XPAR("ALL","ORCH CONTEXT SURGERY",1)
  1. Q
  1. SVSURCTX(Y,ORCTXT) ; Save new Notes view preferences for user
  1. N TMP
  1. S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT SURGERY",1)
  1. I TMP'="" D Q
  1. . D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT SURGERY",1,ORCTXT)
  1. D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT SURGERY",1,ORCTXT)
  1. Q
  1. ;
  1. ONECASE(ORY,ORTIUDA) ;Given a TIU document, return the case and related documents
  1. Q:'$$PATCH^XPDUTL("SR*3.0*100")!(+$G(ORTIUDA)=0)
  1. N ORCASE
  1. D GET1405^TIUSRVR(.ORCASE,ORTIUDA)
  1. I +ORCASE'>0 S ORY=ORCASE Q
  1. D GETONE(.ORY,+ORCASE)
  1. Q
  1. GETONE(ORY,ORCASE) ; called by ONECASE and RPTTEXT
  1. ;Q:'$$PATCH^XPDUTL("SR*3.0*100")
  1. N ORTMP,J,SHOWADD,ORCTXT,X ; *377 ajb added X
  1. S SHOWADD=1,ORCTXT=-1
  1. D ONE^SROESTV("ORY",+ORCASE)
  1. S X=ORY(+ORCASE),J=0
  1. S $P(X,U,6)=$$NON^SROESTV(+X)
  1. S $P(X,U,14)=ORCTXT
  1. S $P(X,U,13)=$P(X,U,5),$P(X,U,5)=""
  1. S ORTMP(0)=X
  1. F S J=$O(ORY(+ORCASE,J)) Q:+J=0 D
  1. . S X=ORY(+ORCASE,J)
  1. . ; S:(($P(X,U,14)=ORCTXT)!($P(X,U,14)="")) $P(X,U,14)=+$P(X,U,10)
  1. . S $P(X,U,14)=+$P(X,U,10)
  1. . S ORTMP(J)=X
  1. K ORY M ORY=ORTMP
  1. Q
  1. SHOWOPTP(ORY,ORCASE) ;Should OpTop be displayed on signature?
  1. I '$$PATCH^XPDUTL("SR*3.0*100") S ORY=0 Q
  1. S ORY=$$OPTOP^SROESTV(+ORCASE)
  1. Q
  1. ISNONOR(ORY,ORCASE) ;Is the procedure a non-OR procedure?
  1. I '$$PATCH^XPDUTL("SR*3.0*100") S ORY=0 Q
  1. S ORY=$$NON^SROESTV(+ORCASE)
  1. Q
  1. RPTLIST(ORY,ORDFN) ;Return list of surgery reports for reports tab
  1. ;I '$$PATCH^XPDUTL("SR*3.0*100") D NOTYET(.ORY) Q
  1. Q:'$$PATCH^XPDUTL("SR*3.0*100")
  1. Q:'+ORDFN
  1. N ORBDT,OREDT,ORMAX,I,SHOWDOCS,X,SITE,Z,SPEC,GMN,STATUS,DCTDTM,TRSDTM,Y,ORLW
  1. S (ORBDT,OREDT,ORMAX)="",SHOWDOCS=0
  1. S ORY=$NA(^TMP("ORLIST",$J))
  1. S SITE=$$SITE^VASITE,SITE=$P(SITE,"^",2)_";"_$P(SITE,"^",3)
  1. D LIST^SROESTV(.ORY,ORDFN,ORBDT,OREDT,ORMAX,SHOWDOCS)
  1. S I=0
  1. F S I=$O(@ORY@(I)) Q:+I=0 D
  1. . N C ; *377 ajb NEW'd C
  1. . S X=$P(@ORY@(I),U,2),$P(@ORY@(I),U,2)=$P(@ORY@(I),U,3),$P(@ORY@(I),U,3)=X
  1. . S $P(@ORY@(I),U,4)=$P($P(@ORY@(I),U,4),";",2)
  1. . S GMN=$P(@ORY@(I),U)
  1. . ;*347 Use Fileman calls.
  1. . 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
  1. . D STATUS^GMTSROB S:'$D(STATUS) STATUS="UNKNOWN"
  1. . S $P(@ORY@(I),U,7)="STATUS-"_STATUS ; op status
  1. . 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
  1. . S $P(@ORY@(I),U,8)="SPEC-"_$G(SPEC) ; Surgical specialty
  1. . S Z=$$GET1^DIQ(130,GMN,15,"I") S:Z>0 DCTDTM=$$DATE^ORDVU(Z)
  1. . S $P(@ORY@(I),U,9)="DICT-"_$G(DCTDTM) ; Dictation Time
  1. . S Z=$$GET1^DIQ(130,GMN,39,"I") S:Z>0 TRSDTM=$$DATE^ORDVU(Z)
  1. . S $P(@ORY@(I),U,10)="TRANS-"_$G(TRSDTM) ; Transcription Time
  1. . ;*347 Reset variables for each item.
  1. . K SPEC,DCTDTM,TRSDTM,STATUS,Y,Z
  1. . S @ORY@(I)=SITE_U_@ORY@(I)
  1. Q
  1. 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
  1. Q:'$$PATCH^XPDUTL("SR*3.0*100")
  1. Q:+ORID=0
  1. N X,ORI,J,ORDOC,ORCASE,CNT,LINES,ORSEP,ORTMP
  1. S (X,ORI)="",$P(ORSEP,"=",74)=""
  1. S ROOT=$NA(^TMP("ORXPND",$J))
  1. K @ROOT
  1. S CNT=0
  1. D GETONE(.ORCASE,ORID)
  1. S (ORI,J)=""
  1. F S ORI=$O(ORCASE(ORI)) Q:ORI="" D
  1. . S ORTMP(ORID,ORI)=ORCASE(ORI)
  1. K ORCASE M ORCASE=ORTMP
  1. S ORI=""
  1. F S ORI=$O(ORCASE(ORID,ORI)) Q:ORI="" D
  1. . Q:'$L($P(ORCASE(ORID,ORI),U,10))
  1. . Q:$E($P(ORCASE(ORID,ORI),U,2),1,8)="Addendum"
  1. . D TGET^TIUSRVR1(.ORDOC,+ORCASE(ORID,ORI),"VIEW")
  1. . S J="",LINES=0
  1. . F S J=$O(@ORDOC@(J)) Q:J="" D
  1. . . I $D(@ORDOC@(J))=10 D
  1. . . . S @ROOT@(J+CNT,0)=@ORDOC@(J,0),LINES=LINES+1
  1. . . E S @ROOT@(J+CNT,0)=@ORDOC@(J),LINES=LINES+1
  1. . K ORDOC,ORY(ORID) S CNT=CNT+LINES+1
  1. . S @ROOT@(CNT,0)=ORSEP,CNT=CNT+1
  1. I CNT=0 S @ROOT@(CNT,0)="No reports are available for this case."
  1. Q
  1. NOTYET(ROOT) ; -- standard not available display text
  1. D SETITEM(.ROOT,"Report not available at this time.")
  1. Q
  1. SETITEM(ROOT,X) ; -- set item in list
  1. S @ROOT@($O(@ROOT@(9999),-1)+1)=X
  1. Q