241 lines
9.0 KiB
Mathematica
241 lines
9.0 KiB
Mathematica
MDRPCOP ; HOIFO/DP - Object RPCs (TMDPatient) ; [01-09-2003 15:21]
|
|
;;1.0;CLINICAL PROCEDURES;**4**;Apr 01, 2004;Build 3
|
|
; Integration Agreements:
|
|
; IA# 3027 [Supported] Calls to DGSEC4
|
|
; IA# 2981 [Subscription] Calls to GUI~GMRCP5
|
|
; IA# 2548 [Supported] ACRP Interface Toolkit APIs.
|
|
; IA# 2552 [Supported] AIT API to provide outpatient encounter data.
|
|
; IA# 10061 [Supported] VADPT calls.
|
|
; IA# 3468 [Subscription] Use GMRCCP APIs.
|
|
; IA# 3266 [Subscription] Call to DPTLK1
|
|
; IA# 10103 [Supported] Call to XLFDT
|
|
; IA# 10039 [Supported] Ward Location File (#42) Access.
|
|
; IA# 10035 [Supported] DPT references
|
|
; IA# 3267 [Subscription] Call to DPTLK1
|
|
; IA# 3593 [Supported] Access to routine DPTLK6 utilities for lookup
|
|
; IA# 3613 [Private] GETVST^MDRPCOP API call
|
|
; IA# 10099 [Supported] GMRADPT call
|
|
; IA# 1096 [Controlled Subscription] ^DGPM("ATID1" x-ref loop
|
|
;
|
|
ADD(X) ; [Procedure] Add line to @RESULTS@(...
|
|
S @RESULTS@(+$O(@RESULTS@(""),-1)+1)=X
|
|
Q
|
|
;
|
|
ALLERGY ; [Procedure] Return Allergies
|
|
D EN1^GMRADPT I '$O(GMRAL(0)) D Q
|
|
.I $G(GMRAL)="" S @RESULTS@(0)="No Allergy Assessment"
|
|
.I $G(GMRAL)=0 S @RESULTS@(0)="No Known Allergies"
|
|
S @RESULTS@(0)="This patient has the following allergy(ies): "
|
|
F X=0:0 S X=$O(GMRAL(X)) Q:'X D
|
|
.S @RESULTS@(X)=$P($G(GMRAL(X)),U,2)
|
|
Q
|
|
;
|
|
CHKIN ; [Procedure] Check In Study
|
|
F X=2:1:5 D
|
|
.I $P(DATA,U,X)]"" S MDFDA(702,$P(DATA,U,1),$P("^.04^.05^.11^.07",U,X))=$P(DATA,U,X)
|
|
S MDFDA(702,$P(DATA,U,1),.09)=4 ; Status = Checked-In
|
|
I $P(DATA,U,1)="+1," D
|
|
.S MDFDA(702,"+1,",.01)=DFN
|
|
.S MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
|
|
.S MDFDA(702,"+1,",.03)=DUZ
|
|
.D UPDATE^DIE("","MDFDA","MDIEN","MDERR") Q:$D(MDERR)
|
|
.S MDIENS=MDIEN(1)_",",MDHL7=$$SUB^MDHL7B(MDIEN(1))
|
|
.I +MDHL7=-1 S MDFDA(702,MDIENS,.09)=2,MDFDA(702,MDIENS,.08)=$P(MDHL7,U,2)
|
|
.I +MDHL7=1 S MDFDA(702,MDIENS,.09)=5,MDFDA(702,MDIENS,.08)=""
|
|
.D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR")
|
|
I $P(DATA,U,1)'="+1," D
|
|
.D FILE^DIE("","MDFDA","MDERR") Q:$D(MDERR)
|
|
.S MDIENS=+DATA_","
|
|
.S MDHL7=$$SUB^MDHL7B(+MDIENS)
|
|
.I +MDHL7=-1 S MDFDA(702,MDIENS,.09)=2,MDFDA(702,MDIENS,.08)=$P(MDHL7,U,2)
|
|
.I +MDHL7=1 S MDFDA(702,MDIENS,.09)=5,MDFDA(702,MDIENS,.08)=""
|
|
.D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR")
|
|
I '$D(MDERR) S @RESULTS@(0)="1^OK" Q
|
|
D ERROR^MDRPCU(RESULTS,.MDERR)
|
|
Q
|
|
;
|
|
DISPCON ; [Procedure] Display a consult
|
|
K ^TMP("GMRC",$J)
|
|
D GUI^GMRCP5(.RESULTS,DATA)
|
|
Q
|
|
;
|
|
GETCONS ; [Procedure] Get available consults for patient
|
|
K ^TMP("MDTMP",$J)
|
|
D CPLIST^GMRCCP(DFN,,$NA(^TMP("MDTMP",$J)))
|
|
S MDX=0
|
|
F S MDX=$O(^TMP("MDTMP",$J,MDX)) Q:'MDX D:"saprc"[$P(^(MDX),U,4)
|
|
.S Y="123;"_$P(^TMP("MDTMP",$J,MDX),U,5)
|
|
.F X=2,3,4,1,6,5 S Y=Y_U_$P(^TMP("MDTMP",$J,MDX),U,X)
|
|
.S Y=Y_U_+$O(^MDD(702,"ACON",+$P(^TMP("MDTMP",$J,MDX),U,5)))
|
|
.;
|
|
.; Patch MD*1.0*4 - Return number of times checked in at piece 9
|
|
.;
|
|
.S (X,Z)=0,MDY=+$P(^TMP("MDTMP",$J,MDX),U,5)
|
|
.F S X=$O(^MDD(702,"ACON",MDY,X)) Q:'X S Z=Z+1
|
|
.S $P(Y,U,9)=Z
|
|
.;
|
|
.; End Patch MD*1.0*4
|
|
.;
|
|
.D ADD(Y)
|
|
S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
|
|
K ^TMP("MDTMP",$J)
|
|
Q
|
|
;
|
|
GETHDR ; [Procedure] Get Pt Header
|
|
S DFNIENS=DFN_","
|
|
S @RESULTS@(0)=$$GET1^DIQ(2,DFNIENS,.01)_" "_$$GET1^DIQ(2,DFNIENS,.1)_" "_$$GET1^DIQ(2,DFNIENS,.101)
|
|
S @RESULTS@(1)=$$GET1^DIQ(2,DFNIENS,.09)_" "_$$GET1^DIQ(2,DFNIENS,.02)_" "_$$GET1^DIQ(2,DFNIENS,.03)_" ("_$$GET1^DIQ(2,DFNIENS,.033)_")"
|
|
Q
|
|
;
|
|
GETOBJ ; [Procedure] Get information for TMDPATIENT object
|
|
D DEM^VADPT,INP^VADPT
|
|
S @RESULTS@(0)=DFN
|
|
S @RESULTS@(1)=VADM(1)
|
|
S @RESULTS@(2)=$P(VADM(2),U,2)
|
|
S @RESULTS@(3)=$P(VADM(3),U,2)
|
|
S @RESULTS@(4)=VADM(4)
|
|
S @RESULTS@(5)=$P(VADM(5),U,2)
|
|
I VAIN(4)]"" S @RESULTS@(6)="Ward: "_$P(VAIN(4),U,2)_" Rm: "_VAIN(5)
|
|
E S @RESULTS@(6)=""
|
|
Q
|
|
;
|
|
GETRES ; [Procedure] Get results report
|
|
F MDX=0:0 S MDX=$O(^MDD(703.1,"ADFN",DFN,MDX)) Q:'MDX D
|
|
.S MDINST=+$P($G(^MDD(703.1,MDX,0)),U,4)
|
|
.I $G(DATA) Q:'$D(^MDS(702.01,DATA,.1,"B",MDINST))
|
|
.S MDY=$O(@RESULTS@(""),-1)+1
|
|
.S @RESULTS@(MDY)="703.1;"_MDX_U_^MDD(703.1,MDX,0)
|
|
.S Y=$P(^MDD(703.1,MDX,0),U,3) D D^DIQ
|
|
.S $P(@RESULTS@(MDY),U,11)=Y
|
|
.S Y=$P($G(^MDS(702.09,+$P(^MDD(703.1,MDX,0),U,4),0)),U)
|
|
.S $P(@RESULTS@(MDY),U,12)=Y
|
|
S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
|
|
Q
|
|
;
|
|
GETTRAN ; [Procedure] Get a patients transactions
|
|
F MDX=0:0 S MDX=$O(^MDD(702,"B",DFN,+MDX))_"," Q:'MDX D
|
|
.S Z=$$GET1^DIQ(702,MDX,".04:.02","I")_U_$$GET1^DIQ(702,MDX,.04)_U_$$GET1^DIQ(702,MDX,.02,"I")_U_$$GET1^DIQ(702,MDX,.09)_U_$$GET1^DIQ(702,MDX,.11)_U_$$GET1^DIQ(702,MDX,.991)
|
|
.S Y=$O(@RESULTS@(""),-1)+1
|
|
.S @RESULTS@(Y)="702;"_+MDX_U_Z
|
|
S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
|
|
Q
|
|
;
|
|
GETVST ; [Procedure] Return list of visits
|
|
N BEG,END,VAERR,VASD,BDT,DTM,EDT,LOC,NOW,MDQUERY,MDLST,STI,STS,TODAY,I,J,K,XI,XE,X
|
|
S NOW=$$NOW^XLFDT(),TODAY=$P(NOW,".",1)
|
|
S BEG=$$X2FM("T-200"),END=$$X2FM("T")+0.2359
|
|
S MDLST="",MDSTOP=""
|
|
I END>NOW D ; get future encounters, past cancels/no-shows from VADPT
|
|
.S VASD("F")=BEG
|
|
.S VASD("T")=END
|
|
.S VASD("W")="123456789"
|
|
.D SDA^VADPT
|
|
.S I=0 F S I=$O(^UTILITY("VASD",$J,I)) Q:'I D
|
|
..S XI=^UTILITY("VASD",$J,I,"I"),XE=^("E")
|
|
..S DTM=$P(XI,U),IEN=$P(XI,U,2),STI=$P(XI,U,3)
|
|
..S LOC=$P(XE,U,2),STS=$P(XE,U,3)
|
|
..I DTM<TODAY,(STI=""!(STI["I")!(STI="NT")) Q ; no prior kept appts
|
|
..S MDLST(DTM,"A",1)="A;"_DTM_";"_IEN_U_DTM_U_LOC_U_STS
|
|
.K ^UTILITY("VASD",$J)
|
|
I BEG'>NOW D ;past encounters from ACRP Toolkit - set in CALLBACK
|
|
.S BDT=BEG
|
|
.S EDT=$S(END<NOW:END,1:NOW)
|
|
.D OPEN^SDQ(.MDQUERY)
|
|
.I '$$ERRCHK^SDQUT() D INDEX^SDQ(.MDQUERY,"PATIENT/DATE","SET")
|
|
.I '$$ERRCHK^SDQUT() D PAT^SDQ(.MDQUERY,DFN,"SET")
|
|
.I '$$ERRCHK^SDQUT() D DATE^SDQ(.MDQUERY,BDT,EDT,"SET")
|
|
.I '$$ERRCHK^SDQUT() D
|
|
..D SCANCB^SDQ(.MDQUERY,"D CALLBACK^ORWCV(Y,Y0,$NA(MDLST),.MDSTOP)","SET")
|
|
.I '$$ERRCHK^SDQUT() D ACTIVE^SDQ(.MDQUERY,"TRUE","SET")
|
|
.I '$$ERRCHK^SDQUT() D SCAN^SDQ(.MDQUERY,"FORWARD")
|
|
.D CLOSE^SDQ(.MDQUERY)
|
|
N TIM,MOV,MDX0,Y,MTIM,XTYP,XLOC,XLOCI,HLOC,EARLY,DONE ; admits
|
|
S EARLY=BEG,DONE=0
|
|
S TIM="" F S TIM=$O(^DGPM("ATID1",DFN,TIM)) Q:TIM'>0 D Q:DONE
|
|
.S MOV=0 F S MOV=$O(^DGPM("ATID1",DFN,TIM,MOV)) Q:MOV'>0 D Q:DONE
|
|
..D GETS^DIQ(405,+MOV_",","*","IE","MDX0") S MTIM=$G(MDX0(405,MOV_",",".01","I"))
|
|
..S XTYP=$G(MDX0(405,+MOV_",",".04","E"))
|
|
..S XLOC=$G(MDX0(405,+MOV_",",".06","E"))
|
|
..S XLOCI=+$G(MDX0(405,+MOV_",",".06","I")),HLOC=+$G(^DIC(42,+XLOCI,44))
|
|
..S MDLST(MTIM,"I",1)="I;"_MTIM_";"_HLOC_U_MTIM_U_"Inpatient Stay"_U_XLOC_U_XTYP
|
|
..S DONE=1 ; Not sure if I should include all stays <DRP@Hines>
|
|
S I=0 F S I=$O(MDLST(I)) Q:'I D
|
|
.S J="" F S J=$O(MDLST(I,J)) Q:J="" D
|
|
..S K=0 F S K=$O(MDLST(I,J,K)) Q:'K D
|
|
...S @RESULTS@($O(@RESULTS@(""),-1)+1)=MDLST(I,J,K)
|
|
S @RESULTS@(0)=+$O(@RESULTS@(""),-1)_U_($$GET1^DIQ(2,DFN_",",.1)]"")
|
|
Q
|
|
;
|
|
LOGSEC ; [Procedure] Log Security
|
|
D NOTICE^DGSEC4(.RESULTS,DFN,DATA,1)
|
|
S @RESULTS@(0)=$S(RESULTS:"1^Logged",1:"-1^Unable to log")
|
|
Q
|
|
;
|
|
RPC(RESULTS,OPTION,DFN,DATA) ; [Procedure] Main RPC call tag
|
|
NEW DFNIENS,GMRAL,GMVALG,GN,IENS,MDDFN,MDERR,MDFDA,MDFLD,MDHL7,MDID,MDIDS,MDIEN,MDIENS,MDRET,MDX,MDY,VA,VADM,VAERR,VAIN,Z
|
|
S RESULTS=$NA(^TMP($J)) K @RESULTS
|
|
D:$T(@OPTION)]"" @OPTION
|
|
D:'$D(@RESULTS) BADRPC^MDRPCU("MD TMDPATIENT","MDRPCOP",OPTION)
|
|
D CLEAN^DILF
|
|
Q
|
|
;
|
|
SELECT ; [Procedure] Select patient
|
|
I '$D(^DPT(+$G(DFN),0))#2 S @RESULTS@(0)="-1^No such patient" Q
|
|
S @RESULTS@(0)="1^Required Identifiers & messages"
|
|
S IENS=DFN_","
|
|
D FILE^DID(2,,"REQUIRED IDENTIFIERS","MDIDS")
|
|
F MDX=0:0 S MDX=$O(MDIDS("REQUIRED IDENTIFIERS",MDX)) Q:'MDX D
|
|
.S MDFLD=MDIDS("REQUIRED IDENTIFIERS",MDX,"FIELD")
|
|
.S MDID="$$PTID^"_$$GET1^DID(2,MDFLD,"","LABEL")
|
|
.S MDID=MDID_U_$$GET1^DIQ(2,IENS,MDFLD)
|
|
.D:MDFLD=.03
|
|
..S MDID=MDID_" ("_$$GET1^DIQ(2,IENS,.033)_")"
|
|
..S MDID=MDID_U_$$DOB^DPTLK1(+IENS)
|
|
.D:MDFLD=.09
|
|
..S X=$P(MDID,U,3),X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10)
|
|
..S $P(MDID,U,3)=X,$P(MDID,U,4)=$$SSN^DPTLK1(+IENS)
|
|
.S @RESULTS@($O(@RESULTS@(""),-1)+1)=MDID
|
|
S MDID="$$PTID^"_$$GET1^DID(2,.1,"","LABEL")
|
|
S MDID=MDID_U_$$GET1^DIQ(2,IENS,.1)
|
|
S @RESULTS@($O(@RESULTS@(""),-1)+1)=MDID
|
|
S MDID="$$PTID^"_$$GET1^DID(2,.101,"","LABEL")
|
|
S MDID=MDID_U_$$GET1^DIQ(2,IENS,.101)
|
|
S @RESULTS@($O(@RESULTS@(""),-1)+1)=MDID
|
|
K MDRET
|
|
D GUIBS5A^DPTLK6(.MDRET,DFN) D:MDRET(1)=1
|
|
.D ADD("$$MSGHDR^2^SAME LAST NAME AND LAST 4")
|
|
.S MDX=1
|
|
.F S MDX=$O(MDRET(MDX)) Q:'MDX!(+$G(MDRET(MDX))) D
|
|
..D ADD($P(MDRET(MDX),U,2))
|
|
.D ADD(" ")
|
|
.S MDX=1
|
|
.F S MDX=$O(MDRET(MDX)) Q:'MDX D:+MDRET(MDX)
|
|
..S MDDFN=+$P(MDRET(MDX),U,2)
|
|
..D ADD($$GET1^DIQ(2,MDDFN_",",.01)_" "_$$DOB^DPTLK1(MDDFN)_" "_$$SSN^DPTLK1(MDDFN))
|
|
.D ADD(" ")
|
|
.D ADD("Please review carefully before continuing")
|
|
.D ADD("$$MSGEND")
|
|
K MDRET
|
|
D PTSEC^DGSEC4(.MDRET,DFN) D:MDRET(1)'=0
|
|
.D:MDRET(1)=3
|
|
..D ADD("$$MSGHDR^0^CAN'T ACCESS YOUR OWN RECORD!!")
|
|
.D:MDRET(1)=-1
|
|
..D ADD("$$MSGHDR^0^INCOMPLETE INFORMATION - CAN'T PROCEED")
|
|
.D:MDRET(1)=1
|
|
..D ADD("$$MSGHDR^1^SENSITIVE RECORD ACCESS")
|
|
.D:MDRET(1)'=-1&(MDRET(1)'=3)&(MDRET(1)'=1)
|
|
..D ADD("$$MSGHDR^3^SENSITIVE RECORD ACCESS")
|
|
.S MDX=1
|
|
.F S MDX=$O(MDRET(MDX)) Q:'MDX D ADD($TR(MDRET(MDX),"*"," "))
|
|
.D ADD("$$MSGEND")
|
|
D GUIMTD^DPTLK6(.MDRET,DFN) D:MDRET(1)=1
|
|
.D ADD("$$MSGHDR^1^NOTICE")
|
|
.F MDX=1:0 S MDX=$O(MDRET(MDX)) Q:'MDX D ADD(MDRET(MDX))
|
|
.D ADD("$$MSGEND")
|
|
Q
|
|
;
|
|
X2FM(X) ; [Function] return FM date given relative date
|
|
N %DT S %DT="TS" D ^%DT
|
|
Q Y
|
|
;
|