- GMRVFSYN ;HIRMFO/RM,YH-X REFERENCE FOR VITAL TYPE, CATEGORY AND SYNONYM ;5/22/97
- ;;4.0;Vitals/Measurements;**1**;Apr 25, 1997
- ;
- BSYNO(GMRVSK,DA,X) ; CALLED FROM SET/KILL LOGIC OF ACHR XREF ON
- ; SYNONYM (.02) FIELD OF GMRV VITAL QUALIFIER (120.52) FILE.
- ; THIS PROCEDURE SETS/KILLS THE FOLLOWING MUMPS INDICES: "BB".
- ; Input variables: GMRVSK=1 if called from SET, 2 if from KILL
- ; DA=DA array passed by reference.
- ; X=value being indexed.
- ;
- S GMRVDA=DA N DA,GMRVY
- S DA(1)=GMRVDA,DA=0
- F S DA=$O(^GMRD(120.52,DA(1),1,DA)) Q:DA'>0 D
- . S GMRVY=$G(^GMRD(120.52,DA(1),1,DA,0))
- . D BB($P(GMRVY,"^"),$P(GMRVY,"^",2),X,.DA,GMRVSK)
- . Q
- K GMRVDA
- Q
- BTYP(GMRVSK,DA,X) ; CALLED FROM SET/KILL LOGIC OF BTYP XREF ON VITAL
- ; TYPE (.01) FIELD OF VITAL TYPE (120.521) SUB-FILE OF GMRV
- ; GMRV VITAL QUALIFIER (120.52) FILE. THIS PROCEDURE SETS/KILLS THE
- ; FOLLOWING MUMPS INDEX: "BB".
- ; Input variables: GMRVSK=1 if called from SET, 2 if from KILL
- ; DA=DA array passed by reference.
- ; X=value being indexed.
- ;
- N GMRVX,GMRVY
- S GMRVX=$P($G(^GMRD(120.52,DA(1),0)),"^"),GMRVY=$G(^GMRD(120.52,DA(1),1,DA,0))
- D BB(X,$P(GMRVY,"^",2),$P(GMRVX,"^",2),.DA,GMRVSK)
- Q
- BCAT(GMRVSK,DA,X) ; CALLED FROM SET/KILL LOGIC OF BCAT XREF ON CATEGORY
- ; (.02) FIELD OF VITAL TYPE (120.521) SUBFILE OF GMRV VITAL QUALIFIER
- ; (120.52) FILE. THIS PROCEDURE SETS/KILLS THE FOLLOWING MUMPS
- ; INDEX: "BB".
- ; Input variables: GMRVSK=1 if called from SET, 2 if from KILL
- ; DA=DA array passed by reference.
- ; X=value being indexed.
- ;
- N GMRVX,GMRVY
- S GMRVX=$G(^GMRD(120.52,DA(1),0)),GMRVY=$G(^GMRD(120.52,DA(1),1,DA,0))
- D BB($P(GMRVY,"^"),X,$P(GMRVX,"^",2),.DA,GMRVSK)
- Q
- BB(TYPE,CAT,CHAR,DA,SK) ; This procedure updates the "BB" index for the 120.52
- ; file. This index has the following format:
- ; ^GMRD(120.52,"BB",TYPE,CAT,CHAR,DA(1),DA)=""
- ; Input variables:
- ; TYPE=Vital Type (.01) field 120.521 sub-file.
- ; CAT=Category (.02) field of 120.521 sub-file.
- ; CHAR=Name (.01) field of 120.52 file.
- ; DA=Passed by reference will have entry in 120.52 sub-file, DA,
- ; and entry in 120.52 file, DA(1).
- ; SK=1 if set xref, 2 if kill xref.
- ;
- Q:$G(TYPE)=""!($G(CAT)="")!($G(CHAR)="")!($G(DA(1))="")!($G(DA)="")
- I $G(SK)=1 S ^GMRD(120.52,"BB",TYPE,CAT,CHAR,DA(1),DA)=""
- I $G(SK)=2 K ^GMRD(120.52,"BB",TYPE,CAT,CHAR,DA(1),DA)
- Q
- SCREEN ;SCREEN FOR DUPLICATE ENTRY FOR A VITAL TYPE
- Q:X="" S GMRVDA=DA N DA,GTYP,GCAT,GSYN
- S DA(1)=GMRVDA,DA=0
- F S DA=$O(^GMRD(120.52,DA(1),1,DA)) Q:DA'>0!'$D(X) D
- . S GMRVY=$G(^GMRD(120.52,DA(1),1,DA,0))
- . S GTYP=+$P(GMRVY,"^")
- . I $D(^GMRD(120.52,"BB",GTYP)) D
- . . S GCAT=0 F S GCAT=$O(^GMRD(120.52,"BB",GTYP,GCAT)) Q:GCAT'>0!'$D(X) S GSYN="" F S GSYN=$O(^GMRD(120.52,"BB",GTYP,GCAT,GSYN)) Q:GSYN=""!'$D(X) I GSYN=X W:'$D(ZTQUEUED) !!,X," has been entered for "_$P(^GMRD(120.51,GTYP,0),"^"),!! K X
- K GMRVDA Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVFSYN 3107 printed Feb 18, 2025@23:22:48 Page 2
- GMRVFSYN ;HIRMFO/RM,YH-X REFERENCE FOR VITAL TYPE, CATEGORY AND SYNONYM ;5/22/97
- +1 ;;4.0;Vitals/Measurements;**1**;Apr 25, 1997
- +2 ;
- BSYNO(GMRVSK,DA,X) ; CALLED FROM SET/KILL LOGIC OF ACHR XREF ON
- +1 ; SYNONYM (.02) FIELD OF GMRV VITAL QUALIFIER (120.52) FILE.
- +2 ; THIS PROCEDURE SETS/KILLS THE FOLLOWING MUMPS INDICES: "BB".
- +3 ; Input variables: GMRVSK=1 if called from SET, 2 if from KILL
- +4 ; DA=DA array passed by reference.
- +5 ; X=value being indexed.
- +6 ;
- +7 SET GMRVDA=DA
- NEW DA,GMRVY
- +8 SET DA(1)=GMRVDA
- SET DA=0
- +9 FOR
- SET DA=$ORDER(^GMRD(120.52,DA(1),1,DA))
- if DA'>0
- QUIT
- Begin DoDot:1
- +10 SET GMRVY=$GET(^GMRD(120.52,DA(1),1,DA,0))
- +11 DO BB($PIECE(GMRVY,"^"),$PIECE(GMRVY,"^",2),X,.DA,GMRVSK)
- +12 QUIT
- End DoDot:1
- +13 KILL GMRVDA
- +14 QUIT
- BTYP(GMRVSK,DA,X) ; CALLED FROM SET/KILL LOGIC OF BTYP XREF ON VITAL
- +1 ; TYPE (.01) FIELD OF VITAL TYPE (120.521) SUB-FILE OF GMRV
- +2 ; GMRV VITAL QUALIFIER (120.52) FILE. THIS PROCEDURE SETS/KILLS THE
- +3 ; FOLLOWING MUMPS INDEX: "BB".
- +4 ; Input variables: GMRVSK=1 if called from SET, 2 if from KILL
- +5 ; DA=DA array passed by reference.
- +6 ; X=value being indexed.
- +7 ;
- +8 NEW GMRVX,GMRVY
- +9 SET GMRVX=$PIECE($GET(^GMRD(120.52,DA(1),0)),"^")
- SET GMRVY=$GET(^GMRD(120.52,DA(1),1,DA,0))
- +10 DO BB(X,$PIECE(GMRVY,"^",2),$PIECE(GMRVX,"^",2),.DA,GMRVSK)
- +11 QUIT
- BCAT(GMRVSK,DA,X) ; CALLED FROM SET/KILL LOGIC OF BCAT XREF ON CATEGORY
- +1 ; (.02) FIELD OF VITAL TYPE (120.521) SUBFILE OF GMRV VITAL QUALIFIER
- +2 ; (120.52) FILE. THIS PROCEDURE SETS/KILLS THE FOLLOWING MUMPS
- +3 ; INDEX: "BB".
- +4 ; Input variables: GMRVSK=1 if called from SET, 2 if from KILL
- +5 ; DA=DA array passed by reference.
- +6 ; X=value being indexed.
- +7 ;
- +8 NEW GMRVX,GMRVY
- +9 SET GMRVX=$GET(^GMRD(120.52,DA(1),0))
- SET GMRVY=$GET(^GMRD(120.52,DA(1),1,DA,0))
- +10 DO BB($PIECE(GMRVY,"^"),X,$PIECE(GMRVX,"^",2),.DA,GMRVSK)
- +11 QUIT
- BB(TYPE,CAT,CHAR,DA,SK) ; This procedure updates the "BB" index for the 120.52
- +1 ; file. This index has the following format:
- +2 ; ^GMRD(120.52,"BB",TYPE,CAT,CHAR,DA(1),DA)=""
- +3 ; Input variables:
- +4 ; TYPE=Vital Type (.01) field 120.521 sub-file.
- +5 ; CAT=Category (.02) field of 120.521 sub-file.
- +6 ; CHAR=Name (.01) field of 120.52 file.
- +7 ; DA=Passed by reference will have entry in 120.52 sub-file, DA,
- +8 ; and entry in 120.52 file, DA(1).
- +9 ; SK=1 if set xref, 2 if kill xref.
- +10 ;
- +11 if $GET(TYPE)=""!($GET(CAT)="")!($GET(CHAR)="")!($GET(DA(1))="")!($GET(DA)="")
- QUIT
- +12 IF $GET(SK)=1
- SET ^GMRD(120.52,"BB",TYPE,CAT,CHAR,DA(1),DA)=""
- +13 IF $GET(SK)=2
- KILL ^GMRD(120.52,"BB",TYPE,CAT,CHAR,DA(1),DA)
- +14 QUIT
- SCREEN ;SCREEN FOR DUPLICATE ENTRY FOR A VITAL TYPE
- +1 if X=""
- QUIT
- SET GMRVDA=DA
- NEW DA,GTYP,GCAT,GSYN
- +2 SET DA(1)=GMRVDA
- SET DA=0
- +3 FOR
- SET DA=$ORDER(^GMRD(120.52,DA(1),1,DA))
- if DA'>0!'$DATA(X)
- QUIT
- Begin DoDot:1
- +4 SET GMRVY=$GET(^GMRD(120.52,DA(1),1,DA,0))
- +5 SET GTYP=+$PIECE(GMRVY,"^")
- +6 IF $DATA(^GMRD(120.52,"BB",GTYP))
- Begin DoDot:2
- +7 SET GCAT=0
- FOR
- SET GCAT=$ORDER(^GMRD(120.52,"BB",GTYP,GCAT))
- if GCAT'>0!'$DATA(X)
- QUIT
- SET GSYN=""
- FOR
- SET GSYN=$ORDER(^GMRD(120.52,"BB",GTYP,GCAT,GSYN))
- if GSYN=""!'$DATA(X)
- QUIT
- IF GSYN=X
- if '$DATA(ZTQUEUED)
- WRITE !!,X," has been entered for "_$PIECE(^GMRD(120.51,GTYP,0),"^"),!!
- KILL X
- End DoDot:2
- End DoDot:1
- +8 KILL GMRVDA
- QUIT