Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MDKRPC1

MDKRPC1.m

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