- EDPDD ;SLC/KCM - Test Update ED Log - Update ;2/28/12 08:33am
- ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
- ;
- ISGONE(STS) ;
- Q STS=$O(^EDPB(233.1,"B","edp.status.gone",0))
- ;
- LFS ; Local form set logic from code field
- N LST,X0,NM,ABB
- S LST=$P(^EDPB(233.2,DA(1),0),U)
- S X0=$G(^EDPB(233.2,DA(1),1,DA,0))
- S NM=$P(X0,U,4),ABB=$P(X0,U,5)
- Q:LST="" Q:X0=""
- S ^EDPB(233.2,"AS",LST,X,DA)=ABB_U_NM
- Q
- LFK ; Local form kill logic from code field
- N LST,CODE
- S LST=$P(^EDPB(233.2,DA(1),0),U)
- S CODE=$P(^EDPB(233.2,DA(1),1,DA,0),U,2)
- Q:LST="" Q:CODE=""
- K ^EDPB(233.2,"AS",LST,X,DA)
- Q
- LFS1 ; Local form set logic from name, abbreviation
- N X0,LST,CODE,NM,ABB
- S LST=$P(^EDPB(233.2,DA(1),0),U)
- S X0=$G(^EDPB(233.2,DA(1),1,DA,0))
- S CODE=$P(X0,U,2),NM=$P(X0,U,4),ABB=$P(X0,U,5)
- Q:LST="" Q:CODE=""
- S ^EDPB(233.2,"AS",LST,CODE,DA)=ABB_U_NM
- Q
- LFK1 ; Local form kill logic name, abbreviation
- N LST,CODE
- S LST=$P(^EDPB(233.2,DA(1),0),U)
- S CODE=$P($G(^EDPB(233.2,DA(1),1,DA,0)),U,2)
- Q:LST="" Q:CODE=""
- K ^EDPB(233.2,"AS",LST,CODE,DA)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPDD 1081 printed Mar 13, 2025@20:56:27 Page 2
- EDPDD ;SLC/KCM - Test Update ED Log - Update ;2/28/12 08:33am
- +1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
- +2 ;
- ISGONE(STS) ;
- +1 QUIT STS=$ORDER(^EDPB(233.1,"B","edp.status.gone",0))
- +2 ;
- LFS ; Local form set logic from code field
- +1 NEW LST,X0,NM,ABB
- +2 SET LST=$PIECE(^EDPB(233.2,DA(1),0),U)
- +3 SET X0=$GET(^EDPB(233.2,DA(1),1,DA,0))
- +4 SET NM=$PIECE(X0,U,4)
- SET ABB=$PIECE(X0,U,5)
- +5 if LST=""
- QUIT
- if X0=""
- QUIT
- +6 SET ^EDPB(233.2,"AS",LST,X,DA)=ABB_U_NM
- +7 QUIT
- LFK ; Local form kill logic from code field
- +1 NEW LST,CODE
- +2 SET LST=$PIECE(^EDPB(233.2,DA(1),0),U)
- +3 SET CODE=$PIECE(^EDPB(233.2,DA(1),1,DA,0),U,2)
- +4 if LST=""
- QUIT
- if CODE=""
- QUIT
- +5 KILL ^EDPB(233.2,"AS",LST,X,DA)
- +6 QUIT
- LFS1 ; Local form set logic from name, abbreviation
- +1 NEW X0,LST,CODE,NM,ABB
- +2 SET LST=$PIECE(^EDPB(233.2,DA(1),0),U)
- +3 SET X0=$GET(^EDPB(233.2,DA(1),1,DA,0))
- +4 SET CODE=$PIECE(X0,U,2)
- SET NM=$PIECE(X0,U,4)
- SET ABB=$PIECE(X0,U,5)
- +5 if LST=""
- QUIT
- if CODE=""
- QUIT
- +6 SET ^EDPB(233.2,"AS",LST,CODE,DA)=ABB_U_NM
- +7 QUIT
- LFK1 ; Local form kill logic name, abbreviation
- +1 NEW LST,CODE
- +2 SET LST=$PIECE(^EDPB(233.2,DA(1),0),U)
- +3 SET CODE=$PIECE($GET(^EDPB(233.2,DA(1),1,DA,0)),U,2)
- +4 if LST=""
- QUIT
- if CODE=""
- QUIT
- +5 KILL ^EDPB(233.2,"AS",LST,CODE,DA)
- +6 QUIT