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

MDRPCOT2.m

Go to the documentation of this file.
  1. MDRPCOT2 ; HOIFO/NCA - Object RPCs (TMDTransaction) Continued 2;10/29/04 12:20 ;3/12/08 09:18
  1. ;;1.0;CLINICAL PROCEDURES;**6,21,20**;Apr 01, 2004;Build 9
  1. ; Integration Agreements:
  1. ; IA# 2056 [Supported] Call to DIQ.
  1. ; IA# 2693 [Subscription] TIU Extractions.
  1. ; IA# 3468 [Subscription] GMRCCP API.
  1. ; IA# 3535 [Subscription] Calls to TIUSRVP.
  1. ; IA# 4795 [Subscription] Calls to TIUSRVP2.
  1. ; IA# 5407 [Subscription] Call routine ORWTPN.
  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")=%
  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. 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. 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")
  1. Q
  1. ;
  1. SUBMIT(MDDATA,MDESIG,MDG1) ; [Procedure] Process the Image(s) Submission.
  1. ; Input: MDDATA - Study ID
  1. ; MDESIG - Electronic Signature
  1. ; MDG1 - ^TMP global with the text of the report
  1. ; Output: -1^Error Message or
  1. ; 1^Successful Message
  1. N MDRESUL,MDSTUDY,MDG2,RES
  1. S MDSTUDY=+MDDATA,(RES,MDRESUL)=""
  1. ; Create New TIU Document
  1. S MDRESUL=$$NEWTIUN(MDSTUDY)
  1. ;S MDRESUL=$$NEWTIUN(MDSTUDY)
  1. ; File TIU Error messages
  1. ;I +MDRESUL<0 D FILEMSG(MDSTUDY,"TIU",2,MDRESUL) Q MDRESUL
  1. I +MDRESUL<0 D Q RES
  1. .D FILEMSG(MDSTUDY,"TIU",2,MDRESUL)
  1. .S RES=MDRESUL
  1. ; Update the text of the TIU document
  1. S MDG2=@($NA(MDG1))
  1. I +$O(@MDG2@(""),-1) D Q:RES'="" RES
  1. .S MDRESUL=$$UPDATE(MDSTUDY,MDESIG,MDG2)
  1. .I +MDRESUL<0 D Q
  1. ..D FILEMSG(MDSTUDY,"TIU",2,MDRESUL)
  1. ..S RES=MDRESUL
  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 RES=MDRESUL
  1. Q RES
  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,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,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. ; Does TIU doc already exist?
  1. S MDNOTE=""
  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,MDCONRS,MDFDA,MDGST,MDL,MDLOC,MDNOTE,MDPDT,MDPROC,MDPT,MDRESU,MDTITL,MDTSTR,MDVST,MDVSTR,MDWP 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,MDRESU)=""
  1. ; If previous TIU document exists, quit
  1. I 'MDLOC Q "-1^No Hospital Location."
  1. I MDNOTE Q MDNOTE
  1. ; Create new visit, if no vstring
  1. S MDPDT=$$PDT^MDRPCOT1(MDGST)
  1. I 'MDPDT S MDPT=$O(^MDD(703.1,"ASTUDYID",+MDGST,""),-1),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. ; Build variables for TIU Call
  1. S MDWP(.05)=1 ; Undictated 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. S MDRESU=$$EN1^MDPCE(MDGST,$P(MDVSTR,";",2),(MDPROC_"^"_MDLOC),$P(MDVSTR,";",3),"P") I +MDRESU S MDVST=+MDRESU,MDVSTR=$P(MDRESU,"^",2)
  1. ;I MDNVST S MDRESU=$$EN1^MDPCE1(MDGST,MDPDT,MDPROC,$P(MDVSTR,";",3),"P") I +MDRESU S MDVST=+MDRESU,MDVSTR=$P(MDRESU,"^",2)
  1. ;I 'MDNVST S MDVST=$P($G(^MDD(702,+MDGST,1)),U) I 'MDVST S MDRESU=$$EN1^MDPCE(MDGST,MDPDT,(MDPROC_"^"_MDLOC),$P(MDVSTR,";",3),"P") I +MDRESU S MDVST=+MDRESU
  1. ;I 'MDNVST&$$CHK^MDPCE1(MDGST) S MDRESU=$$EN1^MDPCE1(MDGST,MDPDT,MDPROC,$P(MDVSTR,";",3),"P") I +MDRESU S MDVST=+MDRESU
  1. I +MDRESU<0 D FILEMSG(MDGST,"PCE",2,$P(MDRESU,"^",2)) Q MDRESU
  1. ; Create the TIU note stub
  1. S MDVST="" S MDVST=+$G(^MDD(702,MDGST,1))
  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. D FILE^DIE("","MDFDA") K MDFDA
  1. D UPD^MDKUTLR(STUDY,+MDNOTE)
  1. ;S MDCONRS=$$CPDOC^GMRCCP(+MDCON,+MDNOTE,2)
  1. Q 1
  1. ;
  1. UPDATE(STUDY,SIGN,MDGLB) ; Update the TIU document with the text
  1. N MDK,MDNOTE,MDPPR,MDRESU,MDS,MDTI,MDTIUER,MDWP,MDV,MDV1,MDVAU S (MDNOTE,MDTIUER)="" K MDWP,^TMP("MDTIUST",$J)
  1. F MDK=0:0 S MDK=$O(@MDGLB@(MDK)) Q:'MDK S MDWP("TEXT",MDK,0)=$G(@MDGLB@(MDK))
  1. S MDTI=$$GET1^DIQ(702,STUDY_",",.06,"I") Q:'MDTI "-1^No Note."
  1. S MDWP(.05)=5
  1. S MDWP(1202)=DUZ
  1. D GETDCOS^ORWTPN(.MDVAU,DUZ)
  1. I +MDVAU S MDWP(1506)=1,MDWP(1208)=+MDVAU
  1. D UPDATE^TIUSRVP(.MDNOTE,+MDTI,.MDWP,1)
  1. I '+MDNOTE S MDNOTE="-1^"_$P(MDNOTE,"^",2) Q MDNOTE
  1. ; Sign TIU Document
  1. S MDS=$$SIGN(MDTI,SIGN) I MDS<0 Q MDS
  1. ;N MDFDA S MDFDA(704.202,STUDY_",",.09)=0
  1. S $P(^MDK(704.202,STUDY,0),"^",9)=0
  1. ;D FILE^DIE("","MDFDA")
  1. N MDFDA S MDFDA(702,STUDY_",",.09)=3
  1. D FILE^DIE("","MDFDA")
  1. K ^MDK(704.202,"AS",1,STUDY)
  1. S ^MDK(704.202,"AS",0,STUDY)=""
  1. Q 1
  1. SIGN(MDTIUIN,MDSIGN) ; Sign the TIU Document
  1. ; [Function] TIU SIGN RECORD
  1. ;Input Parameters:
  1. ; 1. TIUIEN [Literal/Required] TIU internal Entry Number
  1. ; 2. MDSIGN [Literal/Required] User Signature
  1. N MDSRES,X
  1. S MDSRES=""
  1. D SIGN^TIUSRVP2(.MDSRES,MDTIUIN,MDSIGN)
  1. I +MDSRES>0 Q "-1^"_$P(MDSRES,"^",2)
  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