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

BEHORXF2.m

Go to the documentation of this file. 
  1. BEHORXF2 ;MSC/IND/PLS -  XML Support for Pharmacy Rx Gen service ;14-Nov-2013 15:46;DU
  1.  ;;1.1;BEH COMPONENTS;**009009,009010,009011,009012**;Sep 18, 2007
  1.  ;=================================================================
  1.  ; RPC: BEHORXF2 DRUGTXT
  1.  ; Returns data from 51.7 associated with drug
  1.  ;
  1. DRUGTXT(DATA,DRG) ;EP-
  1.  S DATA=$NA(^TMP("PSSDIN",$J))
  1.  D EN^PSSDIN(,DRG)
  1.  Q
  1. GETALG(DFN) ;EP Get allergy data
  1.  N ALG,GMRAL,BEHI,BEHY
  1.  S ALG=""
  1.  D EN1^GMRADPT
  1.  I $D(GMRAL)'>9 D
  1.  . I $D(GMRAL),GMRAL=0 S ALG="Patient has answered NKA"
  1.  . E  S ALG="No Allergy Assessment"
  1.  S BEHI=0,BEHY=""
  1.  F  S BEHI=$O(GMRAL(BEHI)) Q:+BEHI'>0  D
  1.  . N X,Y,BEHX
  1.  . S BEHX=$P($G(GMRAL(BEHI)),U,2)
  1.  . S BEHY=$$APPEND(BEHX,BEHY,250)
  1.  . I BEHY=BEHX
  1.  . S ALG=BEHY
  1.  Q ALG
  1. APPEND(X,Y,LEN) ; Append ", "_X to Y, unless Y would excede LEN
  1.  Q $S('$L(Y):X,($L(Y_$C(44)_" "_X)'>LEN):Y_$C(44)_" "_X,1:X)
  1. WEIGHT(DFN) ;Get latest weight
  1.  N MSR,VMSR,OUT
  1.  S (WT,OUT)=""
  1.  S VMSR=$$VMSR^BEHOVM
  1.  S MSR="WT"
  1.  D QRYGMR:'VMSR,QRYMSR:VMSR
  1.  S WT=$P(OUT,U,1)
  1.  Q WT
  1. HT(DFN) ;Get latest height
  1.  N MSR,VMSR,OUT
  1.  S (HT,OUT)=""
  1.  S VMSR=$$VMSR^BEHOVM
  1.  S MSR="HT"
  1.  D QRYGMR:'VMSR,QRYMSR:VMSR
  1.  S HT=$P(OUT,U,1)
  1.  Q HT
  1. BMI(DFN) ; Get latest BMI
  1.  N BMI,HT,WT,WTDT,X,HTDT,OUT
  1.  S (BMI,OUT)=""
  1.  S VMSR=$$VMSR^BEHOVM
  1.  S MSR="WT"
  1.  D QRYGMR:'VMSR,QRYMSR:VMSR
  1.  S WT=$P(OUT,U,2),WTDT=$P(OUT,U,3)
  1.  I '+WT  G END
  1.  S MSR="HT"
  1.  D QRYGMR:'VMSR,QRYMSR:VMSR
  1.  S HT=$P(OUT,U,2),HTDT=$P(OUT,U,3)
  1.  I '+HT G END
  1.  S BMI=""
  1.  S WT=WT*.45359,HT=HT*.0254,HT=HT*HT,BMI=+$J(WT/HT,0,2)
  1.  S OUT="BMI: "_BMI_" on  "_$$FMTDATE^BGOUTL(WTDT)
  1. END Q OUT
  1. QRYMSR ; Get data from V file
  1.  N VDT,IEN,FOUND,DATE,VALUE,MSR2
  1.  S OUT="",VDT=0
  1.  S FOUND=0,MSR2=0
  1.  S MSR2=$O(^AUTTMSR("B",MSR,MSR2))
  1.  Q:'+MSR2
  1.  F  S VDT=$O(^AUPNVMSR("AA",DFN,MSR2,VDT))  Q:('VDT)!(+FOUND)  D
  1.  .S IEN=0
  1.  .F  S IEN=$O(^AUPNVMSR("AA",DFN,MSR2,VDT,IEN)) Q:'IEN!(+FOUND)  D
  1.  ..K BEH D ENP^XBDIQ1(9000010.01,IEN,".03;.04;2;1201","BEH(","I")
  1.  ..Q:BEH(2,"I")=1
  1.  ..S FOUND=1
  1.  ..S DATE=$S($G(BEH(1201,"I"))]"":+BEH(1201,"I"),1:(9999999-VDT))
  1.  ..I MSR="HT" S Y=$G(BEH(.04)),Y=$J(Y,5,2)_" in ["_$J((Y*2.54),5,2)_" cm]",VALUE=Y
  1.  ..I MSR="WT" S Y=$G(BEH(.04)),Y=$J(Y,5,2)_" lb ["_$J((Y*.454),5,2)_" kg]",VALUE=Y
  1.  ..S OUT=MSR_": "_VALUE_" on "_$$FMTDATE^BGOUTL(DATE)_U_$G(BEH(.04))_U_DATE
  1.  Q
  1. QRYGMR ;Get data from GMR file
  1.  N VDT,IEN,FOUND,DATE,VALUE,MSR2
  1.  S OUT="",VDT=0
  1.  S FOUND=0,MSR2=0
  1.  S MSR2=$O(^GMRD(120.51,"C",MSR,MSR2))
  1.  Q:'+MSR2
  1.  F  S IEN=$O(^GMR(120.5,"AA",DFN,MSR2,VDT)) Q:('VDT)!(+FOUND)  D
  1.  .S IEN=0
  1.  .F  S IEN=$O(^GMR(120.5,"AA",DFN,MSR2,VDT,IEN)) Q:'IEN!(+FOUND)  D
  1.  ..K BEH D ENP^XBDIQ1(120.5,IEN,".01;1.2;2","BEH(","I")
  1.  ..Q:BEH(2,"I")=1
  1.  ..S FOUND=1
  1.  ..S DATE=$G(BEH(.01,"I"))
  1.  ..I MSR="HT" S Y=$G(BEH(1.2)),Y=$J(Y,5,2)_" in ["_$J((Y*2.54),5,2)_" cm]",VALUE=Y
  1.  ..I MSR="WT" S Y=$G(BEH(1.2)),Y=$J(Y,5,2)_" lb ["_$J((Y*.454),5,2)_" kg]",VALUE=Y
  1.  ..S OUT=MSR_": "_VALUE_" on "_$$FMTDATE^BGOUTL(DATE)_U_$G(BEH(1.2))_U_DATE
  1.  Q
  1.  ;Get RxNorm for order
  1. RXNORM(POF) ;
  1.  N RXNORM,DIEN,NDC
  1.  S RXNORM=""
  1.  S DIEN=$$GET1^DIQ(52.41,POF,11,"I")
  1.  I +DIEN D
  1.  .S RXNORM=$$RXNORDRG^APSPFNC1(+DIEN)
  1.  .;S NDC=$TR($P($G(^PSDRUG(DIEN,2)),U,4),"-","")
  1.  .;Q:'$L(NDC)
  1.  .;S RXNORM=+$O(^C0CRXN(176.002,"NDC",NDC,0))
  1.  .;S RXNORM=$$GET1^DIQ(176.002,RXNORM,.01)
  1.  Q RXNORM
  1.  ;Get patient data
  1. BLDPT(DFN,RX) ;
  1.  N SSN
  1.  S RX=$G(RX)
  1.  I RX'="" D ADD($$TAG^BEHORXF1("PatientHRN",2,$$HRN^AUPNPAT3(DFN,$$GET1^DIQ(59,$$GET1^DIQ(52,RX,20,"I"),100,"I"))))
  1.  I RX="" D ADD($$TAG^BEHORXF1("PatientHRN",2,$$HRN^AUPNPAT3(DFN,DUZ(2))))
  1.  D ADD($$TAG^BEHORXF1("PatientDOB",2,$$FMTE^XLFDT($$GET1^DIQ(2,DFN,.03,"I"),9)))
  1.  D ADD($$TAG^BEHORXF1("PatientGender",2,$$GET1^DIQ(2,DFN,.02)))
  1.  D ADD($$TAG^BEHORXF1("PatientPhone",2,$$GET1^DIQ(2,DFN,.131)))
  1.  S SSN=$$GET1^DIQ(2,DFN,.09)
  1.  D ADD($$TAG^BEHORXF1("PatientLastFour",2,$$FMTSSN^APSPFUNC(SSN)))
  1.  Q
  1.  ; Build nodes for patient address
  1. BLDPTADD(DFN) ;
  1.  D ADD($$TAG^BEHORXF1("PatientAddress1",2,$$GET1^DIQ(2,DFN,.111)))
  1.  D ADD($$TAG^BEHORXF1("PatientAddress2",2,$$GET1^DIQ(2,DFN,.112)))
  1.  D ADD($$TAG^BEHORXF1("PatientAddress3",2,$$GET1^DIQ(2,DFN,.113)))
  1.  D ADD($$TAG^BEHORXF1("PatientCity",2,$$GET1^DIQ(2,DFN,.114)))
  1.  D ADD($$TAG^BEHORXF1("PatientState",2,$$GET1^DIQ(2,DFN,.115)))
  1.  D ADD($$TAG^BEHORXF1("PatientZipCode",2,$$GET1^DIQ(2,DFN,.116)))
  1.  Q
  1. PROV(PRVIEN,ORD) ;
  1.  N X
  1.  D ADD($$TAG^BEHORXF1("ProviderDEA",2,$$DEAVAUS^APSPFUNC(PRVIEN)))
  1.  ;D ADD($$TAG^BEHORXF1("ProvIEN",2,PRVIEN))
  1.  D ADD($$TAG^BEHORXF1("ProviderPhone",2,$$PRVINFO(PRVIEN,.132)))
  1.  D ADD($$TAG^BEHORXF1("ProviderFax",2,$$PRVINFO(PRVIEN,.136)))
  1.  ;D ADD($$TAG^BEHORXF1("ProviderESig",2,$S($L($$PRVINFO(PRVIEN,20.4)):"Electronic Signature on File",1:"")))
  1.  S X=$$PRVINFO(PRVIEN,20.2)
  1.  D ADD($$TAG^BEHORXF1("ProviderESig",2,$S($L(X):"/ES/ "_X,1:"")))
  1.  D ADD($$TAG^BEHORXF1("ProviderESigTitle",2,$$PRVINFO(PRVIEN,20.3)))
  1.  D ADD($$TAG^BEHORXF1("ProviderNPI",2,$$PRVINFO(PRVIEN,41.99)))
  1.  D ADD($$TAG^BEHORXF1("ProviderSup",2,$$GET1^DIQ(49,$$GET1^DIQ(200,PRVIEN,29,"I"),2)))
  1.  Q
  1.  ;Get patient data
  1. DATA(DFN) ;
  1.  D ADD($$TAG^BEHORXF1("Allergies",2,$$GETALG^BEHORXF2(DFN)))
  1.  D ADD($$TAG^BEHORXF1("Weight",2,$$WEIGHT^BEHORXF2(DFN)))
  1.  D ADD($$TAG^BEHORXF1("Height",2,$$HT^BEHORXF2(DFN)))
  1.  D ADD($$TAG^BEHORXF1("BMI",2,$$BMI^BEHORXF2(DFN)))
  1.  Q
  1.  ; Add data to array
  1. ADD(VAL) ;EP-
  1.  S CNT=CNT+1
  1.  S @DATA@(CNT)=VAL
  1.  Q
  1.  ; Returns Provider information
  1. PRVINFO(USR,FLD,FLG) ;EP-
  1.  S FLG=$G(FLG,"E")
  1.  Q $$GET1^DIQ(200,USR,FLD,FLG)