Changeset 636 for FOIAVistA/tag/r/CLINICAL_PROCEDURES-MD/MDRPCOP.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• CLINICAL_PROCEDURES-MD/MDRPCOP.m (modified) (8 diffs)

FOIAVistA/tag/r/CLINICAL_PROCEDURES-MD/MDRPCOP.m

@@ -1 @@
-MDRPCOP ; HOIFO/DP - Object RPCs (TMDPatient) ;3/12/08  09:16
- ;;1.0;CLINICAL PROCEDURES;**4,6**;Apr 01, 2004;Build 102
+MDRPCOP ; HOIFO/DP - Object RPCs (TMDPatient) ; [01-09-2003 15:21]
+ ;;1.0;CLINICAL PROCEDURES;**4**;Apr 01, 2004;Build 3
  ; Integration Agreements:
- ; IA# 2263 [Supported] XPAR calls
  ; IA# 3027 [Supported] Calls to DGSEC4
  ; IA# 2981 [Subscription] Calls to GUI~GMRCP5
@@ -9 +8 @@
  ; 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
- ; IA# 358 [Controlled Subscription] FILE 405 references
  ;
 ADD(X) ; [Procedure] Add line to @RESULTS@(...
@@ -50 +51 @@
  .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)
@@ -68 +61 @@
  ;
 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
+ 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)
- .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)))
@@ -124 +114 @@
  ;
 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 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)
- 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
+ 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
@@ -179 +151 @@
  .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 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
@@ -192 +164 @@
  ..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"
+ S @RESULTS@(0)=+$O(@RESULTS@(""),-1)_U_($$GET1^DIQ(2,DFN_",",.1)]"")
+ Q
+ ;
 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")
+ D NOTICE^DGSEC4(.RESULTS,DFN,DATA,1)
+ S @RESULTS@(0)=$S(RESULTS:"1^Logged",1:"-1^Unable to log")
  Q
  ;
@@ -216 +181 @@
  ;
 SELECT ; [Procedure] Select patient
- ; Moved to continuation routine at MD*1.0*6 due to routine size
- D SELECT^MDRPCOP1
+ 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
  ;