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

MDCLIO1.m

Go to the documentation of this file.
  1. MDCLIO1 ;HINES OIFO/DP - CliO backend driver (Continuation);02 Sep 2005
  1. ;;1.0;CLINICAL PROCEDURES;**16**;Apr 01, 2004;Build 280
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; This routine uses the following IAs:
  1. ; # 3027 - NOTICE^DGSEC4 Registration (supported)
  1. ; # 5407 - GETDCOS^ORWTPN OE/RR (controlled subscription)
  1. ; # 3568 - LNGCP^TIUCP TIU (controlled subscription)
  1. ; # 3535 - TIUSRVP calls TIU (controlled subscription)
  1. ; # 1800 - REQCOS^TIUSRVA TIU (controlled subscription)
  1. ; # 2876 - LONGLIST^TIUSRVD TIU (controlled subscription)
  1. ; # 2263 - XPAR calls Toolkit (supported)
  1. ; #10045 - HASH^XUSHSHP Kernel (supported)
  1. ; # 2240 - ENCRYP^XUSRB1 Kernel (supported)
  1. ; # 2241 - DECRYP^XUSRB1 Kernel (supported)
  1. ; # 4866 - access ^GMRD(120.51,"AVUID" Vitals (private)
  1. ; # 4114 - access ^PXRMINDX(120.5 Clinical Reminders (controlled subscription)
  1. ; #10040 - access ^SC( Scheduling (supported)
  1. ;
  1. GETPT ; Does an old style lookup on file 2 so that we don't have to use a PK
  1. D FIND^DIC(2,,.01,"KMP",P2(0),"*")
  1. F X=0:0 S X=$O(^TMP("DILIST",$J,X)) Q:'X S @MDROOT@(+^(X,0))=""
  1. Q
  1. GETESIG ; Returns record with boolean of proper E-Sig entered
  1. D NEWDOC^MDCLIO("RESULTS","ESIG-VALIDATION")
  1. D XMLHDR^MDCLIO("RECORD")
  1. D XMLDATA^MDCLIO("EXTERNAL",P2(0))
  1. S X=$G(P2(0)) D HASH^XUSHSHP S MDX=X
  1. D XMLDATA^MDCLIO("INTERNAL",MDX)
  1. D XMLDATA^MDCLIO("VALID",MDX=$$GET1^DIQ(200,DUZ_",",20.4,"I"))
  1. D XMLFTR^MDCLIO("RECORD")
  1. D ENDDOC^MDCLIO("RESULTS")
  1. Q
  1. GETKRDXA(MDPT,MDSTRT,MDSTOP) ; Returns all actions for patient MDPT active between MDSTRT & MDSTOP
  1. Q
  1. GETKRDXE(MDTASK,MDSTRT,MDSTOP) ; Returns all events for Kardex Action MDTASK active between MDSTRT & MDSTOP
  1. Q
  1. GETGUID(X) ; Returns a string formatted as a GUID (NO GUARANTEE OF UNIQUENESS)
  1. S X=""
  1. F S X=X_$$BASE^XLFUTL($R(16),10,16) Q:$L(X)>31
  1. S X="{"_$E(X,1,8)_"-"_$E(X,9,12)_"-"_$E(X,13,16)_"-"_$E(X,17,20)_"-"_$E(X,21,32)_"}"
  1. Q
  1. ISGUID(MDX) ; Returns true if X is in the format of a GUID
  1. N X,Y
  1. Q:$L(MDX)'=38 0
  1. Q:MDX'?1"{"8UN1"-"4UN1"-"4UN1"-"4UN1"-"12UN1"}" 0
  1. ; Scan for Uppercase character above F
  1. X "S X=1 F Y=71:1:90 I MDX[$C(Y) S X=0 Q"
  1. Q X
  1. ;
  1. PXRMALL ; Full rebuild of the Clinical Reminders Index - Only Verified sent for rebuild
  1. F MD=0:0 S MD=$O(^MDC(704.117,MD)) Q:'MD D:$P(^(MD,0),U,9)=1 PXRMONE(MD)
  1. Q
  1. PXRMONE(MDIEN) ; Maintain the Clinical Reminders Index
  1. N MDVUID,MDVITAL,MDGBL,MDDFN,MDDT,MDSTAT
  1. S MDVUID=$$GET1^DIQ(704.117,MDIEN_",",".07:99.99","I") Q:MDVUID=""
  1. S MDVITAL=$O(^GMRD(120.51,"AVUID",MDVUID,0)) Q:'MDVITAL
  1. S MDGUID=$P(^MDC(704.117,MDIEN,0),U),MDDFN=$P(^(0),U,8),MDDT=$P(^(0),U,5),MDSTAT=$P(^(0),U,9)
  1. Q:MDGUID=""!('MDDFN)!('MDDT) ; Just in case :)
  1. S MDGBL=$NA(^PXRMINDX(120.5))
  1. I MDSTAT=1 D
  1. .S @MDGBL@("PI",MDDFN,MDVITAL,MDDT,MDGUID)=""
  1. .S @MDGBL@("IP",MDVITAL,MDDFN,MDDT,MDGUID)=""
  1. E D
  1. .K @MDGBL@("PI",MDDFN,MDVITAL,MDDT,MDGUID)
  1. .K @MDGBL@("IP",MDVITAL,MDDFN,MDDT,MDGUID)
  1. Q
  1. LOGSEC ; Logs a security hit in PIMS
  1. D NOTICE^DGSEC4(.MDRET,P2(0))
  1. S @RESULTS@(0)=$S(MDRET:"1^Logged",1:"-1^Unable to log")
  1. Q
  1. GETTIUCP ; Gets a list of CP Class TIU notes - bypass regular lookup stuff and call directly
  1. N MDRET K @RESULTS
  1. S MDDATA=$$UP^XLFSTR(P2(0))
  1. D NEWDOC^MDCLIO("RESULTS","VERSION INFORMATION")
  1. D LNGCP^TIUCP(.MDRET,MDDATA)
  1. I $D(MDRET(44)),$P($P(MDRET(44),U,2),$$UP^XLFSTR(P2(0)))="" D XMLFTR^MDCLIO("RESULTS") Q
  1. F Y=0:0 S Y=$O(MDRET(Y)) Q:'Y D:$P(MDRET(Y),U,2)?@("1"""_MDDATA_""".E")
  1. .D XMLHDR^MDCLIO("RECORD")
  1. .D XMLDATA^MDCLIO("ID",$P(MDRET(Y),U,1))
  1. .D XMLDATA^MDCLIO("NAME",$P(MDRET(Y),U,2))
  1. .D XMLFTR^MDCLIO("RECORD")
  1. K MDDATA
  1. D ENDDOC^MDCLIO("RESULTS")
  1. Q
  1. GETTIUPN ; Gets list of all Progress Note Titles
  1. N MDRET K @RESULTS
  1. S MDDATA=$$UP^XLFSTR(P2(0))
  1. D NEWDOC^MDCLIO("RESULTS","VERSION INFORMATION")
  1. D LONGLIST^TIUSRVD(.MDRET,3,MDDATA)
  1. I $D(MDRET(44)),$P($P(MDRET(44),U,2),$$UP^XLFSTR(P2(0)))="" D XMLFTR^MDCLIO("RESULTS") Q
  1. F Y=0:0 S Y=$O(MDRET(Y)) Q:'Y D:$P(MDRET(Y),U,2)?@("1"""_MDDATA_""".E")
  1. .D XMLHDR^MDCLIO("RECORD")
  1. .D XMLDATA^MDCLIO("ID",$P(MDRET(Y),U,1))
  1. .D XMLDATA^MDCLIO("NAME",$P(MDRET(Y),U,2))
  1. .D XMLFTR^MDCLIO("RECORD")
  1. K MDDATA
  1. D ENDDOC^MDCLIO("RESULTS")
  1. Q
  1. GETUSER ; Gets the current users record in ^VA(200,
  1. S MDROOT="MDROOT"
  1. S MDROOT(DUZ)=""
  1. Q
  1. GETLST ; Get a list of observations sent down in P2(0..n)=ID
  1. S MDROOT=$NA(^TMP("MDCLIO",$J)) K @MDROOT
  1. S MDID=""
  1. F S MDID=$O(P2(MDID)) Q:MDID="" D:P2(MDID)]""
  1. .S X=$O(^MDC(704.117,"PK",P2(MDID),0)) S:X @MDROOT@(0,X)=""
  1. Q
  1. GETONE(ID) ; Get single Observation + Children if any
  1. S X=$$FIND1^DIC(704.117,,"KXP",ID(0))
  1. Q:'X S @MDROOT@(0,X)=""
  1. F Y=0:0 S Y=$O(^MDC(704.117,"AP",X,Y)) Q:'Y S @MDROOT@(Y,$O(^MDC(704.117,"AP",X,Y,0)))=""
  1. Q
  1. LOCATION ; Get list of wards, clinics and non-stops
  1. N MDNOW D NOW^%DTC S MDNOW=%
  1. S MDROOT=$NA(^TMP("MDCLIO",$J)) K @MDROOT
  1. F X=0:0 S X=$O(^SC(X)) Q:'X D:"CWN"[$P(^(X,0),U,3)
  1. .I '+$G(^SC(X,"I")) S @MDROOT@(X)="" Q ; No deactivation date on file
  1. .I +^SC(X,"I")<MDNOW&('$P(^("I"),U,2)) Q ; No reactivation date
  1. .I +^SC(X,"I")<MDNOW&($P(^("I"),U,2)>MDNOW) Q ; future reactivation date
  1. .S @MDROOT@(X)=""
  1. Q
  1. ;
  1. GETSUPPG ; Get list of supplemental/optional pages for a date range
  1. ; P2(0)=Patient DFN
  1. ; P2(1)=Start Date
  1. ; P2(2)=Stop Date
  1. S MDDFN=P2(0),MDDT=P2(2)+.0000001,MDROOT=$NA(^TMP("MDCLIO",$J)) K @MDROOT
  1. S MDFR=$$FMDT^MDCLIO(P2(1))
  1. S MDDT=$$FMDT^MDCLIO(P2(2))+.0000001
  1. F S MDDT=$O(^MDC(704.1122,"ADT",MDDFN,MDDT),-1) Q:'MDDT D
  1. .S MDIEN="" F S MDIEN=$O(^MDC(704.1122,"ADT",MDDFN,MDDT,MDIEN),-1) Q:'MDIEN D
  1. ..I $G(^MDC(704.1122,MDIEN,.2)) Q:$G(^(.2))<MDFR ; Deactivated before start date
  1. ..I +$G(^MDC(704.1122,MDIEN,.2))&($P($G(^MDC(704.1122,MDIEN,.1)),U,4)=1) Q ; Deactivated Optional Page
  1. ..S @MDROOT@(MDIEN)=""
  1. Q
  1. GETHL7(ID) ; Get text of HL7 Message from 704.002 entry
  1. S IEN=+$$FIND1^DIC(704.002,,"KX",ID)
  1. D XMLHDR^MDCLIO("HL7_TEXT")
  1. D:IEN>0
  1. .D GETMSG^MDCPHL7B(.MDRET,IEN)
  1. .S X=MDRET F S X=$Q(@X) Q:$E(X,1,$L(MDRET)-1)'=$E(MDRET,1,$L(MDRET)-1) D
  1. ..D XMLADD^MDCLIO($$XMLSAFE^MDCLIO(@X))
  1. D XMLFTR^MDCLIO("HL7_TEXT")
  1. Q
  1. SETACL ; Sets the ACL for an Item
  1. D SETACL^MDCLIO
  1. Q
  1. ;
  1. DELACL ; Removes and item from ACL
  1. D DELACL^MDCLIO
  1. Q
  1. ;
  1. SUBMIT ; Submits an HL7 message back to the queue
  1. N MDMSG,MDSTAT
  1. S MDMSG=$$FIND1^DIC(704.002,,"KX",P2(0))
  1. I MDMSG<1 S @RESULTS@(0)="-1^NO SUCH MESSAGE" Q
  1. S MDSTAT=$G(P2(1),3) ; Default to error if you didn't get a status
  1. D UPDATERP^MDCPHL7B(.MDRET,MDMSG,MDSTAT)
  1. S @RESULTS@(0)="1^Submitted"
  1. Q
  1. QRYDATE(MDRET,MDSTRT,MDSTOP) ; Get list of all observations by DATE/TIME
  1. K @MDRET
  1. F X=MDSTRT-.0000001:0 S X=$O(^MDC(704.117,"ADT",X)) Q:'X!(X>MDSTOP) D
  1. .F Y=0:0 S Y=$O(^MDC(704.117,"ADT",X,Y)) Q:'Y D
  1. ..Q:$P(^MDC(704.117,Y,0),U,9)'=1
  1. ..S @MDRET@($O(@MDRET@(""),-1)+1)=$P(^MDC(704.117,Y,0),U)
  1. S @MDRET@(0)=+$O(@MDRET@(""),-1)
  1. Q
  1. QRYLST(MDRET,MDDFN,MDITEM,MDSTRT,MDSTOP) ; Get list of observations by VUID or TERM NAME
  1. N MDTERM
  1. K @MDRET
  1. S MDSTRT=$G(MDSTRT,DT\1) ; Default today @00:00
  1. S MDSTOP=$G(MDSTOP,DT\1+.24) ; Default today @24:00
  1. S MDTERM=$$FIND1^DIC(704.101,"","PKMX",MDITEM,"C^VUID","I $P(^(0),U,5)=1")
  1. I MDTERM<1 S @MDRET@(0)="-1^Cannot find term '"_MDITEM_"'" Q
  1. F X=MDSTRT-.0000001:0 S X=$O(^MDC(704.117,"PT",MDDFN,X)) Q:'X!(X>MDSTOP) D
  1. .F Y=0:0 S Y=$O(^MDC(704.117,"PT",MDDFN,X,Y)) Q:'Y D
  1. ..Q:$P(^MDC(704.117,Y,0),U,9)'=1
  1. ..Q:$P(^MDC(704.117,Y,0),U,7)'=MDTERM
  1. ..S @MDRET@($O(@MDRET@(""),-1)+1)=$P(^MDC(704.117,Y,0),U)
  1. S @MDRET@(0)=+$O(@MDRET@(""),-1)
  1. Q
  1. ;
  1. QRYOBS(MDRET,MDID) ; Return a single observation
  1. N MDTMP
  1. K @MDRET
  1. S MDIEN=$$FIND1^DIC(704.117,"","PKX",MDID,"PK")
  1. I MDIEN<1 S @MDRET@(0)="-1^No such observation '"_MDID_"'" Q
  1. D GETS^DIQ(704.117,MDIEN_",","*","EIR","MDTMP")
  1. M @MDRET=MDTMP(704.117,MDIEN_",") K MDTMP
  1. S @MDRET@("TERM_ID","I")=$$GET1^DIQ(704.117,MDIEN_",",".07:99.99")
  1. S @MDRET@("TERM_ID","E")=$$GET1^DIQ(704.117,MDIEN_",",".07:.02")
  1. D:$$GET1^DIQ(704.117,MDIEN_",",".07:.06","I")=3 ; Coded data values
  1. .S MDTMP=$$FIND1^DIC(704.101,"","PKX",@MDRET@("SVALUE","I"),"PK")
  1. .S @MDRET@("SVALUE","E")=$$GET1^DIQ(704.101,MDTMP_",",.02)
  1. D QRYQUAL(MDRET,MDIEN)
  1. D QRYCTX($NA(@MDRET@("CONTEXT")),MDID)
  1. Q
  1. ;
  1. QRYQUAL(MDRET,MDIEN) ; Returns the qualifiers for obs in MDIEN
  1. N MDQUAL
  1. F Y=0:0 S Y=$O(^MDC(704.118,"PK",MDIEN,Y)) Q:'Y D
  1. .S MDQUAL=$$GET1^DIQ(704.101,Y_",",".05:.02")
  1. .S @MDRET@(MDQUAL,"I")=$$GET1^DIQ(704.101,Y_",","99.99")
  1. .S @MDRET@(MDQUAL,"E")=$$GET1^DIQ(704.101,Y_",",".02")
  1. Q
  1. ;
  1. QRYCTX(MDRET,MDID) ; We need a terminology based context observation relationship here
  1. N MDIEN,MDCTX,MDDT,MDFROM,MDTO,MDDFN,MDTERM,MDCNT,MDXID
  1. S MDIEN=+$$FIND1^DIC(704.117,"","PKX",MDID,"PK") Q:MDIEN<1
  1. S MDCTX=$$GET1^DIQ(704.117,MDIEN_",",.07) ; GET THE PRIMARY TERM (GUID)
  1. ; FILTER OUT EVERYTHING BUT SpO2 for now
  1. Q:MDCTX'="{5F84DD55-3CCF-094C-2536-B51EB7FAD999}"
  1. S MDDFN=+$$GET1^DIQ(704.117,MDIEN_",",.08,"I") ; GET THE PATIENT
  1. S MDDT=+$$GET1^DIQ(704.117,MDIEN_",",.05,"I") ; GET THE OBS DATE
  1. S MDFROM=$$FMADD^XLFDT(MDDT,0,0,0,-30) ; PREVIOUS 30 SECONDS
  1. S MDTO=$$FMADD^XLFDT(MDDT,0,0,0,30) ; NEXT 30 SECONDS
  1. ; Now we find the context observations
  1. F MDDT=MDFROM:0 S MDDT=$O(^MDC(704.117,"PT",MDDFN,MDDT)) Q:'MDDT!(MDDT>MDTO) D
  1. .F MDOBS=0:0 S MDOBS=$O(^MDC(704.117,"PT",MDDFN,MDDT,MDOBS)) Q:'MDOBS D
  1. ..Q:$$GET1^DIQ(704.117,MDOBS_",",.09,"I")'=1 ; Verfied Only
  1. ..S MDXID=$$GET1^DIQ(704.117,MDOBS_",",.01)
  1. ..Q:MDXID=MDID ; You should ignore yourself in this loop
  1. ..S MDTERM=$$GET1^DIQ(704.117,MDOBS_",",".07")
  1. ..; INSERT FILTER CODE FOR O2 Flowrate and Concentration here - In the future we will find all context terms for an observation in terminology
  1. ..Q:(MDTERM'="{56F82CAC-3564-46CE-A520-1025020DADE9}")&(MDTERM'="{3BB314E8-9BBB-480E-B34E-B56EDE43BAC4}")
  1. ..S MDCNT=$O(@MDRET@(""),-1)+1,@MDRET@(0)=MDCNT
  1. ..S @MDRET@(MDCNT,"OBS_ID","I")=MDXID
  1. ..S @MDRET@(MDCNT,"OBS_ID","E")=MDXID
  1. ..S @MDRET@(MDCNT,"TERM_ID","I")=$$GET1^DIQ(704.117,MDOBS_",",".07:99.99")
  1. ..S @MDRET@(MDCNT,"TERM_ID","E")=$$GET1^DIQ(704.117,MDOBS_",",".07:.02")
  1. ..S @MDRET@(MDCNT,"SVALUE","I")=$$GET1^DIQ(704.117,MDOBS_",",".1","I")
  1. ..S @MDRET@(MDCNT,"SVALUE","E")=$$GET1^DIQ(704.117,MDOBS_",",".1","E")
  1. ..D QRYQUAL($NA(@MDRET@(MDCNT)),MDOBS)
  1. Q
  1. GETOBS(MDPAR) ; Get list of observations by date
  1. S MDPT=MDPAR(0)
  1. S MDROOT=$NA(^TMP("MDCLIO",$J)) K @MDROOT
  1. S MDFR=$$FMDT^MDCLIO(MDPAR(1))-.0000001
  1. S MDTO=$$FMDT^MDCLIO(MDPAR(2))\1+.235959
  1. F S MDFR=$O(^MDC(704.117,"PT",MDPT,MDFR)) Q:'MDFR!(MDFR>MDTO) D
  1. .F Y=0:0 S Y=$O(^MDC(704.117,"PT",MDPT,MDFR,Y)) Q:'Y S @MDROOT@(Y)=""
  1. Q
  1. GETBYDT ; Get list of observations by date
  1. S MDPT=P2(0)
  1. S MDROOT=$NA(^TMP("MDCLIO",$J)) K @MDROOT
  1. S MDFR=$$FMDT^MDCLIO(P2(1))-.0000001
  1. S MDTO=$$FMDT^MDCLIO(P2(2))
  1. F S MDFR=$O(^MDC(704.117,"PT",MDPT,MDFR)) Q:'MDFR!(MDFR>MDTO) D
  1. .F Y=0:0 S Y=$O(^MDC(704.117,"PT",MDPT,MDFR,Y)) Q:'Y S @MDROOT@(Y)=""
  1. Q
  1. GETLOG ; Get list of date/time pairs with data
  1. S MDPT=P2(0),MDROOT=$NA(^TMP("MDCLIO",$J)) K @MDROOT
  1. S MDFR=$$FMDT^MDCLIO(P2(1))-.0000001
  1. S MDTO=$$FMDT^MDCLIO(P2(2))
  1. S MDSTAT=""
  1. F S MDSTAT=$O(^MDC(704.117,"AS",MDSTAT)) Q:MDSTAT="" D
  1. .S MDDT=MDFR
  1. .F S MDDT=$O(^MDC(704.117,"AS",MDSTAT,MDPT,MDDT)) Q:'MDDT!(MDDT>MDTO) D
  1. ..S @MDROOT@(MDSTAT,MDDT,$O(^MDC(704.117,"AS",MDSTAT,MDPT,MDDT,0)))=""
  1. Q
  1. GETBYST ; Get list of observations by patient, status, and date range
  1. S MDPT=P2(0),MDSTAT=P2(3),MDROOT=$NA(^TMP("MDCLIO",$J)) K @MDROOT
  1. S MDFR=$$FMDT^MDCLIO(P2(1))-.0000001
  1. S MDTO=$$FMDT^MDCLIO(P2(2))
  1. F S MDFR=$O(^MDC(704.117,"AS",MDSTAT,MDPT,MDFR)) Q:'MDFR!(MDFR>MDTO) D
  1. .F Y=0:0 S Y=$O(^MDC(704.117,"AS",MDSTAT,MDPT,MDFR,Y)) Q:'Y S @MDROOT@(Y)=""
  1. Q
  1. AUDIT(Y) ; Looks up the audit records for an observation in external format
  1. S MDROOT=$NA(^MDC(704.119,"ALOG",+$O(^MDC(704.117,"PK",Y,0))))
  1. Q
  1. QUAL ; Retrieves all qualifiers for an observation - MDIENS = iens of observation from MDCLIO
  1. N MDQUAL
  1. F MDQUAL=0:0 S MDQUAL=$O(^MDC(704.118,"PK",+MDIENS,MDQUAL)) Q:'MDQUAL D
  1. .D XMLDATA^MDCLIO($$GET1^DIQ(704.101,MDQUAL_",",".05:.02","I"),$$GET1^DIQ(704.101,MDQUAL_",",".01","I"))
  1. Q
  1. SETS ; Retrieve the sets this observation belongs to
  1. D XMLHDR^MDCLIO("SETS")
  1. N MDSET F MDSET=0:0 S MDSET=$O(^MDC(704.1161,"AS",+MDIENS,MDSET)) Q:'MDSET D
  1. .F MDX=0:0 S MDX=$O(^MDC(704.1161,"AS",+MDIENS,MDSET,MDX)) Q:'MDX D
  1. ..D XMLHDR^MDCLIO("SET")
  1. ..D XMLDATA^MDCLIO("VALUE",$$GET1^DIQ(704.1161,MDX_",",.01))
  1. ..D XMLFTR^MDCLIO("SET")
  1. D XMLFTR^MDCLIO("SETS")
  1. Q
  1. GETQUAL ; Returns qualifiers of type P2(1) for term P2(0)
  1. ; Set Y to the IEN of the Term
  1. S X=$$FIND1^DIC(704.101,"","KX",P2(0))
  1. S MDROOT=$NA(^TMP("MDCLIO",$J)) K @MDROOT
  1. S MDGBL=$NA(^MDC(704.103,"PK",X))
  1. F S MDGBL=$Q(@MDGBL) Q:MDGBL="" Q:$QS(MDGBL,3)'=X D
  1. .I $P(^MDC(704.101,$QS(MDGBL,5),0),U,5)=P2(1) D
  1. ..S @MDROOT@($QS(MDGBL,4),$QS(MDGBL,6))=""
  1. Q
  1. PROCIEN(Y) ; Converts CP DEFINITION (procedure) name to IEN
  1. Q $$FIND1^DIC(702.01,,"KXP",Y)
  1. INSTIEN(Y) ; Converts CP INSTRUMENT name to IEN
  1. Q $$FIND1^DIC(702.09,,"KXP",Y)
  1. GETINST ; Gathers instruments for a procedure
  1. S X=$$PROCIEN(P2(0))
  1. F Y=0:0 S Y=$O(^MDS(702.01,+X,.1,"B",Y)) Q:'Y S @MDROOT@(Y)=""
  1. Q
  1. ADDINST ; Adds an instrument definition to a procedure
  1. ; This is a legacy multiple in file 702.01 so it has to be done in an odd way
  1. N MDPROC,MDINST
  1. S MDPROC=$$PROCIEN(P2(0))
  1. S MDINST=$$INSTIEN(P2(1))
  1. I '+MDPROC S @RESULTS@(0)="-1^Unable to find procedure "_P2(0)
  1. I '+MDINST S @RESULTS@(0)="-1^Unable to find instrument "_P2(1)
  1. S MDFDA(702.011,"+1,"_MDPROC_",",.01)=MDINST
  1. D UPDATE^DIE("","MDFDA")
  1. S @RESULTS@(0)="1^Instrument added."
  1. Q
  1. DELINST ; Deletes all instruments from a procedure definition
  1. ; This is a legacy multiple in file 702.01 so it has to be done in an odd way
  1. N MDPROC
  1. S MDPROC=$$PROCIEN(P2(0))
  1. F X=0:0 S X=$O(^MDS(702.01,MDPROC,.1,X)) Q:'X S MDFDA(702.011,X_","_MDPROC_",",.01)="@"
  1. D FILE^DIE("","MDFDA")
  1. S @RESULTS@(0)="1^Instrument list cleared."
  1. Q
  1. GETVER ; Get Version Information
  1. D NEWDOC^MDCLIO("RESULTS","VERSION INFORMATION")
  1. I $G(P2(0))="" D GETLST^XPAR(.MDRET,"SYS","MD VERSION INFORMATION","Q")
  1. I $G(P2(0))]"" S MDRET(1)=P2(0)_"^"_$$GET^XPAR("SYS","MD VERSION INFORMATION",P2(0),"Q")
  1. ; Switch the lines below once we are really checking versions
  1. ;F MDRET=0:0 S MDRET=$O(MDRET(MDRET)) Q:'MDRET D:$P(MDRET(MDRET),"^",2)]""
  1. F MDRET=0:0 S MDRET=$O(MDRET(MDRET)) Q:'MDRET D
  1. .D XMLHDR^MDCLIO("RECORD")
  1. .S MDVER=$P(MDRET(MDRET),"^",1)
  1. .D XMLDATA^MDCLIO("VERSION",MDVER)
  1. .S MDVER=$P(MDRET(MDRET),"^",2)
  1. .; Switch the lines below once we are really checking versions
  1. .;D XMLDATA^MDCLIO("COMPATIBLE",+MDVER)
  1. .D XMLDATA^MDCLIO("COMPATIBLE",1)
  1. .D XMLDATA^MDCLIO("CRC32",$P(MDVER,";",2))
  1. .D XMLDATA^MDCLIO("PRODUCTION_RELEASE",+$P(MDVER,";",3))
  1. .D XMLDATA^MDCLIO("COMMENT",$P(MDVER,";",4))
  1. .D XMLFTR^MDCLIO("RECORD")
  1. D ENDDOC^MDCLIO("RESULTS")
  1. Q
  1. GETVF ; Get View Filters
  1. N MDVIEW,MDTERM,MDIEN,MDXROOT
  1. S MDXROOT=$NA(^TMP("MDXQUERY",$J)) K @MDXROOT
  1. S MDVIEW=+$O(^MDC(704.111,"PK",P2(0),0))
  1. F MDTERM=0:0 S MDTERM=$O(^MDC(704.1112,"PK",MDVIEW,P2(1),MDTERM)) Q:'MDTERM D
  1. .F MDIEN=0:0 S MDIEN=$O(^MDC(704.1112,"PK",MDVIEW,P2(1),MDTERM,MDIEN)) Q:'MDIEN S @MDXROOT@(MDIEN)=MDIEN
  1. D XQUERY^MDCLIO
  1. Q
  1. NEWNOTE ; Returns a new note ID
  1. D GETGUID(.MD)
  1. K ^TMP("MDNOTE",$J,MD)
  1. D QUICKDOC^MDCLIO("ID",MD)
  1. Q
  1. CLRNOTE ; Clears any text in a temporary note P2(0)=Temporary ID
  1. K ^TMP("MDNOTE",$J,P2(0))
  1. S @RESULTS@(0)="1^Note Cleared"
  1. Q
  1. ADDTEXT ; Adds P2(1..n) to the note in P2(0)
  1. F X=0:0 S X=$O(P2(X)) Q:'X D
  1. .S Y=$O(^TMP("MDNOTE",$J,P2(0),""),-1)+1
  1. .S ^TMP("MDNOTE",$J,P2(0),Y,0)=P2(X)
  1. S @RESULTS@(0)=$O(P2(""),-1)_"^Lines added"
  1. Q
  1. ;
  1. SENDMAIL ; Sends an EMail Message
  1. D SENDMAIL^MDCLIO
  1. ;
  1. GETTIU ; Gets Privs for note title in P2(0)
  1. N MDRET
  1. D NEWDOC^MDCLIO("RESULTS","TIU PRIVS")
  1. D XMLHDR^MDCLIO("RECORD")
  1. D REQCOS^TIUSRVA(.MDRET,P2(0))
  1. D XMLDATA^MDCLIO("REQUIRE_COSIGN",MDRET)
  1. D GETDCOS^ORWTPN(.MDRET,DUZ)
  1. D:+MDRET
  1. .D XMLDATA^MDCLIO("DEF_COSIGN_ID",$P(MDRET,U,1))
  1. .D XMLDATA^MDCLIO("DEF_COSIGN_NAME",$P(MDRET,U,2))
  1. D XMLFTR^MDCLIO("RECORD")
  1. D ENDDOC^MDCLIO()
  1. Q
  1. ;
  1. SIGNTIU ; Signs the note
  1. N MDNOW,MDESIG,MDNOTE,MDTEXT,MDVAU,MDRET
  1. D NOW^%DTC S MDNOW=%
  1. S MDESIG=$$DECRYP^XUSRB1(P2(4)),MDESIG=$$ENCRYP^XUSRB1(MDESIG)
  1. D MAKE^TIUSRVP(.MDNOTE,P2(1),P2(2),MDNOW,P2(3))
  1. I MDNOTE<1 S @RESULTS@(0)="-1^Unable to create note." Q
  1. S MDTEXT(2)=$NA(^TMP("MDNOTE",$J,P2(0)))
  1. ; Check for a co-signer
  1. I +$G(P2(5)) S MDTEXT(1506)=1,MDTEXT(1208)=+$G(P2(5))
  1. D UPDATE^TIUSRVP(.MDRET,+MDNOTE,.MDTEXT,1)
  1. I MDRET<1 S @RESULTS@(0)="-1^Unable to file note text." Q
  1. D SIGN^TIUSRVP(.MDRET,MDNOTE,MDESIG)
  1. K MDESIG
  1. I MDRET<0 S @RESULTS@(0)="-1^Unable to sign the note." Q
  1. S @RESULTS@(0)="1^Note signed and filed."
  1. Q
  1. ;
  1. GETENT(X) ; Returns the entity path upward
  1. Q X_$P("USR^DIV^SYS",X,2)
  1. ;
  1. OPENPAR ; Opens and verifies a parameter Entity
  1. D NOW^%DTC S %=%+.00000001
  1. S Y=($E(%,1,3)+1700)_"-"_$E(%,4,5)_"-"_$E(%,6,7)_" "_$E(%,9,10)_":"_$E(%,11,12)_":"_$E(%,13,14)
  1. D EN^XPAR("USR",P2(0),"Date/Time Last Accessed",Y,.MDERR)
  1. I 'MDERR S @RESULTS@(0)="1" E S @RESULTS@(0)=MDERR
  1. Q
  1. LSTPAR ; Returns all parameter Values as a Query
  1. ; GETLST^XPAR(.List,Entity,Parameter,Format,.Error)
  1. N MDLST,MDENT,MDNAME
  1. D NEWDOC^MDCLIO("RESULTS")
  1. D GETLST^XPAR(.MDRET,P2(0),P2(1),"Q",.MDERR)
  1. F Y=0:0 S Y=$O(MDRET(Y)) Q:'Y S MDLST($P(MDRET(Y),U,1))=$P(MDRET(Y),U,2,250)
  1. K MDRET
  1. D:'MDERR
  1. .S MDNAME="" F S MDNAME=$O(MDLST(MDNAME)) Q:MDNAME="" D
  1. ..D XMLHDR^MDCLIO("RECORD")
  1. ..D XMLDATA^MDCLIO("NAME",MDNAME)
  1. ..D XMLDATA^MDCLIO("VALUE",MDLST(MDNAME))
  1. ..D XMLFTR^MDCLIO("RECORD")
  1. D ENDDOC^MDCLIO("RESULTS")
  1. Q
  1. CLRPAR ; Clears all settings for an entity
  1. D NDEL^XPAR(P2(0),P2(1),.MDERR)
  1. I 'MDERR S @RESULTS@(0)=1 E S @RESULTS@(0)=MDERR
  1. Q
  1. SETPAR ; Sets a single parameter value
  1. N MDVALUE
  1. S MDVALUE=$G(P2(3),"@") S:MDVALUE="" MDVALUE="@"
  1. D STRIP^MDCLIO(MDVALUE)
  1. I MDVALUE="@" D Q
  1. .D DEL^XPAR(P2(0),P2(1),P2(2),.MDERR)
  1. .S @RESULTS@(0)=1
  1. D EN^XPAR(P2(0),P2(1),P2(2),MDVALUE,.MDERR)
  1. S @RESULTS@(0)='MDERR
  1. Q
  1. GETPAR ; Gets a single parameter value
  1. N MDVALUE
  1. D NEWDOC^MDCLIO("RESULTS")
  1. D XMLHDR^MDCLIO("RECORD")
  1. S MDVALUE=$$GET^XPAR(P2(0),P2(1),P2(2),"Q")
  1. D:MDVALUE]"" XMLDATA^MDCLIO("VALUE",MDVALUE)
  1. D XMLFTR^MDCLIO("RECORD")
  1. D ENDDOC^MDCLIO("RESULTS")
  1. Q