MDRPCOP ; HOIFO/DP - Object RPCs (TMDPatient) ;8/3/09 10:39
;;1.0;CLINICAL PROCEDURES;**4,6,11,20,42**;Apr 01, 2004;Build 12
; Integration Agreements:
; IA# 2054 [Supported] DILF call
; IA# 2056 [Supported] DIQ calls
; IA# 2263 [Supported] XPAR calls
; 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# 10103 [Supported] Call to XLFDT
; IA# 10039 [Supported] Ward Location File (#42) Access.
; IA# 10035 [Supported] DPT references
; IA# 3613 [Private] GETVST^MDRPCOP API call
; IA# 10099 [Supported] GMRADPT call
; IA# 1096 [Controlled Subscription] ^DGPM("ATID1" x-ref loop
; IA# 358 [Controlled Subscription] FILE 405 references
;
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
N MDCART,MDREZ S MDCART=0
I +$P(DATA,U,4),+$G(^MDS(702.09,+$P(DATA,U,4),"CS")) S MDCART=1
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
.S MDPC=$P(DATA,"^",5),MDPC=$S($L(MDPC,";")=1:MDPC,1:$P(MDPC,";",2))
.S MDFDA(702,"+1,",.14)=MDPC
.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")
; Patch 6 - Renal Check-In
D:+$G(MDIENS)
.S X=+$P(^MDD(702,+MDIENS,0),U,4) Q:'X
.I $P(^MDS(702.01,X,0),U,6)=2 D Q ; Renal Check-In
..D CP^MDKUTLR(+MDIENS)
..S MDFDA(702,+MDIENS_",",.09)=5
..D FILE^DIE("","MDFDA","MDERR")
; Patch 6 - Renal Check-In
I +MDCART>0 D
.S MDREZ=$$NEWTIUN^MDRPCOT(+MDIEN(1))
.I +MDREZ<0 D FILEMSG^MDRPCOT(+MDIEN(1),"TIU",2,MDREZ)
.S MDREZ=$$SUBMIT^MDRPCOT1(MDIEN(1))
.D FILEMSG^MDRPCOT(+MDIEN(1),"IMAGING",$S(+MDREZ>0:+MDREZ,1:2),MDREZ)
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) N MDCDT,MDDY,X1,X2,X
S MDDY=$$GET^XPAR("SYS","MD COMPL PROC DISPLAY DAYS",1)
S X1=DT,X2=-$S(MDDY>0:+MDDY,1:365) D C^%DTC S MDCDT=X
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)
.I $P($G(^TMP("MDTMP",$J,MDX)),U,4)="c" Q:$P($G(^TMP("MDTMP",$J,MDX)),U,1)<MDCDT
.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 Q:'$D(VADM)
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
K ^TMP("MDTMP",$J),^TMP("MDCONL",$J) N MDCDT,MDCDY,MDCOM,MDMULT,MDMULN,MDNUM,MDREQ,MDREQDT,MDYR,X1,X2,X
S MDNUM=$$GET^XPAR("SYS","MD DAYS TO RETAIN COM STUDY",1) S (MDCDY,MDCOM)=0
S MDMULN=$$GET^XPAR("SYS","MD DAYS TO RET COM MULT",1)
I +MDNUM>0 S X1=DT,X2=-MDNUM D C^%DTC S MDCOM=X
I +MDMULN>0 S X1=DT,X2=-MDMULN D C^%DTC S MDCDY=X
D CPLIST^GMRCCP(DFN,,$NA(^TMP("MDTMP",$J)))
S X1=DT,X2=-365 D C^%DTC S MDCDT=X
S MDX=0 F S MDX=$O(^TMP("MDTMP",$J,MDX)) Q:'MDX D:"saprc"[$P(^(MDX),U,4)
.I $P($G(^TMP("MDTMP",$J,MDX)),U,4)="c" Q:$P($G(^TMP("MDTMP",$J,MDX)),U,1)<MDCDT
.S ^TMP("MDCONL",$J,$P($G(^TMP("MDTMP",$J,MDX)),U,5))=$P($G(^TMP("MDTMP",$J,MDX)),U,1)
K ^TMP("MDTMP",$J)
F MDX=0:0 S MDX=$O(^MDD(702,"B",DFN,+MDX))_"," Q:'MDX D
.Q:'$$GET1^DIQ(702,MDX,.05,"I")
.Q:$G(^TMP("MDCONL",$J,+$$GET1^DIQ(702,MDX,.05,"I")))=""
.S MDMULT=+$$GET1^DIQ(702,MDX,".04:.12","I")
.S MDYR=$S(MDMULT<1:MDCOM,1:MDCDT)
.I MDNUM Q:$$GET1^DIQ(702,MDX,.09,"I")=3&($$GET1^DIQ(702,MDX,.02,"I")<MDYR)
.I MDMULT=1&(+MDMULN>0) Q:$$GET1^DIQ(702,MDX,.09,"I")=3&($$GET1^DIQ(702,MDX,.02,"I")<MDCDY)
.S MDREQDT="" I +$$GET1^DIQ(702,MDX,.05,"I") S MDREQDT=$G(^TMP("MDCONL",$J,+$$GET1^DIQ(702,MDX,.05,"I")))
.I MDREQDT'="" S MDREQDT=$$FMTE^XLFDT(MDREQDT,"1P")
.S MDREQ=$$GET1^DIQ(702,MDX,.04)_" "_+MDX_" (Consult #:"_$$GET1^DIQ(702,MDX,.05,"I")_$S(MDREQDT'="":" Requested: "_MDREQDT,1:"")_")"
.S Z=$$GET1^DIQ(702,MDX,".04:.02","I")_U_MDREQ_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)
K ^TMP("MDCONL",$J)
Q
;
GETVST ; [Procedure] Return list of visits
N BEG,END,VAERR,VASD,BDT,DTM,EDT,LOC,NOW,MDQUERY,MDLST,MDTDF,STI,STS,TODAY,I,J,K,XI,XE,X
S NOW=$$NOW^XLFDT(),TODAY=$P(NOW,".",1),MDTDF=DFN
S BEG=$$X2FM($$GETBEG),END=$$X2FM($$GETEND)+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")="129"
.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:$G(DFN)="" DFN=MDTDF
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_",",".01;.04;.06","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:$G(DFN)="" DFN=MDTDF S @RESULTS@(0)=+$O(@RESULTS@(""),-1)_U_($$GET1^DIQ(2,DFN_",",.1)]"")
Q
;
GETBEG() ; Get Beginning Date Range
I $$GET^XPAR("SYS","MD APPOINT START DATE",1)>1 Q "T-"_$$GET^XPAR("SYS","MD APPOINT START DATE",1)
Q "T-200"
GETEND() ; Get Ending Date Range
I $$GET^XPAR("SYS","MD APPOINT END DATE",1)>1 Q "T+"_$$GET^XPAR("SYS","MD APPOINT END DATE",1)
Q "T"
LOGSEC ; [Procedure] Log Security
N RES
D NOTICE^DGSEC4(.RES,DFN,DATA,1)
S @RESULTS@(0)=$S(+RES:"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
; Moved to continuation routine at MD*1.0*6 due to routine size
D SELECT^MDRPCOP1
Q
;
X2FM(X) ; [Function] return FM date given relative date
N %DT S %DT="TS" D ^%DT
Q Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDRPCOP 10165 printed Apr 09, 2024@20:47:21 Page 2
MDRPCOP ; HOIFO/DP - Object RPCs (TMDPatient) ;8/3/09 10:39
+1 ;;1.0;CLINICAL PROCEDURES;**4,6,11,20,42**;Apr 01, 2004;Build 12
+2 ; Integration Agreements:
+3 ; IA# 2054 [Supported] DILF call
+4 ; IA# 2056 [Supported] DIQ calls
+5 ; IA# 2263 [Supported] XPAR calls
+6 ; IA# 3027 [Supported] Calls to DGSEC4
+7 ; IA# 2981 [Subscription] Calls to GUI~GMRCP5
+8 ; IA# 2548 [Supported] ACRP Interface Toolkit APIs.
+9 ; IA# 2552 [Supported] AIT API to provide outpatient encounter data.
+10 ; IA# 10061 [Supported] VADPT calls.
+11 ; IA# 3468 [Subscription] Use GMRCCP APIs.
+12 ; IA# 10103 [Supported] Call to XLFDT
+13 ; IA# 10039 [Supported] Ward Location File (#42) Access.
+14 ; IA# 10035 [Supported] DPT references
+15 ; IA# 3613 [Private] GETVST^MDRPCOP API call
+16 ; IA# 10099 [Supported] GMRADPT call
+17 ; IA# 1096 [Controlled Subscription] ^DGPM("ATID1" x-ref loop
+18 ; IA# 358 [Controlled Subscription] FILE 405 references
+19 ;
ADD(X) ; [Procedure] Add line to @RESULTS@(...
+1 SET @RESULTS@(+$ORDER(@RESULTS@(""),-1)+1)=X
+2 QUIT
+3 ;
ALLERGY ; [Procedure] Return Allergies
+1 DO EN1^GMRADPT
IF '$ORDER(GMRAL(0))
Begin DoDot:1
+2 IF $GET(GMRAL)=""
SET @RESULTS@(0)="No Allergy Assessment"
+3 IF $GET(GMRAL)=0
SET @RESULTS@(0)="No Known Allergies"
End DoDot:1
QUIT
+4 SET @RESULTS@(0)="This patient has the following allergy(ies): "
+5 FOR X=0:0
SET X=$ORDER(GMRAL(X))
if 'X
QUIT
Begin DoDot:1
+6 SET @RESULTS@(X)=$PIECE($GET(GMRAL(X)),U,2)
End DoDot:1
+7 QUIT
+8 ;
CHKIN ; [Procedure] Check In Study
+1 NEW MDCART,MDREZ
SET MDCART=0
+2 IF +$PIECE(DATA,U,4)
IF +$GET(^MDS(702.09,+$PIECE(DATA,U,4),"CS"))
SET MDCART=1
+3 FOR X=2:1:5
Begin DoDot:1
+4 IF $PIECE(DATA,U,X)]""
SET MDFDA(702,$PIECE(DATA,U,1),$PIECE("^.04^.05^.11^.07",U,X))=$PIECE(DATA,U,X)
End DoDot:1
+5 ; Status = Checked-In
SET MDFDA(702,$PIECE(DATA,U,1),.09)=4
+6 IF $PIECE(DATA,U,1)="+1,"
Begin DoDot:1
+7 SET MDFDA(702,"+1,",.01)=DFN
+8 SET MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
+9 SET MDFDA(702,"+1,",.03)=DUZ
+10 SET MDPC=$PIECE(DATA,"^",5)
SET MDPC=$SELECT($LENGTH(MDPC,";")=1:MDPC,1:$PIECE(MDPC,";",2))
+11 SET MDFDA(702,"+1,",.14)=MDPC
+12 DO UPDATE^DIE("","MDFDA","MDIEN","MDERR")
if $DATA(MDERR)
QUIT
+13 SET MDIENS=MDIEN(1)_","
SET MDHL7=$$SUB^MDHL7B(MDIEN(1))
+14 IF +MDHL7=-1
SET MDFDA(702,MDIENS,.09)=2
SET MDFDA(702,MDIENS,.08)=$PIECE(MDHL7,U,2)
+15 IF +MDHL7=1
SET MDFDA(702,MDIENS,.09)=5
SET MDFDA(702,MDIENS,.08)=""
+16 if $DATA(MDFDA)
DO FILE^DIE("","MDFDA","MDERR")
End DoDot:1
+17 IF $PIECE(DATA,U,1)'="+1,"
Begin DoDot:1
+18 DO FILE^DIE("","MDFDA","MDERR")
if $DATA(MDERR)
QUIT
+19 SET MDIENS=+DATA_","
+20 SET MDHL7=$$SUB^MDHL7B(+MDIENS)
+21 IF +MDHL7=-1
SET MDFDA(702,MDIENS,.09)=2
SET MDFDA(702,MDIENS,.08)=$PIECE(MDHL7,U,2)
+22 IF +MDHL7=1
SET MDFDA(702,MDIENS,.09)=5
SET MDFDA(702,MDIENS,.08)=""
+23 if $DATA(MDFDA)
DO FILE^DIE("","MDFDA","MDERR")
End DoDot:1
+24 ; Patch 6 - Renal Check-In
+25 if +$GET(MDIENS)
Begin DoDot:1
+26 SET X=+$PIECE(^MDD(702,+MDIENS,0),U,4)
if 'X
QUIT
+27 ; Renal Check-In
IF $PIECE(^MDS(702.01,X,0),U,6)=2
Begin DoDot:2
+28 DO CP^MDKUTLR(+MDIENS)
+29 SET MDFDA(702,+MDIENS_",",.09)=5
+30 DO FILE^DIE("","MDFDA","MDERR")
End DoDot:2
QUIT
End DoDot:1
+31 ; Patch 6 - Renal Check-In
+32 IF +MDCART>0
Begin DoDot:1
+33 SET MDREZ=$$NEWTIUN^MDRPCOT(+MDIEN(1))
+34 IF +MDREZ<0
DO FILEMSG^MDRPCOT(+MDIEN(1),"TIU",2,MDREZ)
+35 SET MDREZ=$$SUBMIT^MDRPCOT1(MDIEN(1))
+36 DO FILEMSG^MDRPCOT(+MDIEN(1),"IMAGING",$SELECT(+MDREZ>0:+MDREZ,1:2),MDREZ)
End DoDot:1
+37 IF '$DATA(MDERR)
SET @RESULTS@(0)="1^OK"
QUIT
+38 DO ERROR^MDRPCU(RESULTS,.MDERR)
+39 QUIT
+40 ;
DISPCON ; [Procedure] Display a consult
+1 KILL ^TMP("GMRC",$JOB)
+2 DO GUI^GMRCP5(.RESULTS,DATA)
+3 QUIT
+4 ;
GETCONS ; [Procedure] Get available consults for patient
+1 KILL ^TMP("MDTMP",$JOB)
NEW MDCDT,MDDY,X1,X2,X
+2 SET MDDY=$$GET^XPAR("SYS","MD COMPL PROC DISPLAY DAYS",1)
+3 SET X1=DT
SET X2=-$SELECT(MDDY>0:+MDDY,1:365)
DO C^%DTC
SET MDCDT=X
+4 DO CPLIST^GMRCCP(DFN,,$NAME(^TMP("MDTMP",$JOB)))
+5 SET MDX=0
+6 FOR
SET MDX=$ORDER(^TMP("MDTMP",$JOB,MDX))
if 'MDX
QUIT
if "saprc"[$PIECE(^(MDX),U,4)
Begin DoDot:1
+7 SET Y="123;"_$PIECE(^TMP("MDTMP",$JOB,MDX),U,5)
+8 IF $PIECE($GET(^TMP("MDTMP",$JOB,MDX)),U,4)="c"
if $PIECE($GET(^TMP("MDTMP",$JOB,MDX)),U,1)<MDCDT
QUIT
+9 FOR X=2,3,4,1,6,5
SET Y=Y_U_$PIECE(^TMP("MDTMP",$JOB,MDX),U,X)
+10 SET Y=Y_U_+$ORDER(^MDD(702,"ACON",+$PIECE(^TMP("MDTMP",$JOB,MDX),U,5)))
+11 ;
+12 ; Patch MD*1.0*4 - Return number of times checked in at piece 9
+13 ;
+14 SET (X,Z)=0
SET MDY=+$PIECE(^TMP("MDTMP",$JOB,MDX),U,5)
+15 FOR
SET X=$ORDER(^MDD(702,"ACON",MDY,X))
if 'X
QUIT
SET Z=Z+1
+16 SET $PIECE(Y,U,9)=Z
+17 ;
+18 ; End Patch MD*1.0*4
+19 ;
+20 DO ADD(Y)
End DoDot:1
+21 SET @RESULTS@(0)=+$ORDER(@RESULTS@(""),-1)
+22 KILL ^TMP("MDTMP",$JOB)
+23 QUIT
+24 ;
GETHDR ; [Procedure] Get Pt Header
+1 SET DFNIENS=DFN_","
+2 SET @RESULTS@(0)=$$GET1^DIQ(2,DFNIENS,.01)_" "_$$GET1^DIQ(2,DFNIENS,.1)_" "_$$GET1^DIQ(2,DFNIENS,.101)
+3 SET @RESULTS@(1)=$$GET1^DIQ(2,DFNIENS,.09)_" "_$$GET1^DIQ(2,DFNIENS,.02)_" "_$$GET1^DIQ(2,DFNIENS,.03)_" ("_$$GET1^DIQ(2,DFNIENS,.033)_")"
+4 QUIT
+5 ;
GETOBJ ; [Procedure] Get information for TMDPATIENT object
+1 DO DEM^VADPT
DO INP^VADPT
if '$DATA(VADM)
QUIT
+2 SET @RESULTS@(0)=DFN
+3 SET @RESULTS@(1)=VADM(1)
+4 SET @RESULTS@(2)=$PIECE(VADM(2),U,2)
+5 SET @RESULTS@(3)=$PIECE(VADM(3),U,2)
+6 SET @RESULTS@(4)=VADM(4)
+7 SET @RESULTS@(5)=$PIECE(VADM(5),U,2)
+8 IF VAIN(4)]""
SET @RESULTS@(6)="Ward: "_$PIECE(VAIN(4),U,2)_" Rm: "_VAIN(5)
+9 IF '$TEST
SET @RESULTS@(6)=""
+10 QUIT
+11 ;
GETRES ; [Procedure] Get results report
+1 FOR MDX=0:0
SET MDX=$ORDER(^MDD(703.1,"ADFN",DFN,MDX))
if 'MDX
QUIT
Begin DoDot:1
+2 SET MDINST=+$PIECE($GET(^MDD(703.1,MDX,0)),U,4)
+3 IF $GET(DATA)
if '$DATA(^MDS(702.01,DATA,.1,"B",MDINST))
QUIT
+4 SET MDY=$ORDER(@RESULTS@(""),-1)+1
+5 SET @RESULTS@(MDY)="703.1;"_MDX_U_^MDD(703.1,MDX,0)
+6 SET Y=$PIECE(^MDD(703.1,MDX,0),U,3)
DO D^DIQ
+7 SET $PIECE(@RESULTS@(MDY),U,11)=Y
+8 SET Y=$PIECE($GET(^MDS(702.09,+$PIECE(^MDD(703.1,MDX,0),U,4),0)),U)
+9 SET $PIECE(@RESULTS@(MDY),U,12)=Y
End DoDot:1
+10 SET @RESULTS@(0)=+$ORDER(@RESULTS@(""),-1)
+11 QUIT
+12 ;
GETTRAN ; [Procedure] Get a patients transactions
+1 KILL ^TMP("MDTMP",$JOB),^TMP("MDCONL",$JOB)
NEW MDCDT,MDCDY,MDCOM,MDMULT,MDMULN,MDNUM,MDREQ,MDREQDT,MDYR,X1,X2,X
+2 SET MDNUM=$$GET^XPAR("SYS","MD DAYS TO RETAIN COM STUDY",1)
SET (MDCDY,MDCOM)=0
+3 SET MDMULN=$$GET^XPAR("SYS","MD DAYS TO RET COM MULT",1)
+4 IF +MDNUM>0
SET X1=DT
SET X2=-MDNUM
DO C^%DTC
SET MDCOM=X
+5 IF +MDMULN>0
SET X1=DT
SET X2=-MDMULN
DO C^%DTC
SET MDCDY=X
+6 DO CPLIST^GMRCCP(DFN,,$NAME(^TMP("MDTMP",$JOB)))
+7 SET X1=DT
SET X2=-365
DO C^%DTC
SET MDCDT=X
+8 SET MDX=0
FOR
SET MDX=$ORDER(^TMP("MDTMP",$JOB,MDX))
if 'MDX
QUIT
if "saprc"[$PIECE(^(MDX),U,4)
Begin DoDot:1
+9 IF $PIECE($GET(^TMP("MDTMP",$JOB,MDX)),U,4)="c"
if $PIECE($GET(^TMP("MDTMP",$JOB,MDX)),U,1)<MDCDT
QUIT
+10 SET ^TMP("MDCONL",$JOB,$PIECE($GET(^TMP("MDTMP",$JOB,MDX)),U,5))=$PIECE($GET(^TMP("MDTMP",$JOB,MDX)),U,1)
End DoDot:1
+11 KILL ^TMP("MDTMP",$JOB)
+12 FOR MDX=0:0
SET MDX=$ORDER(^MDD(702,"B",DFN,+MDX))_","
if 'MDX
QUIT
Begin DoDot:1
+13 if '$$GET1^DIQ(702,MDX,.05,"I")
QUIT
+14 if $GET(^TMP("MDCONL",$JOB,+$$GET1^DIQ(702,MDX,.05,"I")))=""
QUIT
+15 SET MDMULT=+$$GET1^DIQ(702,MDX,".04:.12","I")
+16 SET MDYR=$SELECT(MDMULT<1:MDCOM,1:MDCDT)
+17 IF MDNUM
if $$GET1^DIQ(702,MDX,.09,"I")=3&($$GET1^DIQ(702,MDX,.02,"I")<MDYR)
QUIT
+18 IF MDMULT=1&(+MDMULN>0)
if $$GET1^DIQ(702,MDX,.09,"I")=3&($$GET1^DIQ(702,MDX,.02,"I")<MDCDY)
QUIT
+19 SET MDREQDT=""
IF +$$GET1^DIQ(702,MDX,.05,"I")
SET MDREQDT=$GET(^TMP("MDCONL",$JOB,+$$GET1^DIQ(702,MDX,.05,"I")))
+20 IF MDREQDT'=""
SET MDREQDT=$$FMTE^XLFDT(MDREQDT,"1P")
+21 SET MDREQ=$$GET1^DIQ(702,MDX,.04)_" "_+MDX_" (Consult #:"_$$GET1^DIQ(702,MDX,.05,"I")_$SELECT(MDREQDT'="":" Requested: "_MDREQDT,1:"")_")"
+22 SET Z=$$GET1^DIQ(702,MDX,".04:.02","I")_U_MDREQ_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)
+23 SET Y=$ORDER(@RESULTS@(""),-1)+1
+24 SET @RESULTS@(Y)="702;"_+MDX_U_Z
End DoDot:1
+25 SET @RESULTS@(0)=+$ORDER(@RESULTS@(""),-1)
+26 KILL ^TMP("MDCONL",$JOB)
+27 QUIT
+28 ;
GETVST ; [Procedure] Return list of visits
+1 NEW BEG,END,VAERR,VASD,BDT,DTM,EDT,LOC,NOW,MDQUERY,MDLST,MDTDF,STI,STS,TODAY,I,J,K,XI,XE,X
+2 SET NOW=$$NOW^XLFDT()
SET TODAY=$PIECE(NOW,".",1)
SET MDTDF=DFN
+3 SET BEG=$$X2FM($$GETBEG)
SET END=$$X2FM($$GETEND)+0.2359
+4 SET MDLST=""
SET MDSTOP=""
+5 ; get future encounters, past cancels/no-shows from VADPT
IF END>NOW
Begin DoDot:1
+6 SET VASD("F")=BEG
+7 SET VASD("T")=END
+8 SET VASD("W")="129"
+9 DO SDA^VADPT
+10 SET I=0
FOR
SET I=$ORDER(^UTILITY("VASD",$JOB,I))
if 'I
QUIT
Begin DoDot:2
+11 SET XI=^UTILITY("VASD",$JOB,I,"I")
SET XE=^("E")
+12 SET DTM=$PIECE(XI,U)
SET IEN=$PIECE(XI,U,2)
SET STI=$PIECE(XI,U,3)
+13 SET LOC=$PIECE(XE,U,2)
SET STS=$PIECE(XE,U,3)
+14 ; no prior kept appts
IF DTM<TODAY
IF (STI=""!(STI["I")!(STI="NT"))
QUIT
+15 SET MDLST(DTM,"A",1)="A;"_DTM_";"_IEN_U_DTM_U_LOC_U_STS
End DoDot:2
+16 KILL ^UTILITY("VASD",$JOB)
End DoDot:1
+17 ;past encounters from ACRP Toolkit - set in CALLBACK
IF BEG'>NOW
Begin DoDot:1
+18 SET BDT=BEG
+19 SET EDT=$SELECT(END<NOW:END,1:NOW)
+20 DO OPEN^SDQ(.MDQUERY)
+21 IF '$$ERRCHK^SDQUT()
DO INDEX^SDQ(.MDQUERY,"PATIENT/DATE","SET")
+22 IF '$$ERRCHK^SDQUT()
DO PAT^SDQ(.MDQUERY,DFN,"SET")
+23 IF '$$ERRCHK^SDQUT()
DO DATE^SDQ(.MDQUERY,BDT,EDT,"SET")
+24 IF '$$ERRCHK^SDQUT()
Begin DoDot:2
+25 DO SCANCB^SDQ(.MDQUERY,"D CALLBACK^ORWCV(Y,Y0,$NA(MDLST),.MDSTOP)","SET")
End DoDot:2
+26 IF '$$ERRCHK^SDQUT()
DO ACTIVE^SDQ(.MDQUERY,"TRUE","SET")
+27 IF '$$ERRCHK^SDQUT()
DO SCAN^SDQ(.MDQUERY,"FORWARD")
+28 DO CLOSE^SDQ(.MDQUERY)
End DoDot:1
+29 ; admits
NEW TIM,MOV,MDX0,Y,MTIM,XTYP,XLOC,XLOCI,HLOC,EARLY,DONE
+30 SET EARLY=BEG
SET DONE=0
if $GET(DFN)=""
SET DFN=MDTDF
+31 SET TIM=""
FOR
SET TIM=$ORDER(^DGPM("ATID1",DFN,TIM))
if TIM'>0
QUIT
Begin DoDot:1
+32 SET MOV=0
FOR
SET MOV=$ORDER(^DGPM("ATID1",DFN,TIM,MOV))
if MOV'>0
QUIT
Begin DoDot:2
+33 DO GETS^DIQ(405,+MOV_",",".01;.04;.06","IE","MDX0")
SET MTIM=$GET(MDX0(405,MOV_",",".01","I"))
+34 SET XTYP=$GET(MDX0(405,+MOV_",",".04","E"))
+35 SET XLOC=$GET(MDX0(405,+MOV_",",".06","E"))
+36 SET XLOCI=+$GET(MDX0(405,+MOV_",",".06","I"))
SET HLOC=+$GET(^DIC(42,+XLOCI,44))
+37 SET MDLST(MTIM,"I",1)="I;"_MTIM_";"_HLOC_U_MTIM_U_"Inpatient Stay"_U_XLOC_U_XTYP
+38 ; Not sure if I should include all stays <DRP@Hines>
SET DONE=1
End DoDot:2
if DONE
QUIT
End DoDot:1
if DONE
QUIT
+39 SET I=0
FOR
SET I=$ORDER(MDLST(I))
if 'I
QUIT
Begin DoDot:1
+40 SET J=""
FOR
SET J=$ORDER(MDLST(I,J))
if J=""
QUIT
Begin DoDot:2
+41 SET K=0
FOR
SET K=$ORDER(MDLST(I,J,K))
if 'K
QUIT
Begin DoDot:3
+42 SET @RESULTS@($ORDER(@RESULTS@(""),-1)+1)=MDLST(I,J,K)
End DoDot:3
End DoDot:2
End DoDot:1
+43 if $GET(DFN)=""
SET DFN=MDTDF
SET @RESULTS@(0)=+$ORDER(@RESULTS@(""),-1)_U_($$GET1^DIQ(2,DFN_",",.1)]"")
+44 QUIT
+45 ;
GETBEG() ; Get Beginning Date Range
+1 IF $$GET^XPAR("SYS","MD APPOINT START DATE",1)>1
QUIT "T-"_$$GET^XPAR("SYS","MD APPOINT START DATE",1)
+2 QUIT "T-200"
GETEND() ; Get Ending Date Range
+1 IF $$GET^XPAR("SYS","MD APPOINT END DATE",1)>1
QUIT "T+"_$$GET^XPAR("SYS","MD APPOINT END DATE",1)
+2 QUIT "T"
LOGSEC ; [Procedure] Log Security
+1 NEW RES
+2 DO NOTICE^DGSEC4(.RES,DFN,DATA,1)
+3 SET @RESULTS@(0)=$SELECT(+RES:"1^Logged",1:"-1^Unable to log")
+4 QUIT
+5 ;
RPC(RESULTS,OPTION,DFN,DATA) ; [Procedure] Main RPC call tag
+1 NEW DFNIENS,GMRAL,GMVALG,GN,IENS,MDDFN,MDERR,MDFDA,MDFLD,MDHL7,MDID,MDIDS,MDIEN,MDIENS,MDRET,MDX,MDY,VA,VADM,VAERR,VAIN,Z
+2 SET RESULTS=$NAME(^TMP($JOB))
KILL @RESULTS
+3 if $TEXT(@OPTION)]""
DO @OPTION
+4 if '$DATA(@RESULTS)
DO BADRPC^MDRPCU("MD TMDPATIENT","MDRPCOP",OPTION)
+5 DO CLEAN^DILF
+6 QUIT
+7 ;
SELECT ; [Procedure] Select patient
+1 ; Moved to continuation routine at MD*1.0*6 due to routine size
+2 DO SELECT^MDRPCOP1
+3 QUIT
+4 ;
X2FM(X) ; [Function] return FM date given relative date
+1 NEW %DT
SET %DT="TS"
DO ^%DT
+2 QUIT Y
+3 ;
