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 Oct 16, 2024@17:59:25 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
