GMVFSYN ;HOIFO/RM,YH,FT-X REFERENCE FOR VITAL TYPE, CATEGORY AND SYNONYM ;3/8/05  13:38
 ;;5.0;GEN. MED. REC. - VITALS;**8**;Oct 31, 2002
 ;
 ; This routine uses the following IAs:
 ; <None>
 ;
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
 ; Called from SYNONYM field (#.02) of the GMRV VITAL QUALIFIER file
 ; (#120.52) - ^DD(120.52,.02,0)
 Q  ; SYNONYMs will be provided by the standardization process. 
 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&'$D(^(GSYN,DA(1))) W:'$D(ZTQUEUED) !!,X K X
 K GMRVDA Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMVFSYN   3303     printed  Sep 23, 2025@19:34:47                                                                                                                                                                                                     Page 2
GMVFSYN   ;HOIFO/RM,YH,FT-X REFERENCE FOR VITAL TYPE, CATEGORY AND SYNONYM ;3/8/05  13:38
 +1       ;;5.0;GEN. MED. REC. - VITALS;**8**;Oct 31, 2002
 +2       ;
 +3       ; This routine uses the following IAs:
 +4       ; <None>
 +5       ;
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       ; Called from SYNONYM field (#.02) of the GMRV VITAL QUALIFIER file
 +2       ; (#120.52) - ^DD(120.52,.02,0)
 +3       ; SYNONYMs will be provided by the standardization process. 
           QUIT 
 +4        if X=""
               QUIT 
           SET GMRVDA=DA
           NEW DA,GTYP,GCAT,GSYN
 +5        SET DA(1)=GMRVDA
           SET DA=0
 +6        FOR 
               SET DA=$ORDER(^GMRD(120.52,DA(1),1,DA))
               if DA'>0!'$DATA(X)
                   QUIT 
               Begin DoDot:1
 +7                SET GMRVY=$GET(^GMRD(120.52,DA(1),1,DA,0))
 +8                SET GTYP=+$PIECE(GMRVY,"^")
 +9                IF $DATA(^GMRD(120.52,"BB",GTYP))
                       Begin DoDot:2
 +10                       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&'$DATA(^(GSYN,DA(1)))
                                       if '$DATA(ZTQUEUED)
                                           WRITE !!,X
                                       KILL X
                       End DoDot:2
               End DoDot:1
 +11       KILL GMRVDA
           QUIT