MDKRPC1	;HIOFO/FT-RPC to return patient data ;2/19/08  13:13
	;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
	;
	; This routine uses the following IAs:
	; #1239  - ^PXRHS03               (controlled)
	; #1240  - ^PXRHS04               (private)
	; #1625  - ^XUA4A72               (supported)
	; #2263  - ^XPAR                  (supported)
	; #2864  - ^TIUPP3 calls          (controlled)
	; #3065  - ^XLFNAME               (supported)
	; #3556  - ^LA7QRY                (controlled)
	; #10035 - ^DPT global refs       (supported)
	; #10060 - ^FILE 200 refs         (supported)
	; #10099 - ^GMRADPT calls         (supported)
	; #10103 - ^XLFDT calls           (supported)
	; #4868  - VA(200,"AUSER"         (Private)
	;
RPC(RESULT,OPTION,DATA)	; RPC to return existing VistA patient data for
	; renal dialysis data entry.
	; RPC: [MDK GET VISTA DATA]
	;
	; Input parameters
	;  1. RESULT [Reference/Required] RPC Return array
	;  2. OPTION [Literal/Required] RPC Option to execute
	;  3. DATA [Literal/Required] Other data as required for call
	;
	K RESULT
	D:$T(@OPTION)]"" @OPTION
	S:'$D(RESULT) RESULT(0)="-1^No results returned"
	Q
DEMO	; demographic
	N DFN,MDKNODE0,MDKSSN
	S DFN=$G(DATA)
	I '$G(DFN) D  Q
	.S RESULT(0)="-1^DFN is not defined"
	.Q
	I '$D(^DPT(DFN,0)) D  Q
	.S RESULT(0)="-1^Patient not found"
	.Q
	S MDKNODE0=$G(^DPT(DFN,0))
	S RESULT(1)=$P(MDKNODE0,U,1) ;name
	S RESULT(2)=$P(MDKNODE0,U,9) ;ssn
	S RESULT(3)=$P(MDKNODE0,U,3) ;date of birth
	S RESULT(0)=3
	Q
ALLERGY	; get allergy data
	; DATA = DFN
	S DFN=$G(DATA)
	N GMRAL
	N MDKCNT,MDLOOP
	S (MDKCNT,MDKLOOP)=0
	D EN1^GMRADPT
	I $O(GMRAL(0))'>0 D  Q
	.S:$G(GMRAL)="" RESULT(1)="No Allergy Assessment"
	.S:$G(GMRAL)=0 RESULT(1)="No Known Allergies"
	.S RESULT(0)=1
	.Q
	I $O(GMRAL(0))>0 D
	.F  S MDKLOOP=$O(GMRAL(MDKLOOP)) Q:MDKLOOP'>0  D
	..S MDKCNT=MDKCNT+1
	..S RESULT(MDKCNT)=$P($G(GMRAL(MDKLOOP)),U,2)
	..Q
	.S RESULT(0)=MDKCNT
	.Q
	Q
SHOTS	; get latest vaccination data
	N MDKCNT,MDKDATE,MDKIEN,MDKIMMUM,MDKNAME,MDKNODE
	S DFN=$G(DATA)
	S (MDKCNT,RESULT(0))=0
	S MDKIMMUM("HEP A")="HEPATITIS A"
	S MDKIMMUM("HEP B")="HEPATITIS B"
	S MDKIMMUM("INFLUENZA")="FLU"
	S MDKIMMUM("PNEUMO-VAC")="PNEUMOCOCCAL"
	;S MDKIMMUM("PNEUMOCOCCAL")="PNEUMONIA"
	S MDKIMMUM("PPD")="PPD"
	D IMMUN^PXRHS03(DFN)
	F MDKNAME="HEP A","HEP B","INFLUENZA","PNEUMO-VAC" D
	.Q:'$D(^TMP("PXI",$J,MDKNAME))
	.S MDKDATE=0
	.F  S MDKDATE=$O(^TMP("PXI",$J,MDKNAME,MDKDATE)) Q:'MDKDATE  D
	..S MDKIEN=0
	..F  S MDKIEN=$O(^TMP("PXI",$J,MDKNAME,MDKDATE,MDKIEN)) Q:'MDKIEN  D
	...S MDKNODE=$G(^TMP("PXI",$J,MDKNAME,MDKDATE,MDKIEN,0))
	...Q:MDKNODE=""
	...S MDKCNT=MDKCNT+1
	...;RESULT(N)=shot name^date^reaction^contraindicated
	...S RESULT(MDKCNT)=MDKIMMUM(MDKNAME)_U_$P(MDKNODE,U,3)_U_$P(MDKNODE,U,6)_U_$P(MDKNODE,U,7)
	...Q
	..Q
	.Q
	S RESULT(0)=MDKCNT
	K ^TMP("PXI",$J)
	; get PPD (skin) result
	D SKIN^PXRHS04(DFN)
	I $D(^TMP("PXS",$J)) D
	.S MDKDATE=0
	.F  S MDKDATE=$O(^TMP("PXS",$J,"PPD",MDKDATE)) Q:'MDKDATE  D
	..S MDKIEN=0
	..F  S MDKIEN=$O(^TMP("PXS",$J,"PPD",MDKDATE,MDKIEN)) Q:'MDKIEN  D
	...S MDKNODE=$G(^TMP("PXS",$J,"PPD",MDKDATE,MDKIEN,0))
	...Q:MDKNODE=""
	...S MDKCNT=MDKCNT+1
	...;RESULT(N)=skin test^date
	...S RESULT(MDKCNT)=$P(MDKNODE,U,1)_U_$P(MDKNODE,U,2)
	...S RESULT(0)=MDKCNT
	...Q
	..Q
	.Q
	K ^TMP("PXS",$J)
	Q
LAB	; get lab results
	; data = dfn^start date^end date^max # of entires to return
	N LA7PTID,LA7SDT,LA7EDT,LA7SC,LA7SPEC
	N MDK64PTR,MDKARRAY,MDKCNT,MDKCODE,MDKDATE,MDKEDT,MDKFLAG,MDKLOOP,MDKMAX,MDKNLT,MDKNODE,MDKODT,MDKRSULT
	N MDKSC,MDKSDT,MDKSSN,MDKTEST,MDKTOT,MDKUNIT
	S DATA=$G(DATA)
	S DFN=$P(DATA,U,1)
	Q:'DFN
	S MDKSDT=$P(DATA,U,2) ;start date
	S MDKEDT=$P(DATA,U,3) ;end date
	S MDKMAX=+$P(DATA,U,4) ;# of entries per test
	S MDKSSN=$P($G(^DPT(DFN,0)),U,9) ;patient ssn
	I MDKEDT="" S MDKEDT=$$NOW^XLFDT()
	;I MDKSDT="" S MDKSDT=$$FMADD^XLFDT(DT,-90) ;go back 90 days
	I MDKSDT="" S MDKSDT=$$FMADD^XLFDT(DT,-365) ;<-- TESTING ONLY
	I 'MDKMAX S MDKMAX=3
	; array(nlt code)=test name
	S MDKSC("84520.")="BUN"
	S MDKSC("82565.")="CREATININE"
	S MDKSC("84295.")="SODIUM"
	S MDKSC("84140.")="POTASSIUM"
	S MDKSC("82435.")="CHLORIDE"
	S MDKSC("82830.")="CARBON DIOXIDE"
	S MDKSC("82310.")="CALCIUM"
	S MDKSC("84100.")="PHOSPHORUS"
	S MDKSC("82040.")="ALBUMIN"
	S MDKSC("84455.")="AST"
	S MDKSC("84465.")="ALT"
	S MDKSC("84075.")="ALKALINE PHOSPHATASE"
	S MDKSC("82250.")="BILIRUBIN"
	S MDKSC("83020.")="HEMOGLOBIN"
	S MDKSC("85055.")="HEMATOCRIT"
	S MDKSC("85569.")="WBC"
	S MDKSC("86806.")="PLATELETS"
	S MDKSC("83057.")="HEMOGLOBIN A1C"
	S MDKSC("82466.")="CHOLESTEROL"
	S MDKSC("84480.")="TRIGLYCERIDES"
	S MDKSC("82370.")="FERRITIN"
	S MDKSC("83540.")="IRON"
	S MDKSC("82060.")="TRANSFERRIN"
	S MDKSC("84012.")="PARATHRYROID HORMONE"
	S MDKSC("81512.")="ALUMINUM"
	S MDKSC("89068.")="HEPATITIS B SURFACE ANTIGEN"
	S MDKSC("89065.")="HEPATITIS B SURFACE ANTIBODY"
	S MDKSC("89067.")="HEPATITIS B SURFACE ANTIBODY"
	S MDKSC("82013.")="HEPATITIS B SURFACE ANTIBODY"
	S MDKSC("89095.")="HEPATITIS B SURFACE ANTIBODY"
	S MDKSC("89127.")="HEPATITIS B SURFACE ANTIBODY"
	S MDKSC("89128.")="HEPATITIS B SURFACE ANTIBODY"
	S MDKSC("87398.")="HEPATITIS B SURFACE ANTIBODY"
	S MDKSC("89699.")="HEPATITIS B SURFACE ANTIBODY"
	S MDKSC("89070.")="HEPATITIS C ANTIBODY"
	S MDKSC("87261.")="FLU"
	K ^TMP("HLS",$J)
	S LA7SDT=MDKSDT_"^RAD" ;start date
	S LA7EDT=MDKEDT_"^RAD" ;end date
	S LA7SC="CH" ;all chemistry tests
	S LA7SPEC="*" ;all specimens
	S LA7PTID=MDKSSN ;patient's ssn
	S MDKARRAY=$$GCPR^LA7QRY(LA7PTID,LA7SDT,LA7EDT,.LA7SC,LA7SPEC,"","","")
	S (MDKCNT,MDKTOT)=0
	F  S MDKCNT=$O(^TMP("HLS",$J,MDKCNT)) Q:'MDKCNT  D
	.S MDKNODE=$G(^TMP("HLS",$J,MDKCNT))
	.Q:$E(MDKNODE,1,3)'="OBX"
	.S MDKFLAG=0
	.S MDKTEST=$P(MDKNODE,"|",4) ;test ids
	.S MDKCODE=""
	.F  S MDKCODE=$O(MDKSC(MDKCODE)) Q:MDKCODE=""!(MDKFLAG=1)  D
	..I MDKTEST[MDKCODE S MDKFLAG=1,MDKNLT=MDKCODE
	..Q
	.Q:'MDKFLAG  ;nlt code doesn't match
	.S MDKDATE=$P(MDKNODE,"|",15) ;date
	.S MDKDATE=$P(MDKDATE,"-",1) ;strip off time zone offset
	.S MDKRSULT=$P(MDKNODE,"|",6) ;result
	.S MDKUNIT=$P(MDKNODE,"|",7) ;unit
	.S MDKTOT=MDKTOT+1
	.S RESULT(MDKTOT)=$G(MDKSC(MDKNLT))_U_MDKDATE_U_MDKRSULT_U_MDKUNIT
	.S RESULT(0)=$G(RESULT(0))+1
	.Q
	K ^TMP("HLS",$J)
	Q
AD	; get advance directives
	; DATA = DFN
	S DFN=$G(DATA)
	N MDKLOOP
	K ^TMP("TIUPPCV",$J)
	D ENCOVER^TIUPP3(DFN)
	I '$D(^TMP("TIUPPCV",$J)) Q
	S RESULT(1)="No",RESULT(0)=1
	S MDKLOOP=0
	F  S MDKLOOP=$O(^TMP("TIUPPCV",$J,MDKLOOP)) Q:'MDKLOOP  D
	.I $P(^TMP("TIUPPCV",$J,MDKLOOP),U,2)'="D" Q
	.S RESULT(1)="Yes"
	.S RESULT(0)=1
	.Q
	K ^TMP("TIUPPCV",$J)
	Q
	;
CW	; get clinical warnings
	; DATA = DFN
	S DFN=$G(DATA)
	N MDKCNT,MDKLOOP
	K ^TMP("TIUPPCV",$J)
	D ENCOVER^TIUPP3(DFN)
	S RESULT(1)="None",RESULT(0)=1
	I '$D(^TMP("TIUPPCV",$J)) Q
	S (MDKCNT,MDKLOOP)=0
	F  S MDKLOOP=$O(^TMP("TIUPPCV",$J,MDKLOOP)) Q:'MDKLOOP  D
	.I $P(^TMP("TIUPPCV",$J,MDKLOOP),U,2)'="W" Q
	.S MDKCNT=MDKCNT+1
	.S RESULT(MDKCNT)=^TMP("TIUPPCV",$J,MDKLOOP)
	.Q
	S RESULT(0)=MDKCNT
	K ^TMP("TIUPPCV",$J)
	Q
	;
GETPROV	; Get list of available providers with name starting with P1
	N MDDATE,MDDUP,MDRI,MDI1,MDI2,MDLAST,MDMAX,MDPREV,MDTTL
	S MDRI=0,MDMAX=44,(MDLAST,MDPREV)="",X1=DT,MDFROM=DATA,MDDATE=DT
	F  Q:MDRI'<MDMAX  S MDFROM=$O(^VA(200,"AUSER",MDFROM),1) Q:MDFROM=""  D
	.S MDI1=""
	.F  S MDI1=$O(^VA(200,"AUSER",MDFROM,MDI1),1) Q:'MDI1  D
	..I MDDATE>0,$$GET^XUA4A72(MDI1,MDDATE)<1 Q    ; Check date?
	..S MDRI=MDRI+1,RESULT(MDRI)=MDI1_U_$$NAMEFMT^XLFNAME(MDFROM,"F","DcMPC")
	I MDRI<1 S RESULT(0)="-1^No matches found." Q
	S RESULT(0)=MDRI
	Q
	;
TIME	; Get time
	S RESULT(0)=$$NOW^XLFDT()
	Q
GETLD	; Get MDK Application Install Info
	N MDS
	S MDS=$$GET^XPAR("SYS","MDK APPLICATION INSTALL","DATE_TIME_OF_LAUNCH")
	S MDS=MDS_"^"_$$GET^XPAR("SYS","MDK APPLICATION INSTALL","USER")
	S MDS=MDS_"^"_$$GET^XPAR("SYS","MDK APPLICATION INSTALL","OPTION_LOADED")
	S MDS=MDS_"^"_$$GET^XPAR("SYS","MDK APPLICATION INSTALL","WORKSTATION")
	S RESULT(0)=MDS
	Q
SETLD	; Set MDK Application Install Info
	D EN^XPAR("SYS","MDK APPLICATION INSTALL","DATE_TIME_OF_LAUNCH",$P(DATA,"^"))
	D EN^XPAR("SYS","MDK APPLICATION INSTALL","USER",$P(DATA,"^",2))
	D EN^XPAR("SYS","MDK APPLICATION INSTALL","OPTION_LOADED",$P(DATA,"^",3))
	D EN^XPAR("SYS","MDK APPLICATION INSTALL","WORKSTATION",$P(DATA,"^",4))
	Q