Context Navigation

← Previous Change
Next Change →

MDRPCOP.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

: 1 edited

WorldVistAEHR/trunk/r/CLINICAL_PROCEDURES-MD/MDRPCOP.m (modified) (1 diff)

Legend:

: Unmodified
: Added
: Removed

WorldVistAEHR/trunk/r/CLINICAL_PROCEDURES-MD/MDRPCOP.m

-              r613
+              r623
+MDRPCOP ; HOIFO/DP - Object RPCs (TMDPatient) ;3/12/08  09:16
+        ;;1.0;CLINICAL PROCEDURES;**4,6**;Apr 01, 2004;Build 102
+        ; Integration Agreements:
+        ; 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
+        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")
+        ; 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 '$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
+        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,MDCOM,MDMULT,MDNUM,MDREQ,MDREQDT,MDYR,X1,X2,X
+        S MDNUM=$$GET^XPAR("SYS","MD DAYS TO RETAIN COM STUDY",1) S MDCOM=0
+        I +MDNUM>0 S X1=DT,X2=-MDNUM D C^%DTC S MDCOM=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)
+        .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")="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:$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_",","*","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
+        ;
+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
+ ;

Note: See TracChangeset for help on using the changeset viewer.

Context Navigation

Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_PROCEDURES-MD/MDRPCOP.m

Legend:

WorldVistAEHR/trunk/r/CLINICAL_PROCEDURES-MD/MDRPCOP.m

Download in other formats: