BPHRMUPM ;GDIT/HS/ALA-PHR MU Performance Measure ; 20 Aug 2013 9:54 AM
;;2.1;IHS PERSONAL HEALTH RECORD;**1**;Apr 01, 2014;Build 23
;
PHR(DFN,BDT,EDT,RESULT,PROV) ;PEP - API call for Performance Measure
; Input Parameters
; DFN - Patient Internal Entry Number
; BDT - Begining Date
; EDT - Ending Date
;
; Output - RESULT format below
; 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
;
; Get Patient ICN
NEW BPHREUID,BPARRAY,BPHRP,BPHRR,EXEC,STS,RETRY,MAX,CONNEC,TRY,FAIL,DA,PROD
S RESULT="0^^0^^0^^"
I $G(DT)="" D DT^DICRW
I $G(BDT)="" S BDT=DT
I $G(EDT)="" S EDT=DT
;
S BPHREUID=$P($G(^DPT(DFN,"MPI")),U,1)
I BPHREUID="" Q
;
I $P($G(^AUTTLOC(DUZ(2),21)),"^",5)="" S $P(RESULT,"^",10)="Location does not have DIRECT email address" Q
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BPHRMUPM D UNWIND^%ZTER"
;
S PROD=$$PROD^XUPROD()
I 'PROD S DA=1
I PROD S DA=2
; Get web service information
K BPARRAY
D GETS^DIQ(90670.2,DA_",","**","E","BPARRAY")
S BPHRP("URLROOT")=$G(BPARRAY(90670.2,DA_",",.02,"E"))
S BPHRP("SERVICEPATH")=$G(BPARRAY(90670.2,DA_",",.11,"E"))
S BPHRP("PORT")=$G(BPARRAY(90670.2,DA_",",.03,"E"))
S BPHRP("TIMEOUT")=$G(BPARRAY(90670.2,DA_",",.05,"E"))
S BPHRP("USER")=$G(BPARRAY(90670.2,DA_",",.07,"E"))
S BPHRP("PASS")=$G(BPARRAY(90670.2,DA_",",.08,"E"))
; Pass Patient ICN and BDT and EDT to web service call
S BPHRP("EUID")=BPHREUID
; Change BDT and EDT to appropriate dates from FileMan date
S BPHRP("FROM")=$$DATE(BDT)_"T00:00:00"_$$TMZ()
S BPHRP("TO")=$$DATE(EDT)_"T23:59:59"_$$TMZ()
I $G(PROV)="" S BPHRP("ADDR")=""
;I $G(PROV)'="" S BPHRP("ADDR")=$S($$AGNT^BPHRUPD(DFN)="":"",1:$$AGNT^BPHRUPD(DFN)_",")_$$PROV^BPHRUPD($G(PROV))
I $G(PROV)'="" S BPHRP("ADDR")=$S($$AGNT^BPHRUPD(DFN)="":"",1:$$AGNT^BPHRUPD(DFN))_$$PROV^BPHRUPD($G(PROV))
S BPHRP("SSL")=$G(BPARRAY(90670.2,DA_",",2.01,"E"))
S RETRY=$G(BPARRAY(90670.2,DA_",",4.01,"E"))
S MAX=$G(BPARRAY(90670.2,DA_",",4.02,"E"))
S CONNEC=$G(BPARRAY(90670.2,DA_",",.12,"E"))
;
; Returns data
S QFL=0,TRY=0,FAIL=0,OK=0
F D Q:OK Q:QFL
. S EXEC="S STS=##class(BPHR.WebServiceCalls).PMQueryRequest(.BPHRP,.BPHRR)" X EXEC
. I $P($G(STS),U,1)=1 S OK=1 Q
. I $P($G(STS),U,1)=0 D
.. S TRY=TRY+1 I TRY>RETRY S FAIL=FAIL+1,TRY=0
.. I FAIL>MAX S $P(RESULT,U,1)=-1,$P(RESULT,U,10)=$P($G(STS),U,2),QFL=1 Q
.. HANG CONNEC
;
I QFL Q
;
I $G(BPHRR("ACCESS"))="" S $P(RESULT,U,1)=0
I $G(BPHRR("ACCESS"))'="" D
. NEW VAL
. S VAL=$G(BPHRR("ACCESS"))
. S $P(RESULT,U,1)=1,$P(RESULT,U,2)=$$GMT(VAL)
I $G(BPHRR("LOGIN"))="" S $P(RESULT,U,3)=0
I $G(BPHRR("LOGIN"))'="" D
. NEW VAL
. S VAL=$G(BPHRR("LOGIN"))
. S $P(RESULT,U,3)=1,$P(RESULT,U,4)=$$GMT(VAL)
I $G(BPHRR("SMESSAGE"))="" S $P(RESULT,U,5)=0
I $G(BPHRR("SMESSAGE"))'="" D
. NEW VAL
. S VAL=$G(BPHRR("SMESSAGE"))
. S $P(RESULT,U,5)=1,$P(RESULT,U,6)=$$GMT(VAL)
I $G(BPHRR("SDIRECT"))="" S $P(RESULT,U,7)=""
I $G(BPHRR("SDIRECT"))'="" D
. NEW VAL
. S VAL=$G(BPHRR("SDIRECT")),$P(RESULT,U,7)=VAL
;
Q
;
DATE(BPX) ;EP
NEW BPY,BPM,BPD
S BPY=$$FMTE^XLFDT(BPX,"7Z")
S BPY=$TR(BPY,"/","-")
Q BPY
;
FMDT(BPX) ;EP
NEW X,Y,TMZ,DATE,TIME
S BPX=$TR(BPX,"T","@")
S TMZ=$E(BPX,$L(BPX)-4,$L(BPX)),BPX=$E(BPX,1,$L(BPX)-5)
S TIME=$P(BPX,"@",2),DATE=$P(BPX,"@",1)
S X=$P(DATE,"-",2)_"/"_$P(DATE,"-",3)_"/"_$P(DATE,"-",1)_" "_TIME_" "_TMZ
S Y=$$CONVERT^XMXUTIL1(X,1)
I Y=-1 S Y=""
Q Y
;
TMZ() ;EP - System Timezone
NEW TMZ,VAL
S VAL="S TMZ=$ZTZ\60"
X VAL
S TMZ=$$TIMEDIFF^XMXUTIL1(-TMZ)
Q TMZ
;
ERR ;EP - Error Trap
NEW ERRAY,EXEC
I $ZE["ZSOAP" D
. S EXEC="Set ERRAY=$System.Status.DecomposeStatus(%objlasterror,.ERRAY)" X EXEC
. S $P(RESULT,"^",1)=-1,$P(RESULT,"^",10)=$S($G(ERRAY(1))'="":$G(ERRAY(1)),1:$ZE)
D ^%ZTER
Q
;
GMT(DATE) ;EP - Convert GMT time to Local time
NEW TLG,LG,OFF,NDATE,%DT,HDATE,NHDATE,Y,X,OP,I
; Find the Offset value
S TLG=$L(DATE) F I=TLG:-1:1 S OP=$E(DATE,I,I) I OP="-"!(OP="+") S LG=I Q
S OFF=$E(DATE,LG,TLG),OFF=+OFF,OFF=$$STRIP^XLFSTR(OFF,0),OFF=OFF*60
; translate the date to a $H date
S NDATE=$E(DATE,1,LG),NDATE=$TR(NDATE,"T","@"),%DT="TS",X=NDATE
D ^%DT I Y=-1 Q ""
S HDATE=$$FMTH^XLFDT(Y)
; adjust the $H date with the offset
S NHDATE=$$HADD^XLFDT(HDATE,,,OFF)
; translate date to FileMan date
Q $$HTFM^XLFDT(NHDATE)
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
+2 ;
PHR(DFN,BDT,EDT,RESULT,PROV) ;PEP - API call for Performance Measure
+1 ; Input Parameters
+2 ; DFN - Patient Internal Entry Number
+3 ; BDT - Begining Date
+4 ; EDT - Ending Date
+5 ;
+6 ; Output - RESULT format below
+7 ; 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
+8 ;
+9 ; Get Patient ICN
+10 NEW BPHREUID,BPARRAY,BPHRP,BPHRR,EXEC,STS,RETRY,MAX,CONNEC,TRY,FAIL,DA,PROD
+11 SET RESULT="0^^0^^0^^"
+12 IF $GET(DT)=""
DO DT^DICRW
+13 IF $GET(BDT)=""
SET BDT=DT
+14 IF $GET(EDT)=""
SET EDT=DT
+15 ;
+16 SET BPHREUID=$PIECE($GET(^DPT(DFN,"MPI")),U,1)
+17 IF BPHREUID=""
QUIT
+18 ;
+19 IF $PIECE($GET(^AUTTLOC(DUZ(2),21)),"^",5)=""
SET $PIECE(RESULT,"^",10)="Location does not have DIRECT email address"
QUIT
+20 ;
+21 NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BPHRMUPM D UNWIND^%ZTER"
+22 ;
+23 SET PROD=$$PROD^XUPROD()
+24 IF 'PROD
SET DA=1
+25 IF PROD
SET DA=2
+26 ; Get web service information
+27 KILL BPARRAY
+28 DO GETS^DIQ(90670.2,DA_",","**","E","BPARRAY")
+29 SET BPHRP("URLROOT")=$GET(BPARRAY(90670.2,DA_",",.02,"E"))
+30 SET BPHRP("SERVICEPATH")=$GET(BPARRAY(90670.2,DA_",",.11,"E"))
+31 SET BPHRP("PORT")=$GET(BPARRAY(90670.2,DA_",",.03,"E"))
+32 SET BPHRP("TIMEOUT")=$GET(BPARRAY(90670.2,DA_",",.05,"E"))
+33 SET BPHRP("USER")=$GET(BPARRAY(90670.2,DA_",",.07,"E"))
+34 SET BPHRP("PASS")=$GET(BPARRAY(90670.2,DA_",",.08,"E"))
+35 ; Pass Patient ICN and BDT and EDT to web service call
+36 SET BPHRP("EUID")=BPHREUID
+37 ; Change BDT and EDT to appropriate dates from FileMan date
+38 SET BPHRP("FROM")=$$DATE(BDT)_"T00:00:00"_$$TMZ()
+39 SET BPHRP("TO")=$$DATE(EDT)_"T23:59:59"_$$TMZ()
+40 IF $GET(PROV)=""
SET BPHRP("ADDR")=""
+41 ;I $G(PROV)'="" S BPHRP("ADDR")=$S($$AGNT^BPHRUPD(DFN)="":"",1:$$AGNT^BPHRUPD(DFN)_",")_$$PROV^BPHRUPD($G(PROV))
+42 IF $GET(PROV)'=""
SET BPHRP("ADDR")=$SELECT($$AGNT^BPHRUPD(DFN)="":"",1:$$AGNT^BPHRUPD(DFN))_$$PROV^BPHRUPD($GET(PROV))
+43 SET BPHRP("SSL")=$GET(BPARRAY(90670.2,DA_",",2.01,"E"))
+44 SET RETRY=$GET(BPARRAY(90670.2,DA_",",4.01,"E"))
+45 SET MAX=$GET(BPARRAY(90670.2,DA_",",4.02,"E"))
+46 SET CONNEC=$GET(BPARRAY(90670.2,DA_",",.12,"E"))
+47 ;
+48 ; Returns data
+49 SET QFL=0
SET TRY=0
SET FAIL=0
SET OK=0
+50 FOR
Begin DoDot:1
+51 SET EXEC="S STS=##class(BPHR.WebServiceCalls).PMQueryRequest(.BPHRP,.BPHRR)"
XECUTE EXEC
+52 IF $PIECE($GET(STS),U,1)=1
SET OK=1
QUIT
+53 IF $PIECE($GET(STS),U,1)=0
Begin DoDot:2
+54 SET TRY=TRY+1
IF TRY>RETRY
SET FAIL=FAIL+1
SET TRY=0
+55 IF FAIL>MAX
SET $PIECE(RESULT,U,1)=-1
SET $PIECE(RESULT,U,10)=$PIECE($GET(STS),U,2)
SET QFL=1
QUIT
+56 HANG CONNEC
End DoDot:2
End DoDot:1
IF OK
QUIT
IF QFL
QUIT
+57 ;
+58 IF QFL
QUIT
+59 ;
+60 IF $GET(BPHRR("ACCESS"))=""
SET $PIECE(RESULT,U,1)=0
+61 IF $GET(BPHRR("ACCESS"))'=""
Begin DoDot:1
+62 NEW VAL
+63 SET VAL=$GET(BPHRR("ACCESS"))
+64 SET $PIECE(RESULT,U,1)=1
SET $PIECE(RESULT,U,2)=$$GMT(VAL)
End DoDot:1
+65 IF $GET(BPHRR("LOGIN"))=""
SET $PIECE(RESULT,U,3)=0
+66 IF $GET(BPHRR("LOGIN"))'=""
Begin DoDot:1
+67 NEW VAL
+68 SET VAL=$GET(BPHRR("LOGIN"))
+69 SET $PIECE(RESULT,U,3)=1
SET $PIECE(RESULT,U,4)=$$GMT(VAL)
End DoDot:1
+70 IF $GET(BPHRR("SMESSAGE"))=""
SET $PIECE(RESULT,U,5)=0
+71 IF $GET(BPHRR("SMESSAGE"))'=""
Begin DoDot:1
+72 NEW VAL
+73 SET VAL=$GET(BPHRR("SMESSAGE"))
+74 SET $PIECE(RESULT,U,5)=1
SET $PIECE(RESULT,U,6)=$$GMT(VAL)
End DoDot:1
+75 IF $GET(BPHRR("SDIRECT"))=""
SET $PIECE(RESULT,U,7)=""
+76 IF $GET(BPHRR("SDIRECT"))'=""
Begin DoDot:1
+77 NEW VAL
+78 SET VAL=$GET(BPHRR("SDIRECT"))
SET $PIECE(RESULT,U,7)=VAL
End DoDot:1
+79 ;
+80 QUIT
+81 ;
DATE(BPX) ;EP
+1 NEW BPY,BPM,BPD
+2 SET BPY=$$FMTE^XLFDT(BPX,"7Z")
+3 SET BPY=$TRANSLATE(BPY,"/","-")
+4 QUIT BPY
+5 ;
FMDT(BPX) ;EP
+1 NEW X,Y,TMZ,DATE,TIME
+2 SET BPX=$TRANSLATE(BPX,"T","@")
+3 SET TMZ=$EXTRACT(BPX,$LENGTH(BPX)-4,$LENGTH(BPX))
SET BPX=$EXTRACT(BPX,1,$LENGTH(BPX)-5)
+4 SET TIME=$PIECE(BPX,"@",2)
SET DATE=$PIECE(BPX,"@",1)
+5 SET X=$PIECE(DATE,"-",2)_"/"_$PIECE(DATE,"-",3)_"/"_$PIECE(DATE,"-",1)_" "_TIME_" "_TMZ
+6 SET Y=$$CONVERT^XMXUTIL1(X,1)
+7 IF Y=-1
SET Y=""
+8 QUIT Y
+9 ;
TMZ() ;EP - System Timezone
+1 NEW TMZ,VAL
+2 SET VAL="S TMZ=$ZTZ\60"
+3 XECUTE VAL
+4 SET TMZ=$$TIMEDIFF^XMXUTIL1(-TMZ)
+5 QUIT TMZ
+6 ;
ERR ;EP - Error Trap
+1 NEW ERRAY,EXEC
+2 IF $ZE["ZSOAP"
Begin DoDot:1
+3 SET EXEC="Set ERRAY=$System.Status.DecomposeStatus(%objlasterror,.ERRAY)"
XECUTE EXEC
+4 SET $PIECE(RESULT,"^",1)=-1
SET $PIECE(RESULT,"^",10)=$SELECT($GET(ERRAY(1))'="":$GET(ERRAY(1)),1:$ZE)
End DoDot:1
+5 DO ^%ZTER
+6 QUIT
+7 ;
GMT(DATE) ;EP - Convert GMT time to Local time
+1 NEW TLG,LG,OFF,NDATE,%DT,HDATE,NHDATE,Y,X,OP,I
+2 ; Find the Offset value
+3 SET TLG=$LENGTH(DATE)
FOR I=TLG:-1:1
SET OP=$EXTRACT(DATE,I,I)
IF OP="-"!(OP="+")
SET LG=I
QUIT
+4 SET OFF=$EXTRACT(DATE,LG,TLG)
SET OFF=+OFF
SET OFF=$$STRIP^XLFSTR(OFF,0)
SET OFF=OFF*60
+5 ; translate the date to a $H date
+6 SET NDATE=$EXTRACT(DATE,1,LG)
SET NDATE=$TRANSLATE(NDATE,"T","@")
SET %DT="TS"
SET X=NDATE
+7 DO ^%DT
IF Y=-1
QUIT ""
+8 SET HDATE=$$FMTH^XLFDT(Y)
+9 ; adjust the $H date with the offset
+10 SET NHDATE=$$HADD^XLFDT(HDATE,,,OFF)
+11 ; translate date to FileMan date
+12 QUIT $$HTFM^XLFDT(NHDATE)
