MDKRPC1 ;HIOFO/FT-RPC to return patient data ;8/12/16 10:45am
;;1.0;CLINICAL PROCEDURES;**6,47**;Apr 01, 2004;Build 3
;
; 08/12/2016 KAM/BAY CA/SDM - I9088043FY16/MD*1*47 Modifications to
; utilize the new Group Name field in
; the Immunization File (9999999.14) for
; Hemodialysis
;
; 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
;
; KAM/BP MD*1*47 Added code to handle Immun (9999999.14) File
; Standardization by the VIMM group in patch PX*1*201
; Original Code left in for backward compatibility
;
N MDKCNT,MDKDATE,MDKIEN,MDKIMMUM,MDKNAME,MDKNODE,MDKGRPNAME
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=""
...;
...; 08/12/2016 KAM/BP CA/SDM - I9088043FY16/MD*1*47
...; Check to see if there is a Group Name in the Immun Rec
...; If so do not add this record to the RESULT array
...; It will be included later with the Group data
...;
... N MDKIIEN
... S MDKIIEN=$P(^AUPNVIMM(MDKIEN,0),"^")
... Q:$D(^AUTTIMM(MDKIIEN,7,1,0))
... ;
...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
;
; 08/12/2016 KAM/BP CA/SDM - I9088043FY16/MD*1*47
; Get vaccination data using the Group Field
;
S MDKIMMUM("HepA")="HEPATITIS A"
S MDKIMMUM("HepB")="HEPATITIS B"
S MDKIMMUM("FLU")="FLU"
S MDKIMMUM("PneumoPPV")="PNEUMOCOCCAL"
S MDKIMMUM("PneumoPCV")="PNEUMOCOCCAL"
S MDKIMMUM("PPD")="PPD"
F MDKGRPNAME="HepA","HepB","FLU","PneumoPPV","PneumoPCV" D
.K ^TMP("PXI",$J)
.D IMMUN^PXRHS03(DFN,"A","G:"_MDKGRPNAME)
.Q:'$D(^TMP("PXI",$J))
.S MDKNAME=""
.F S MDKNAME=$O(^TMP("PXI",$J,MDKNAME)) Q:MDKNAME="" D
..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(MDKGRPNAME)_U_$P(MDKNODE,U,3)_U_$P(MDKNODE,U,6)_U_$P(MDKNODE,U,7)
;End of changes for CA/SDM - I9088043FY16/MD*1*47
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDKRPC1 10346 printed Mar 13, 2025@20:47:40 Page 2
MDKRPC1 ;HIOFO/FT-RPC to return patient data ;8/12/16 10:45am
+1 ;;1.0;CLINICAL PROCEDURES;**6,47**;Apr 01, 2004;Build 3
+2 ;
+3 ; 08/12/2016 KAM/BAY CA/SDM - I9088043FY16/MD*1*47 Modifications to
+4 ; utilize the new Group Name field in
+5 ; the Immunization File (9999999.14) for
+6 ; Hemodialysis
+7 ;
+8 ; This routine uses the following IAs:
+9 ; #1239 - ^PXRHS03 (controlled)
+10 ; #1240 - ^PXRHS04 (private)
+11 ; #1625 - ^XUA4A72 (supported)
+12 ; #2263 - ^XPAR (supported)
+13 ; #2864 - ^TIUPP3 calls (controlled)
+14 ; #3065 - ^XLFNAME (supported)
+15 ; #3556 - ^LA7QRY (controlled)
+16 ; #10035 - ^DPT global refs (supported)
+17 ; #10060 - ^FILE 200 refs (supported)
+18 ; #10099 - ^GMRADPT calls (supported)
+19 ; #10103 - ^XLFDT calls (supported)
+20 ; #4868 - VA(200,"AUSER" (Private)
+21 ;
RPC(RESULT,OPTION,DATA) ; RPC to return existing VistA patient data for
+1 ; renal dialysis data entry.
+2 ; RPC: [MDK GET VISTA DATA]
+3 ;
+4 ; Input parameters
+5 ; 1. RESULT [Reference/Required] RPC Return array
+6 ; 2. OPTION [Literal/Required] RPC Option to execute
+7 ; 3. DATA [Literal/Required] Other data as required for call
+8 ;
+9 KILL RESULT
+10 if $TEXT(@OPTION)]""
DO @OPTION
+11 if '$DATA(RESULT)
SET RESULT(0)="-1^No results returned"
+12 QUIT
DEMO ; demographic
+1 NEW DFN,MDKNODE0,MDKSSN
+2 SET DFN=$GET(DATA)
+3 IF '$GET(DFN)
Begin DoDot:1
+4 SET RESULT(0)="-1^DFN is not defined"
+5 QUIT
End DoDot:1
QUIT
+6 IF '$DATA(^DPT(DFN,0))
Begin DoDot:1
+7 SET RESULT(0)="-1^Patient not found"
+8 QUIT
End DoDot:1
QUIT
+9 SET MDKNODE0=$GET(^DPT(DFN,0))
+10 ;name
SET RESULT(1)=$PIECE(MDKNODE0,U,1)
+11 ;ssn
SET RESULT(2)=$PIECE(MDKNODE0,U,9)
+12 ;date of birth
SET RESULT(3)=$PIECE(MDKNODE0,U,3)
+13 SET RESULT(0)=3
+14 QUIT
ALLERGY ; get allergy data
+1 ; DATA = DFN
+2 SET DFN=$GET(DATA)
+3 NEW GMRAL
+4 NEW MDKCNT,MDLOOP
+5 SET (MDKCNT,MDKLOOP)=0
+6 DO EN1^GMRADPT
+7 IF $ORDER(GMRAL(0))'>0
Begin DoDot:1
+8 if $GET(GMRAL)=""
SET RESULT(1)="No Allergy Assessment"
+9 if $GET(GMRAL)=0
SET RESULT(1)="No Known Allergies"
+10 SET RESULT(0)=1
+11 QUIT
End DoDot:1
QUIT
+12 IF $ORDER(GMRAL(0))>0
Begin DoDot:1
+13 FOR
SET MDKLOOP=$ORDER(GMRAL(MDKLOOP))
if MDKLOOP'>0
QUIT
Begin DoDot:2
+14 SET MDKCNT=MDKCNT+1
+15 SET RESULT(MDKCNT)=$PIECE($GET(GMRAL(MDKLOOP)),U,2)
+16 QUIT
End DoDot:2
+17 SET RESULT(0)=MDKCNT
+18 QUIT
End DoDot:1
+19 QUIT
SHOTS ; get latest vaccination data
+1 ;
+2 ; KAM/BP MD*1*47 Added code to handle Immun (9999999.14) File
+3 ; Standardization by the VIMM group in patch PX*1*201
+4 ; Original Code left in for backward compatibility
+5 ;
+6 NEW MDKCNT,MDKDATE,MDKIEN,MDKIMMUM,MDKNAME,MDKNODE,MDKGRPNAME
+7 SET DFN=$GET(DATA)
+8 SET (MDKCNT,RESULT(0))=0
+9 SET MDKIMMUM("HEP A")="HEPATITIS A"
+10 SET MDKIMMUM("HEP B")="HEPATITIS B"
+11 SET MDKIMMUM("INFLUENZA")="FLU"
+12 SET MDKIMMUM("PNEUMO-VAC")="PNEUMOCOCCAL"
+13 ;S MDKIMMUM("PNEUMOCOCCAL")="PNEUMONIA"
+14 SET MDKIMMUM("PPD")="PPD"
+15 DO IMMUN^PXRHS03(DFN)
+16 FOR MDKNAME="HEP A","HEP B","INFLUENZA","PNEUMO-VAC"
Begin DoDot:1
+17 if '$DATA(^TMP("PXI",$JOB,MDKNAME))
QUIT
+18 SET MDKDATE=0
+19 FOR
SET MDKDATE=$ORDER(^TMP("PXI",$JOB,MDKNAME,MDKDATE))
if 'MDKDATE
QUIT
Begin DoDot:2
+20 SET MDKIEN=0
+21 FOR
SET MDKIEN=$ORDER(^TMP("PXI",$JOB,MDKNAME,MDKDATE,MDKIEN))
if 'MDKIEN
QUIT
Begin DoDot:3
+22 SET MDKNODE=$GET(^TMP("PXI",$JOB,MDKNAME,MDKDATE,MDKIEN,0))
+23 if MDKNODE=""
QUIT
+24 ;
+25 ; 08/12/2016 KAM/BP CA/SDM - I9088043FY16/MD*1*47
+26 ; Check to see if there is a Group Name in the Immun Rec
+27 ; If so do not add this record to the RESULT array
+28 ; It will be included later with the Group data
+29 ;
+30 NEW MDKIIEN
+31 SET MDKIIEN=$PIECE(^AUPNVIMM(MDKIEN,0),"^")
+32 if $DATA(^AUTTIMM(MDKIIEN,7,1,0))
QUIT
+33 ;
+34 SET MDKCNT=MDKCNT+1
+35 ;RESULT(N)=shot name^date^reaction^contraindicated
+36 SET RESULT(MDKCNT)=MDKIMMUM(MDKNAME)_U_$PIECE(MDKNODE,U,3)_U_$PIECE(MDKNODE,U,6)_U_$PIECE(MDKNODE,U,7)
+37 QUIT
End DoDot:3
+38 QUIT
End DoDot:2
+39 QUIT
End DoDot:1
+40 ;
+41 ; 08/12/2016 KAM/BP CA/SDM - I9088043FY16/MD*1*47
+42 ; Get vaccination data using the Group Field
+43 ;
+44 SET MDKIMMUM("HepA")="HEPATITIS A"
+45 SET MDKIMMUM("HepB")="HEPATITIS B"
+46 SET MDKIMMUM("FLU")="FLU"
+47 SET MDKIMMUM("PneumoPPV")="PNEUMOCOCCAL"
+48 SET MDKIMMUM("PneumoPCV")="PNEUMOCOCCAL"
+49 SET MDKIMMUM("PPD")="PPD"
+50 FOR MDKGRPNAME="HepA","HepB","FLU","PneumoPPV","PneumoPCV"
Begin DoDot:1
+51 KILL ^TMP("PXI",$JOB)
+52 DO IMMUN^PXRHS03(DFN,"A","G:"_MDKGRPNAME)
+53 if '$DATA(^TMP("PXI",$JOB))
QUIT
+54 SET MDKNAME=""
+55 FOR
SET MDKNAME=$ORDER(^TMP("PXI",$JOB,MDKNAME))
if MDKNAME=""
QUIT
Begin DoDot:2
+56 SET MDKDATE=0
+57 FOR
SET MDKDATE=$ORDER(^TMP("PXI",$JOB,MDKNAME,MDKDATE))
if 'MDKDATE
QUIT
Begin DoDot:3
+58 SET MDKIEN=0
+59 FOR
SET MDKIEN=$ORDER(^TMP("PXI",$JOB,MDKNAME,MDKDATE,MDKIEN))
if 'MDKIEN
QUIT
Begin DoDot:4
+60 SET MDKNODE=$GET(^TMP("PXI",$JOB,MDKNAME,MDKDATE,MDKIEN,0))
+61 if MDKNODE=""
QUIT
+62 SET MDKCNT=MDKCNT+1
+63 ;RESULT(N)=shot name^date^reaction^contraindicated
+64 SET RESULT(MDKCNT)=MDKIMMUM(MDKGRPNAME)_U_$PIECE(MDKNODE,U,3)_U_$PIECE(MDKNODE,U,6)_U_$PIECE(MDKNODE,U,7)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+65 ;End of changes for CA/SDM - I9088043FY16/MD*1*47
+66 ;
+67 SET RESULT(0)=MDKCNT
+68 KILL ^TMP("PXI",$JOB)
+69 ; get PPD (skin) result
+70 DO SKIN^PXRHS04(DFN)
+71 IF $DATA(^TMP("PXS",$JOB))
Begin DoDot:1
+72 SET MDKDATE=0
+73 FOR
SET MDKDATE=$ORDER(^TMP("PXS",$JOB,"PPD",MDKDATE))
if 'MDKDATE
QUIT
Begin DoDot:2
+74 SET MDKIEN=0
+75 FOR
SET MDKIEN=$ORDER(^TMP("PXS",$JOB,"PPD",MDKDATE,MDKIEN))
if 'MDKIEN
QUIT
Begin DoDot:3
+76 SET MDKNODE=$GET(^TMP("PXS",$JOB,"PPD",MDKDATE,MDKIEN,0))
+77 if MDKNODE=""
QUIT
+78 SET MDKCNT=MDKCNT+1
+79 ;RESULT(N)=skin test^date
+80 SET RESULT(MDKCNT)=$PIECE(MDKNODE,U,1)_U_$PIECE(MDKNODE,U,2)
+81 SET RESULT(0)=MDKCNT
+82 QUIT
End DoDot:3
+83 QUIT
End DoDot:2
+84 QUIT
End DoDot:1
+85 KILL ^TMP("PXS",$JOB)
+86 QUIT
LAB ; get lab results
+1 ; data = dfn^start date^end date^max # of entires to return
+2 NEW LA7PTID,LA7SDT,LA7EDT,LA7SC,LA7SPEC
+3 NEW MDK64PTR,MDKARRAY,MDKCNT,MDKCODE,MDKDATE,MDKEDT,MDKFLAG,MDKLOOP,MDKMAX,MDKNLT,MDKNODE,MDKODT,MDKRSULT
+4 NEW MDKSC,MDKSDT,MDKSSN,MDKTEST,MDKTOT,MDKUNIT
+5 SET DATA=$GET(DATA)
+6 SET DFN=$PIECE(DATA,U,1)
+7 if 'DFN
QUIT
+8 ;start date
SET MDKSDT=$PIECE(DATA,U,2)
+9 ;end date
SET MDKEDT=$PIECE(DATA,U,3)
+10 ;# of entries per test
SET MDKMAX=+$PIECE(DATA,U,4)
+11 ;patient ssn
SET MDKSSN=$PIECE($GET(^DPT(DFN,0)),U,9)
+12 IF MDKEDT=""
SET MDKEDT=$$NOW^XLFDT()
+13 ;I MDKSDT="" S MDKSDT=$$FMADD^XLFDT(DT,-90) ;go back 90 days
+14 ;<-- TESTING ONLY
IF MDKSDT=""
SET MDKSDT=$$FMADD^XLFDT(DT,-365)
+15 IF 'MDKMAX
SET MDKMAX=3
+16 ; array(nlt code)=test name
+17 SET MDKSC("84520.")="BUN"
+18 SET MDKSC("82565.")="CREATININE"
+19 SET MDKSC("84295.")="SODIUM"
+20 SET MDKSC("84140.")="POTASSIUM"
+21 SET MDKSC("82435.")="CHLORIDE"
+22 SET MDKSC("82830.")="CARBON DIOXIDE"
+23 SET MDKSC("82310.")="CALCIUM"
+24 SET MDKSC("84100.")="PHOSPHORUS"
+25 SET MDKSC("82040.")="ALBUMIN"
+26 SET MDKSC("84455.")="AST"
+27 SET MDKSC("84465.")="ALT"
+28 SET MDKSC("84075.")="ALKALINE PHOSPHATASE"
+29 SET MDKSC("82250.")="BILIRUBIN"
+30 SET MDKSC("83020.")="HEMOGLOBIN"
+31 SET MDKSC("85055.")="HEMATOCRIT"
+32 SET MDKSC("85569.")="WBC"
+33 SET MDKSC("86806.")="PLATELETS"
+34 SET MDKSC("83057.")="HEMOGLOBIN A1C"
+35 SET MDKSC("82466.")="CHOLESTEROL"
+36 SET MDKSC("84480.")="TRIGLYCERIDES"
+37 SET MDKSC("82370.")="FERRITIN"
+38 SET MDKSC("83540.")="IRON"
+39 SET MDKSC("82060.")="TRANSFERRIN"
+40 SET MDKSC("84012.")="PARATHRYROID HORMONE"
+41 SET MDKSC("81512.")="ALUMINUM"
+42 SET MDKSC("89068.")="HEPATITIS B SURFACE ANTIGEN"
+43 SET MDKSC("89065.")="HEPATITIS B SURFACE ANTIBODY"
+44 SET MDKSC("89067.")="HEPATITIS B SURFACE ANTIBODY"
+45 SET MDKSC("82013.")="HEPATITIS B SURFACE ANTIBODY"
+46 SET MDKSC("89095.")="HEPATITIS B SURFACE ANTIBODY"
+47 SET MDKSC("89127.")="HEPATITIS B SURFACE ANTIBODY"
+48 SET MDKSC("89128.")="HEPATITIS B SURFACE ANTIBODY"
+49 SET MDKSC("87398.")="HEPATITIS B SURFACE ANTIBODY"
+50 SET MDKSC("89699.")="HEPATITIS B SURFACE ANTIBODY"
+51 SET MDKSC("89070.")="HEPATITIS C ANTIBODY"
+52 SET MDKSC("87261.")="FLU"
+53 KILL ^TMP("HLS",$JOB)
+54 ;start date
SET LA7SDT=MDKSDT_"^RAD"
+55 ;end date
SET LA7EDT=MDKEDT_"^RAD"
+56 ;all chemistry tests
SET LA7SC="CH"
+57 ;all specimens
SET LA7SPEC="*"
+58 ;patient's ssn
SET LA7PTID=MDKSSN
+59 SET MDKARRAY=$$GCPR^LA7QRY(LA7PTID,LA7SDT,LA7EDT,.LA7SC,LA7SPEC,"","","")
+60 SET (MDKCNT,MDKTOT)=0
+61 FOR
SET MDKCNT=$ORDER(^TMP("HLS",$JOB,MDKCNT))
if 'MDKCNT
QUIT
Begin DoDot:1
+62 SET MDKNODE=$GET(^TMP("HLS",$JOB,MDKCNT))
+63 if $EXTRACT(MDKNODE,1,3)'="OBX"
QUIT
+64 SET MDKFLAG=0
+65 ;test ids
SET MDKTEST=$PIECE(MDKNODE,"|",4)
+66 SET MDKCODE=""
+67 FOR
SET MDKCODE=$ORDER(MDKSC(MDKCODE))
if MDKCODE=""!(MDKFLAG=1)
QUIT
Begin DoDot:2
+68 IF MDKTEST[MDKCODE
SET MDKFLAG=1
SET MDKNLT=MDKCODE
+69 QUIT
End DoDot:2
+70 ;nlt code doesn't match
if 'MDKFLAG
QUIT
+71 ;date
SET MDKDATE=$PIECE(MDKNODE,"|",15)
+72 ;strip off time zone offset
SET MDKDATE=$PIECE(MDKDATE,"-",1)
+73 ;result
SET MDKRSULT=$PIECE(MDKNODE,"|",6)
+74 ;unit
SET MDKUNIT=$PIECE(MDKNODE,"|",7)
+75 SET MDKTOT=MDKTOT+1
+76 SET RESULT(MDKTOT)=$GET(MDKSC(MDKNLT))_U_MDKDATE_U_MDKRSULT_U_MDKUNIT
+77 SET RESULT(0)=$GET(RESULT(0))+1
+78 QUIT
End DoDot:1
+79 KILL ^TMP("HLS",$JOB)
+80 QUIT
AD ; get advance directives
+1 ; DATA = DFN
+2 SET DFN=$GET(DATA)
+3 NEW MDKLOOP
+4 KILL ^TMP("TIUPPCV",$JOB)
+5 DO ENCOVER^TIUPP3(DFN)
+6 IF '$DATA(^TMP("TIUPPCV",$JOB))
QUIT
+7 SET RESULT(1)="No"
SET RESULT(0)=1
+8 SET MDKLOOP=0
+9 FOR
SET MDKLOOP=$ORDER(^TMP("TIUPPCV",$JOB,MDKLOOP))
if 'MDKLOOP
QUIT
Begin DoDot:1
+10 IF $PIECE(^TMP("TIUPPCV",$JOB,MDKLOOP),U,2)'="D"
QUIT
+11 SET RESULT(1)="Yes"
+12 SET RESULT(0)=1
+13 QUIT
End DoDot:1
+14 KILL ^TMP("TIUPPCV",$JOB)
+15 QUIT
+16 ;
CW ; get clinical warnings
+1 ; DATA = DFN
+2 SET DFN=$GET(DATA)
+3 NEW MDKCNT,MDKLOOP
+4 KILL ^TMP("TIUPPCV",$JOB)
+5 DO ENCOVER^TIUPP3(DFN)
+6 SET RESULT(1)="None"
SET RESULT(0)=1
+7 IF '$DATA(^TMP("TIUPPCV",$JOB))
QUIT
+8 SET (MDKCNT,MDKLOOP)=0
+9 FOR
SET MDKLOOP=$ORDER(^TMP("TIUPPCV",$JOB,MDKLOOP))
if 'MDKLOOP
QUIT
Begin DoDot:1
+10 IF $PIECE(^TMP("TIUPPCV",$JOB,MDKLOOP),U,2)'="W"
QUIT
+11 SET MDKCNT=MDKCNT+1
+12 SET RESULT(MDKCNT)=^TMP("TIUPPCV",$JOB,MDKLOOP)
+13 QUIT
End DoDot:1
+14 SET RESULT(0)=MDKCNT
+15 KILL ^TMP("TIUPPCV",$JOB)
+16 QUIT
+17 ;
GETPROV ; Get list of available providers with name starting with P1
+1 NEW MDDATE,MDDUP,MDRI,MDI1,MDI2,MDLAST,MDMAX,MDPREV,MDTTL
+2 SET MDRI=0
SET MDMAX=44
SET (MDLAST,MDPREV)=""
SET X1=DT
SET MDFROM=DATA
SET MDDATE=DT
+3 FOR
if MDRI'<MDMAX
QUIT
SET MDFROM=$ORDER(^VA(200,"AUSER",MDFROM),1)
if MDFROM=""
QUIT
Begin DoDot:1
+4 SET MDI1=""
+5 FOR
SET MDI1=$ORDER(^VA(200,"AUSER",MDFROM,MDI1),1)
if 'MDI1
QUIT
Begin DoDot:2
+6 ; Check date?
IF MDDATE>0
IF $$GET^XUA4A72(MDI1,MDDATE)<1
QUIT
+7 SET MDRI=MDRI+1
SET RESULT(MDRI)=MDI1_U_$$NAMEFMT^XLFNAME(MDFROM,"F","DcMPC")
End DoDot:2
End DoDot:1
+8 IF MDRI<1
SET RESULT(0)="-1^No matches found."
QUIT
+9 SET RESULT(0)=MDRI
+10 QUIT
+11 ;
TIME ; Get time
+1 SET RESULT(0)=$$NOW^XLFDT()
+2 QUIT
GETLD ; Get MDK Application Install Info
+1 NEW MDS
+2 SET MDS=$$GET^XPAR("SYS","MDK APPLICATION INSTALL","DATE_TIME_OF_LAUNCH")
+3 SET MDS=MDS_"^"_$$GET^XPAR("SYS","MDK APPLICATION INSTALL","USER")
+4 SET MDS=MDS_"^"_$$GET^XPAR("SYS","MDK APPLICATION INSTALL","OPTION_LOADED")
+5 SET MDS=MDS_"^"_$$GET^XPAR("SYS","MDK APPLICATION INSTALL","WORKSTATION")
+6 SET RESULT(0)=MDS
+7 QUIT
SETLD ; Set MDK Application Install Info
+1 DO EN^XPAR("SYS","MDK APPLICATION INSTALL","DATE_TIME_OF_LAUNCH",$PIECE(DATA,"^"))
+2 DO EN^XPAR("SYS","MDK APPLICATION INSTALL","USER",$PIECE(DATA,"^",2))
+3 DO EN^XPAR("SYS","MDK APPLICATION INSTALL","OPTION_LOADED",$PIECE(DATA,"^",3))
+4 DO EN^XPAR("SYS","MDK APPLICATION INSTALL","WORKSTATION",$PIECE(DATA,"^",4))
+5 QUIT
