EDPUPD ;SLC/MKB - Update local data ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
PHONE(DFN,HOME,CELL,NOK) ; -- update phone numbers [savePhoneNumbers]
S DFN=+$G(DFN) I DFN<1 D RET("Missing or invalid patient id") Q
N EDPX,EDPDR,X,OK
S EDPDR="",HOME=$G(HOME),CELL=$G(CELL)
S:$L(HOME) EDPX(.131)=$S(HOME="@":"@",1:$$FORMAT(HOME)),EDPDR=".131"
S:$L(CELL) EDPX(.134)=$S(CELL="@":"@",1:$$FORMAT(CELL)),EDPDR=EDPDR_$S($L(EDPDR):";",1:"")_".134"
S:$L(NOK) EDPX(.219)=$S(NOK="@":"@",1:$$FORMAT(NOK)),EDPDR=EDPDR_$S($L(EDPDR):";",1:"")_".219"
I '$O(EDPX(0)) D RET("Missing phone numbers") Q
D EDIT^VAFCPTED(DFN,"EDPX",EDPDR)
S X=$G(^DPT(DFN,.13)),OK=1 D ;check global
. I $L(HOME),$S(HOME="@":$L($P(X,U)),1:(HOME'=$P(X,U))) S OK=0
. I $L(CELL),$S(CELL="@":$L($P(X,U,4)),1:(CELL'=$P(X,U,4))) S OK=0
. I $L(NOK) S X=$G(^DPT(DFN,.21)) I $S(NOK="@":$L($P(X,U,9)),1:(NOK'=$P(X,U,9))) S OK=0
S X=$S(OK:"",1:"update failed") D RET(X)
Q
;
FORMAT(X) ; -- enforce (xxx)xxx-xxxx phone format
S X=$G(X) I X?1"("3N1")"3N1"-"4N.E Q X
N P,N,I,Y S P=""
F I=1:1:$L(X) S N=$E(X,I) I N=+N S P=P_N
S:$L(P)<10 P=$E("0000000000",1,10-$L(P))_P
S Y=$S(P:"("_$E(P,1,3)_")"_$E(P,4,6)_"-"_$E(P,7,10),1:"")
Q Y
;
RET(MSG) ; -- return [error] message
N X S X="<upd status='"_$S($L($G(MSG)):"error' msg='"_MSG,1:"ok")_"' />"
D XML^EDPX(X)
Q
;
ACK(LIST) ; -- acknowledge orders in LIST("order",n)
N EDPI,EDPN,EDPY,X
S EDPI=0 F S EDPI=$O(LIST("order",EDPI)) Q:EDPI<1 S X=LIST("order",EDPI),EDPN(EDPI)="ORR:"_+X_"^1"
D ACK^ORRCACK(.EDPY,DUZ,.EDPN)
D RET("")
Q
;
EVENT(EVT) ; -- saveClinicalEvent
N ID,EDPX,EDPY,EDPERR,DIERR
S ID=$G(EVT("id",1)),ID=$S(ID:ID_",",1:"+1,")
S:$G(EVT("eventTS",1)) EDPX(234,ID,.01)=EVT("eventTS",1)
S:$G(EVT("patient",1)) EDPX(234,ID,2)=EVT("patient",1)
S:$G(EVT("userID",1)) EDPX(234,ID,3)=EVT("userID",1)
S:$G(EVT("ordItem",1)) EDPX(234,ID,4)=EVT("ordItem",1)
S:$G(EVT("labTest",1)) EDPX(234,ID,5)=EVT("labTest",1)
S:$G(EVT("vitalSign",1)) EDPX(234,ID,6)=EVT("vitalSign",1)
S:$G(EVT("title",1)) EDPX(234,ID,1)=EVT("title",1)
S:$G(EVT("text",1)) EDPX(234,ID,10)=EVT("text",1)
I ID D FILE^DIE("","EDPX",EDPERR)
I ID="+1" D UPDATE^DIE("","EDPX","EDPY",EDPERR)
; return ?? EDPY(1) = new ien
; $G(DIERR): EDPERR("DIERR",1,"TEXT",1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPUPD 2349 printed Dec 13, 2024@01:52:30 Page 2
EDPUPD ;SLC/MKB - Update local data ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
PHONE(DFN,HOME,CELL,NOK) ; -- update phone numbers [savePhoneNumbers]
+1 SET DFN=+$GET(DFN)
IF DFN<1
DO RET("Missing or invalid patient id")
QUIT
+2 NEW EDPX,EDPDR,X,OK
+3 SET EDPDR=""
SET HOME=$GET(HOME)
SET CELL=$GET(CELL)
+4 if $LENGTH(HOME)
SET EDPX(.131)=$SELECT(HOME="@":"@",1:$$FORMAT(HOME))
SET EDPDR=".131"
+5 if $LENGTH(CELL)
SET EDPX(.134)=$SELECT(CELL="@":"@",1:$$FORMAT(CELL))
SET EDPDR=EDPDR_$SELECT($LENGTH(EDPDR):";",1:"")_".134"
+6 if $LENGTH(NOK)
SET EDPX(.219)=$SELECT(NOK="@":"@",1:$$FORMAT(NOK))
SET EDPDR=EDPDR_$SELECT($LENGTH(EDPDR):";",1:"")_".219"
+7 IF '$ORDER(EDPX(0))
DO RET("Missing phone numbers")
QUIT
+8 DO EDIT^VAFCPTED(DFN,"EDPX",EDPDR)
+9 ;check global
SET X=$GET(^DPT(DFN,.13))
SET OK=1
Begin DoDot:1
+10 IF $LENGTH(HOME)
IF $SELECT(HOME="@":$LENGTH($PIECE(X,U)),1:(HOME'=$PIECE(X,U)))
SET OK=0
+11 IF $LENGTH(CELL)
IF $SELECT(CELL="@":$LENGTH($PIECE(X,U,4)),1:(CELL'=$PIECE(X,U,4)))
SET OK=0
+12 IF $LENGTH(NOK)
SET X=$GET(^DPT(DFN,.21))
IF $SELECT(NOK="@":$LENGTH($PIECE(X,U,9)),1:(NOK'=$PIECE(X,U,9)))
SET OK=0
End DoDot:1
+13 SET X=$SELECT(OK:"",1:"update failed")
DO RET(X)
+14 QUIT
+15 ;
FORMAT(X) ; -- enforce (xxx)xxx-xxxx phone format
+1 SET X=$GET(X)
IF X?1"("3N1")"3N1"-"4N.E
QUIT X
+2 NEW P,N,I,Y
SET P=""
+3 FOR I=1:1:$LENGTH(X)
SET N=$EXTRACT(X,I)
IF N=+N
SET P=P_N
+4 if $LENGTH(P)<10
SET P=$EXTRACT("0000000000",1,10-$LENGTH(P))_P
+5 SET Y=$SELECT(P:"("_$EXTRACT(P,1,3)_")"_$EXTRACT(P,4,6)_"-"_$EXTRACT(P,7,10),1:"")
+6 QUIT Y
+7 ;
RET(MSG) ; -- return [error] message
+1 NEW X
SET X="<upd status='"_$SELECT($LENGTH($GET(MSG)):"error' msg='"_MSG,1:"ok")_"' />"
+2 DO XML^EDPX(X)
+3 QUIT
+4 ;
ACK(LIST) ; -- acknowledge orders in LIST("order",n)
+1 NEW EDPI,EDPN,EDPY,X
+2 SET EDPI=0
FOR
SET EDPI=$ORDER(LIST("order",EDPI))
if EDPI<1
QUIT
SET X=LIST("order",EDPI)
SET EDPN(EDPI)="ORR:"_+X_"^1"
+3 DO ACK^ORRCACK(.EDPY,DUZ,.EDPN)
+4 DO RET("")
+5 QUIT
+6 ;
EVENT(EVT) ; -- saveClinicalEvent
+1 NEW ID,EDPX,EDPY,EDPERR,DIERR
+2 SET ID=$GET(EVT("id",1))
SET ID=$SELECT(ID:ID_",",1:"+1,")
+3 if $GET(EVT("eventTS",1))
SET EDPX(234,ID,.01)=EVT("eventTS",1)
+4 if $GET(EVT("patient",1))
SET EDPX(234,ID,2)=EVT("patient",1)
+5 if $GET(EVT("userID",1))
SET EDPX(234,ID,3)=EVT("userID",1)
+6 if $GET(EVT("ordItem",1))
SET EDPX(234,ID,4)=EVT("ordItem",1)
+7 if $GET(EVT("labTest",1))
SET EDPX(234,ID,5)=EVT("labTest",1)
+8 if $GET(EVT("vitalSign",1))
SET EDPX(234,ID,6)=EVT("vitalSign",1)
+9 if $GET(EVT("title",1))
SET EDPX(234,ID,1)=EVT("title",1)
+10 if $GET(EVT("text",1))
SET EDPX(234,ID,10)=EVT("text",1)
+11 IF ID
DO FILE^DIE("","EDPX",EDPERR)
+12 IF ID="+1"
DO UPDATE^DIE("","EDPX","EDPY",EDPERR)
+13 ; return ?? EDPY(1) = new ien
+14 ; $G(DIERR): EDPERR("DIERR",1,"TEXT",1)
+15 QUIT
