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

MDRPCOT.m

Go to the documentation of this file. 
  1. MDRPCOT ; HOIFO/DP/NCA - Object RPCs (TMDTransaction) ; 5/9/18 1:07pm
  1.  ;;1.0;CLINICAL PROCEDURES;**5,6,11,21,43**;Apr 01, 2004;Build 7
  1.  ; Integration Agreements:
  1.  ; IA# 2693 [Subscription] TIU Extractions.
  1.  ; IA# 2944 [Subscription] Calls to TIUSRVR1.
  1.  ; IA# 3535 [Subscription] Calls to TIUSRVP.
  1.  ; IA# 10103 [Supported] Call to XLFDT
  1.  ; IA# 10104 [Supported] Routine XLFSTR calls
  1. ADDMSG ; [Procedure] Add message to transaction
  1.  N MDIEN,MDIENS,MDRET
  1.  Q:'$G(DATA("TRANSACTION"))
  1.  Q:$G(DATA("MESSAGE"))=""
  1.  S MDIEN=+DATA("TRANSACTION"),MDIENS="+1,"_MDIEN_","
  1.  D NOW^%DTC S DATA("DATE")=% K %
  1.  S MDFDA(702.091,MDIENS,.01)=+$O(^MDD(702,+MDIEN,.091,"A"),-1)+1
  1.  S MDFDA(702.091,MDIENS,.02)=DATA("DATE")
  1.  S MDFDA(702.091,MDIENS,.03)=$G(DATA("PKG"),"UNKNOWN")
  1.  S MDFDA(702.091,MDIENS,.09)=DATA("MESSAGE")
  1.  D UPDATE^DIE("","MDFDA","MDRET")
  1.  Q
  1.  ;
  1. DELETE ; [Procedure] Delete Study
  1.  ; Sets @RESULTS@(0)="-1^Reason for not deleting" or "1^Study Deleted"
  1.  ;
  1.  N MDAST,MDHOLD,MDNOTE,MDRES,MDSIEN,BODY,SUBJECT,DEVIEN
  1.  S (MDHOLD,MDSIEN)=+DATA,MDRES=0,MDNOTE=""
  1.  D ALERT^MDHL7U3(MDSIEN) ; Builds the body of the mail message
  1.  I $G(^MDD(702,+MDSIEN,0))="" S @RESULTS@(0)="1^Study Deleted." D NOTICE^MDHL7U3(SUBJECT,.BODY,DEVIEN,DUZ) Q  ;deleting message
  1.  S:+$P(^MDD(702,MDSIEN,0),U,6) MDNOTE=$P(^MDD(702,MDSIEN,0),U,6)
  1.  I "13"[$P(^MDD(702,MDSIEN,0),U,9) S @RESULTS@(0)="-1^Can't Delete TIU Note from a "_$$GET1^DIQ(702,MDSIEN,.09,"E")_" Study." Q
  1.  I "5"[$P(^MDD(702,MDSIEN,0),U,9) S MDCANR=$$CANCEL^MDHL7B(MDHOLD) I +MDCANR<0 S @RESULTS@(0)="-1^"_$P(MDCANR,"^",2) Q
  1.  I +MDNOTE S MDRES="" D DELETE^TIUSRVP(.MDRES,MDNOTE)
  1.  I MDRES D  Q
  1.  .D STATUS(MDSIEN_",",2,$P(MDRES,"^",2))
  1.  .S DATA("TRANSACTION")=MDSIEN,DATA("PKG")="TIU"
  1.  .S DATA("MESSAGE")=$P(MDRES,"^",2) D ADDMSG
  1.  .S @RESULTS@(0)="-1^"_$P(MDRES,"^",2)
  1.  .Q
  1.  E  D
  1.  .I $D(^MDD(702.001,"ASTUDY",MDSIEN)) S @RESULTS@(0)="-1^Note associated with study, can not delete." Q
  1.  .S MDAST=$$HL7CHK^MDHL7U3(+MDSIEN) I +MDAST<1 S @RESULTS@(0)=MDAST Q
  1.  .D NOTICE^MDHL7U3(SUBJECT,.BODY,DEVIEN,DUZ) ; delete message
  1.  .S MDFDA(702,DATA_",",.01)=""
  1.  .; Check for renal study to delete as well
  1.  .S:$D(^MDK(704.202,DATA)) MDFDA(704.202,DATA_",",.01)=""
  1.  .D FILE^DIE("","MDFDA")
  1.  .N DA,DIK S DA=+MDSIEN,DIK="^MDD(702," D ^DIK
  1.  .S @RESULTS@(0)="1^Study Deleted."
  1.  .Q
  1.  Q
  1.  ;
  1. FILEMSG(STUDY,MDPKG,MDSTAT,MDMSG) ; [Procedure] File Study Status and Message.
  1.  S DATA("TRANSACTION")=STUDY,DATA("PKG")=MDPKG
  1.  S DATA("MESSAGE")=$P(MDMSG,"^",2)
  1.  D STATUS(STUDY_",",MDSTAT,$P(MDMSG,"^",2)),ADDMSG
  1.  Q
  1.  ;
  1. FILES ; [Procedure] Add/remove an attachment to this transaction
  1.  NEW MDFDA,MDIEN,MDIENS,MDRET,MDT,MDT1,P1,P2,P3,P4
  1.  S P1=$P(DATA,U,1),P2=$P(DATA,U,2),P3=$P(DATA,U,3),P4=$P(DATA,U,4)
  1.  S MDIEN=0 I $G(^MDD(702,+P1,0))="" Q
  1.  S MDT=+P1,MDT1=$$MULT^MDRPCOT1(MDT),MDT=$S('MDT1:1,MDT1=1:1,1:0)
  1.  ;I +MDT,$P($G(^MDD(702,+P1,0)),"^",9)=3 S @RESULTS@(0)="1^Study is already complete" Q
  1.  I $P($G(^MDD(702,+P1,0)),"^",9)=6 S @RESULTS@(0)="1^Study is already cancelled" Q
  1.  ; Look for file (All comparisons done on lower case values)
  1.  F  S MDIEN=$O(^MDD(702,P1,.1,MDIEN)) Q:'MDIEN  D  Q:X=P3
  1.  .S X=$$LOW^XLFSTR($G(^MDD(702,P1,.1,MDIEN,.1)))
  1.  I +MDT,MDIEN,P4 S @RESULTS@(0)="1^File already assigned" Q
  1.  I 'MDIEN&'P4 S @RESULTS@(0)="1^File not assigned" Q
  1.  I P4 D  Q  ; Add a file
  1.  .S MDIENS="+1,"_P1_","
  1.  .L +^MDD(702,P1,0):0 I '$T S @RESULTS@(0)="1^Study locked" Q  ;43 - add lock
  1.  .S MDFDA(702.1,MDIENS,.01)=$O(^MDD(702,P1,.1,"B",""),-1)+1
  1.  .S MDFDA(702.1,MDIENS,.02)=$S(P2:"I",1:"U")
  1.  .I P2 S MDFDA(702.1,MDIENS,.03)=P2
  1.  .S MDFDA(702.1,MDIENS,.1)=P3
  1.  .D UPDATE^DIE("","MDFDA","MDIEN")
  1.  .S @RESULTS@(0)=+$G(MDIEN(1),-1)
  1.  .L -^MDD(702,P1,0)  ;43 - add unlock
  1.  I 'P4 D  Q  ; Remove the file
  1.  .S MDFDA(702.1,MDIEN_","_P1_",",.01)="@"
  1.  .D FILE^DIE("","MDFDA","MDRET")
  1.  .S @RESULTS@(0)=$S($D(MDRET):-1,1:1)
  1.  Q
  1.  ;
  1. GETATT ; [Procedure] Get Attachments
  1.  F X=0:0 S X=$O(^MDD(702,DATA,.1,X)) Q:'X  D
  1.  .S Y=$O(@RESULTS@(""),-1)+1
  1.  .S @RESULTS@(Y)=$P(^MDD(702,DATA,.1,X,0),U,1,3)
  1.  .S $P(@RESULTS@(Y),U,4)=$G(^MDD(702,DATA,.1,X,.1))
  1.  S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
  1.  Q
  1.  ;
  1. GETERR ; [Procedure] Return list of Imaging Errors
  1.  ; DATA = Transaction IEN
  1.  F MDX=0:0 S MDX=$O(^MDD(702,DATA,.091,MDX)) Q:'MDX  D
  1.  .S MDY=+^MDD(702,DATA,.091,MDX,0)_U,Y=$P(^(0),U,2)
  1.  .D D^DIQ S MDY=MDY_Y_U
  1.  .S MDY=MDY_$P(^MDD(702,DATA,.091,MDX,0),U,3)_U_$P(^(0),U,9)
  1.  .S ^TMP($J,$O(^TMP($J,""),-1)+1)=MDY
  1.  S ^TMP($J,0)=+$O(^TMP($J,""),-1)
  1.  Q
  1.  ;
  1. NEWSTAT ; [Procedure] RPC Call to set status
  1.  S MDFDA(702,DATA,.09)=TYPE
  1.  D FILE^DIE("","MDFDA")
  1.  I TYPE=3&($G(^MDK(704.202,+DATA,0))'="") K MDFDA S MDFDA(704.202,DATA,.09)=0 D FILE^DIE("","MDFDA") K MDFDA
  1.  I TYPE=5 D
  1.  .N MDHL7,MDERR S MDHL7=$$SUB^MDHL7B(+DATA)
  1.  .I +MDHL7=-1 S MDFDA(702,DATA,.09)=2,MDFDA(702,DATA,.08)=$P(MDHL7,U,2)
  1.  .I +MDHL7=1 S MDFDA(702,DATA,.09)=5,MDFDA(702,DATA,.08)=""
  1.  .I $L($P($G(^MDD(702,+DATA,0)),"^",7),";")=1 S MDFDA(702,DATA,.07)=$$NOW^XLFDT(),MDFDA(702,DATA,.14)=$$NOW^XLFDT()
  1.  .D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR")
  1.  Q
  1.  ;
  1. RPC(RESULTS,OPTION,DATA,TYPE,FILE,RESREP) ; [Procedure] Main RPC call
  1.  N MDCANR,MDCON,MDDOC,MDFDA,MDFN,MDGST,MDHOLD,MDIEN,MDIENS,MDL,MDLOC,MDMSG,MDNEWV,MDNOTE,MDNVST,MDPDT,MDPKG,MDPROC,MDRES,MDRESU,MDRESUL,MDRET,MDS,MDSIEN,MDSTAT,MDSTUDY,MDTITL,MDTIUER,MDTRAN,MDTST,MDTSTR,MDVST,MDVSTR,MDWP,MDX,MDY
  1.  S RESULTS=$NA(^TMP($J)) K @RESULTS
  1.  D:$T(@OPTION)]"" @OPTION
  1.  D:'$D(@RESULTS) BADRPC^MDRPCU("MD TMDTRANSACTION","MDRPCOT",OPTION)
  1.  D CLEAN^DILF
  1.  Q
  1.  ;
  1. STATUS(MDIENS,MDSTAT,MDMSG) ; [Procedure] Update transaction status
  1.  S MDFDA(702,MDIENS,.08)=$G(MDMSG)
  1.  S MDFDA(702,MDIENS,.09)=MDSTAT
  1.  D FILE^DIE("","MDFDA") K MDFDA
  1.  Q
  1.  ;
  1. SUBMIT ; [Procedure] Process the Image(s) Submission.
  1.  ; Output: -1^Error Message or
  1.  ;          1^Successful Message
  1.  N MDRESUL,MDSTUDY
  1.  S MDSTUDY=+DATA,MDRESUL=""
  1.  L +^MDD(702,MDSTUDY,0):0 I '$T S @RESULTS@(0)="1^Study locked" Q  ;43 - add lock
  1.  ; Create New TIU Document
  1.  S MDRESUL=$$NEWTIUN(MDSTUDY)
  1.  ; File TIU Error messages
  1.  I +MDRESUL<0 D  Q
  1.  .D FILEMSG(MDSTUDY,"TIU",2,MDRESUL)
  1.  .S @RESULTS@(0)=MDRESUL
  1.  .L -^MDD(702,MDSTUDY,0)  ;43 - add unlock
  1.  ; Submit and export the images
  1.  S MDRESUL=$$SUBMIT^MDRPCOT1(MDSTUDY)
  1.  ; File message
  1.  D FILEMSG(MDSTUDY,"IMAGING",$S(+MDRESUL>0:+MDRESUL,1:2),MDRESUL)
  1.  S @RESULTS@(0)=MDRESUL
  1.  L -^MDD(702,MDSTUDY,0)  ;43 - add unlock
  1.  Q
  1.  ;
  1. VIEWTIU ; [Procedure] VIew the associated tiu document
  1.  I '$P(^MDD(702,+DATA,0),U,6) D  Q
  1.  .S @RESULTS@(0)="NO TIU NOTE FOR THIS STUDY"
  1.  D TGET^TIUSRVR1(.RESULTS,+$P(^MDD(702,+DATA,0),U,6))
  1.  Q
  1.  ;
  1. GETDATA(STUDY) ; [Function] Return the Necessary data for creating a TIU note.
  1.  ; Return: Patient DFN_"^"_TIU title_"^"_Hospital Location_"^"_TIU Note
  1.  ;         IEN_"^"_Consult #_"^"_CP Definition IEN_"^"_Visit String_"^"
  1.  ;         New Visit Flag
  1.  ;         or
  1.  ;         -1^Error Message
  1.  N DFN,MDCON,MDFN,MDIEN,MDDPT,MDIENS,MDLOC,MDNEWV,MDNOTE,MDNVST,MDPROC,MDVSTR,MDTITL,MDX,MDTST
  1.  S MDIEN=+STUDY,MDIENS=MDIEN_",",MDNVST=0
  1.  I $$GET1^DIQ(702,MDIENS,.01)="" Q "-1^No such study entry."
  1.  ; Get DFN
  1.  S DFN=$$GET1^DIQ(702,MDIEN,.01,"I")
  1.  I 'DFN Q "-1^No DFN."
  1.  ; Get CP Def
  1.  S MDPROC=$$GET1^DIQ(702,MDIEN,.04,"I")
  1.  I 'MDPROC Q "-1^No CP Def."
  1.  ; Get Consult
  1.  S MDCON=$$GET1^DIQ(702,MDIEN,.05,"I")
  1.  I 'MDCON Q "-1^No Consult #."
  1.  ; Get TIU Note Title
  1.  S MDTITL=$$GET1^DIQ(702.01,+MDPROC_",",.04,"I")
  1.  I 'MDTITL Q "-1^No TIU Note Title."
  1.  S MDVSTR=$$GET1^DIQ(702,MDIEN,.07)
  1.  I MDVSTR=""  Q "-1^No Visit String."
  1.  I $L(MDVSTR,";")=1 S MDNVST=1,MDDPT=$$PDT^MDRPCOT1(MDIEN),MDVSTR=";"_MDVSTR ; If new visit is selected
  1.  ; MDLOC is Hospital Location
  1.  I MDVSTR'="" D
  1.  .S MDVSTR=$$GETVSTR^MDRPCOT1(DFN,MDVSTR,MDPROC,$$GET1^DIQ(702,MDIEN,.02,"I"))
  1.  .S MDLOC=$P(MDVSTR,";",1)
  1.  I $$GET1^DIQ(702.01,+MDPROC_",",.12,"I")=1 Q DFN_"^"_MDTITL_"^"_MDLOC_"^^"_MDCON_"^"_MDPROC_"^"_MDVSTR_"^"_MDNVST
  1.  ; Does TIU doc already exist?
  1.  I $$GET1^DIQ(702,MDIEN,.06,"I") Q DFN_"^"_MDTITL_"^"_MDLOC_"^"_+$$GET1^DIQ(702,MDIEN,.06,"I")_"^"_MDCON_"^"_MDPROC_"^"_MDVSTR_"^"_MDNVST
  1.  ; Does TIU doc exist for previous transaction of this consult?
  1.  I MDCON S MDNOTE=$$PREV(MDCON,MDIEN)
  1.  Q DFN_"^"_MDTITL_"^"_MDLOC_"^"_+MDNOTE_"^"_MDCON_"^"_MDPROC_"^"_MDVSTR_"^"_MDNVST
  1.  ;
  1. NEWTIUN(STUDY) ; [Function] Create a new TIU for transaction
  1.  ; Input: STUDY - IENS of CP study entry
  1.  ; Return: TIU Document IEN
  1.  N CTR,DFN,MDCON,MDFDA,MDGST,MDL,MDLOC,MDNOTE,MDPDT,MDPROC,MDRESU,MDTITL,MDTSTR,MDVST,MDVSTR,MDWP,MDPT S CTR=0,MDGST=+STUDY,MDRESU=""
  1.  ; Get data for TIU Note Creation
  1.  S (MDTSTR,MDRESU)=$$GETDATA(MDGST)
  1.  ; File Error message
  1.  I +MDRESU<0 D FILEMSG(MDGST,"CP",2,MDRESU) Q MDRESU
  1.  I $G(MDTSTR)="" Q "-1^No Data to Create TIU Document"
  1.  F MDL="DFN","MDTITL","MDLOC","MDNOTE","MDCON","MDPROC","MDVSTR","MDNVST" D
  1.  .S CTR=CTR+1,@MDL=$P(MDTSTR,"^",CTR)
  1.  S MDVST=""
  1.  ; If previous TIU document exists, quit
  1.  I MDNOTE Q MDNOTE
  1.  I $$GET^XPAR("SYS","MD GET HIGH VOLUME",MDPROC,"I")'=""&(+$P(^MDD(702,+MDGST,0),"^",6)) Q $P(^MDD(702,+MDGST,0),"^",6)
  1.  I 'MDLOC Q "-1^No Hospital Location."
  1.  ; Create new visit, if no vstring
  1.  S MDPDT=$$PDT^MDRPCOT1(MDGST)
  1.  I 'MDPDT S MDPT=$O(^MDD(703.1,"ASTUDYID",+MDGST,0)),MDPDT=$P($G(^MDD(703.1,+MDPT,0)),U,3)
  1.  S:'MDPDT MDPDT=$P(MDVSTR,";",2) ; If No D/T Performed grab visit D/T
  1.  I $P(MDVSTR,";",3)="V" S $P(MDVSTR,";",3)="A"
  1.  ; Build variables for TIU Call
  1.  S MDWP(.05)=1 ; Undicated Status
  1.  S MDWP(1405)=+MDCON_";GMR(123," ; Package Reference
  1.  S MDWP(70201)=5 ; Default Procedure Summary Code "Machine Resulted"
  1.  I MDPDT S MDWP(70202)=MDPDT ; Date/Time Performed
  1.  ; File PCE Error message
  1.  I MDNVST S MDRESU=$$EN1^MDPCE(MDGST,$P(MDVSTR,";",2),MDPROC,$P(MDVSTR,";",3),"P") I +MDRESU S MDVST=+MDRESU,MDVSTR=$P(MDRESU,"^",2)
  1.  I MDNVST&(+MDRESU<0) D FILEMSG(MDGST,"PCE",2,$P(MDRESU,"^",2)) Q MDRESU
  1.  ; Create the TIU note stub
  1.  S MDNOTE="" D MAKE^TIUSRVP(.MDNOTE,DFN,MDTITL,$P(MDVSTR,";",2),MDLOC,$S(MDVST:MDVST,1:""),.MDWP,MDVSTR,1,1)
  1.  I '(+MDNOTE) S $P(MDNOTE,"^")=-1 Q MDNOTE
  1.  ; Finalize the transaction
  1.  S MDFDA(702,STUDY_",",.06)=+MDNOTE
  1.  S MDFDA(702,STUDY_",",.08)=""
  1.  S:MDVST>0 MDFDA(702,STUDY_",",.13)=MDVST
  1.  D FILE^DIE("","MDFDA")
  1.  D UPD^MDKUTLR(STUDY,+MDNOTE)
  1.  Q 1
  1.  ;
  1. PREV(MDC,MDS) ; [Function] Return the Previous TIU document.
  1.  N MDNEWV,MDDOC,MDTRAN,MDTIUER,MDTST
  1.  S (MDDOC,MDNEWV,MDTRAN,MDTIUER,MDTST)="" K ^TMP("MDTIUST",$J)
  1.  F  S MDTRAN=$O(^MDD(702,"ACON",MDC,MDTRAN)) Q:'MDTRAN  D  Q:'MDTRAN
  1.  .I $P(^MDD(702,MDTRAN,0),U,6) D
  1.  ..D EXTRACT^TIULQ($P(^MDD(702,MDTRAN,0),U,6),"^TMP(""MDTIUST"",$J)",MDTIUER,".01;.05;1406") Q:+MDTIUER
  1.  ..S MDTST=$G(^TMP("MDTIUST",$J,$P(^MDD(702,MDTRAN,0),U,6),.05,"E"))
  1.  ..I MDTST'="UNDICTATED"&(MDTST'="UNSIGNED") K ^TMP("MDTIUST",$J) Q
  1.  ..I MDTST="UNSIGNED"&'($G(^TMP("MDTIUST",$J,$P(^MDD(702,MDTRAN,0),U,6),1406,"I"))) K ^TMP("MDTIUST",$J) Q
  1.  ..S MDDOC=$P(^MDD(702,MDTRAN,0),U,6),MDNEWV=$P(^MDD(702,MDTRAN,0),U,7)
  1.  ..Q:'MDS
  1.  ..S MDFDA(702,MDS_",",.06)=MDDOC
  1.  ..S MDFDA(702,MDS_",",.07)=MDNEWV
  1.  ..D FILE^DIE("","MDFDA")
  1.  ..S MDTRAN=""
  1.  Q MDDOC
  1.  ;