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

BPHRMUPM.m

Go to the documentation of this file. 
  1. BPHRMUPM ;GDIT/HS/ALA-PHR MU Performance Measure ; 20 Aug 2013  9:54 AM
  1.  ;;2.1;IHS PERSONAL HEALTH RECORD;**1**;Apr 01, 2014;Build 23
  1.  ;
  1. PHR(DFN,BDT,EDT,RESULT,PROV) ;PEP - API call for Performance Measure
  1.  ; Input Parameters
  1.  ;  DFN - Patient Internal Entry Number
  1.  ;  BDT - Begining Date
  1.  ;  EDT - Ending Date
  1.  ;
  1.  ; Output - RESULT format below
  1.  ;          Signed up for PHR (0=No, 1=Yes)^date^accessed PHR (0=No, 1=Yes)^last date^used secure messaging (0=No, 1=Yes)^last date^direct address
  1.  ;
  1.  ; Get Patient ICN
  1.  NEW BPHREUID,BPARRAY,BPHRP,BPHRR,EXEC,STS,RETRY,MAX,CONNEC,TRY,FAIL,DA,PROD
  1.  S RESULT="0^^0^^0^^"
  1.  I $G(DT)="" D DT^DICRW
  1.  I $G(BDT)="" S BDT=DT
  1.  I $G(EDT)="" S EDT=DT
  1.  ;
  1.  S BPHREUID=$P($G(^DPT(DFN,"MPI")),U,1)
  1.  I BPHREUID="" Q
  1.  ;
  1.  I $P($G(^AUTTLOC(DUZ(2),21)),"^",5)="" S $P(RESULT,"^",10)="Location does not have DIRECT email address" Q
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BPHRMUPM D UNWIND^%ZTER"
  1.  ;
  1.  S PROD=$$PROD^XUPROD()
  1.  I 'PROD S DA=1
  1.  I PROD S DA=2
  1.  ; Get web service information
  1.  K BPARRAY
  1.  D GETS^DIQ(90670.2,DA_",","**","E","BPARRAY")
  1.  S BPHRP("URLROOT")=$G(BPARRAY(90670.2,DA_",",.02,"E"))
  1.  S BPHRP("SERVICEPATH")=$G(BPARRAY(90670.2,DA_",",.11,"E"))
  1.  S BPHRP("PORT")=$G(BPARRAY(90670.2,DA_",",.03,"E"))
  1.  S BPHRP("TIMEOUT")=$G(BPARRAY(90670.2,DA_",",.05,"E"))
  1.  S BPHRP("USER")=$G(BPARRAY(90670.2,DA_",",.07,"E"))
  1.  S BPHRP("PASS")=$G(BPARRAY(90670.2,DA_",",.08,"E"))
  1.  ; Pass Patient ICN and BDT and EDT to web service call
  1.  S BPHRP("EUID")=BPHREUID
  1.  ; Change BDT and EDT to appropriate dates from FileMan date
  1.  S BPHRP("FROM")=$$DATE(BDT)_"T00:00:00"_$$TMZ()
  1.  S BPHRP("TO")=$$DATE(EDT)_"T23:59:59"_$$TMZ()
  1.  I $G(PROV)="" S BPHRP("ADDR")=""
  1.  ;I $G(PROV)'="" S BPHRP("ADDR")=$S($$AGNT^BPHRUPD(DFN)="":"",1:$$AGNT^BPHRUPD(DFN)_",")_$$PROV^BPHRUPD($G(PROV))
  1.  I $G(PROV)'="" S BPHRP("ADDR")=$S($$AGNT^BPHRUPD(DFN)="":"",1:$$AGNT^BPHRUPD(DFN))_$$PROV^BPHRUPD($G(PROV))
  1.  S BPHRP("SSL")=$G(BPARRAY(90670.2,DA_",",2.01,"E"))
  1.  S RETRY=$G(BPARRAY(90670.2,DA_",",4.01,"E"))
  1.  S MAX=$G(BPARRAY(90670.2,DA_",",4.02,"E"))
  1.  S CONNEC=$G(BPARRAY(90670.2,DA_",",.12,"E"))
  1.  ;
  1.  ; Returns data
  1.  S QFL=0,TRY=0,FAIL=0,OK=0
  1.  F  D  Q:OK  Q:QFL
  1.  . S EXEC="S STS=##class(BPHR.WebServiceCalls).PMQueryRequest(.BPHRP,.BPHRR)" X EXEC
  1.  . I $P($G(STS),U,1)=1 S OK=1 Q
  1.  . I $P($G(STS),U,1)=0 D
  1.  .. S TRY=TRY+1 I TRY>RETRY S FAIL=FAIL+1,TRY=0
  1.  .. I FAIL>MAX S $P(RESULT,U,1)=-1,$P(RESULT,U,10)=$P($G(STS),U,2),QFL=1 Q
  1.  .. HANG CONNEC
  1.  ;
  1.  I QFL Q
  1.  ;
  1.  I $G(BPHRR("ACCESS"))="" S $P(RESULT,U,1)=0
  1.  I $G(BPHRR("ACCESS"))'="" D
  1.  . NEW VAL
  1.  . S VAL=$G(BPHRR("ACCESS"))
  1.  . S $P(RESULT,U,1)=1,$P(RESULT,U,2)=$$GMT(VAL)
  1.  I $G(BPHRR("LOGIN"))="" S $P(RESULT,U,3)=0
  1.  I $G(BPHRR("LOGIN"))'="" D
  1.  . NEW VAL
  1.  . S VAL=$G(BPHRR("LOGIN"))
  1.  . S $P(RESULT,U,3)=1,$P(RESULT,U,4)=$$GMT(VAL)
  1.  I $G(BPHRR("SMESSAGE"))="" S $P(RESULT,U,5)=0
  1.  I $G(BPHRR("SMESSAGE"))'="" D
  1.  . NEW VAL
  1.  . S VAL=$G(BPHRR("SMESSAGE"))
  1.  . S $P(RESULT,U,5)=1,$P(RESULT,U,6)=$$GMT(VAL)
  1.  I $G(BPHRR("SDIRECT"))="" S $P(RESULT,U,7)=""
  1.  I $G(BPHRR("SDIRECT"))'="" D
  1.  . NEW VAL
  1.  . S VAL=$G(BPHRR("SDIRECT")),$P(RESULT,U,7)=VAL
  1.  ;
  1.  Q
  1.  ;
  1. DATE(BPX) ;EP
  1.  NEW BPY,BPM,BPD
  1.  S BPY=$$FMTE^XLFDT(BPX,"7Z")
  1.  S BPY=$TR(BPY,"/","-")
  1.  Q BPY
  1.  ;
  1. FMDT(BPX) ;EP
  1.  NEW X,Y,TMZ,DATE,TIME
  1.  S BPX=$TR(BPX,"T","@")
  1.  S TMZ=$E(BPX,$L(BPX)-4,$L(BPX)),BPX=$E(BPX,1,$L(BPX)-5)
  1.  S TIME=$P(BPX,"@",2),DATE=$P(BPX,"@",1)
  1.  S X=$P(DATE,"-",2)_"/"_$P(DATE,"-",3)_"/"_$P(DATE,"-",1)_"  "_TIME_" "_TMZ
  1.  S Y=$$CONVERT^XMXUTIL1(X,1)
  1.  I Y=-1 S Y=""
  1.  Q Y
  1.  ;
  1. TMZ() ;EP - System Timezone
  1.  NEW TMZ,VAL
  1.  S VAL="S TMZ=$ZTZ\60"
  1.  X VAL
  1.  S TMZ=$$TIMEDIFF^XMXUTIL1(-TMZ)
  1.  Q TMZ
  1.  ;
  1. ERR ;EP - Error Trap
  1.  NEW ERRAY,EXEC
  1.  I $ZE["ZSOAP" D
  1.  . S EXEC="Set ERRAY=$System.Status.DecomposeStatus(%objlasterror,.ERRAY)" X EXEC
  1.  . S $P(RESULT,"^",1)=-1,$P(RESULT,"^",10)=$S($G(ERRAY(1))'="":$G(ERRAY(1)),1:$ZE)
  1.  D ^%ZTER
  1.  Q
  1.  ;
  1. GMT(DATE) ;EP - Convert GMT time to Local time
  1.  NEW TLG,LG,OFF,NDATE,%DT,HDATE,NHDATE,Y,X,OP,I
  1.  ; Find the Offset value
  1.  S TLG=$L(DATE) F I=TLG:-1:1 S OP=$E(DATE,I,I) I OP="-"!(OP="+") S LG=I Q
  1.  S OFF=$E(DATE,LG,TLG),OFF=+OFF,OFF=$$STRIP^XLFSTR(OFF,0),OFF=OFF*60
  1.  ; translate the date to a $H date
  1.  S NDATE=$E(DATE,1,LG),NDATE=$TR(NDATE,"T","@"),%DT="TS",X=NDATE
  1.  D ^%DT I Y=-1 Q ""
  1.  S HDATE=$$FMTH^XLFDT(Y)
  1.  ; adjust the $H date with the offset
  1.  S NHDATE=$$HADD^XLFDT(HDATE,,,OFF)
  1.  ; translate date to FileMan date
  1.  Q $$HTFM^XLFDT(NHDATE)