Routine: MDRPCOP

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

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)

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)

DISPCON ; [Procedure] Display a consult

 K ^TMP("GMRC",$J)

 D GUI^GMRCP5(.RESULTS,DATA)

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)

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)_")"

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)=""

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)

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)

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)]"")

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")

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

SELECT ; [Procedure] Select patient

 ; Moved to continuation routine at MD*1.0*6 due to routine size

 D SELECT^MDRPCOP1

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  Feb 18, 2025@23:10:28                                                                                                                                                                                                    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       ;

MDRPCOP.m