- 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 Feb 18, 2025@23:18:55 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