GMVFUT3 ;HOIFO/RM,FT-FILE UTILITIES FOR 120.53 FILE ;5/23/01 15:43
;;5.0;GEN. MED. REC. - VITALS;;Oct 31, 2002
;
; This routine uses the following IAs:
; <None>
;
ACAT(GMRVSK,DA,X) ; CALLED FROM SET/KILL LOGIC OF ACAT XREF ON CATEGORY
; (.01) FIELD OF GMRV CATEGORY (120.53) FILE. THIS PROCEDURE
; SETS/KILLS THE FOLLOWING MUMPS INDICES: "AA".
; 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.53,DA(1),1,DA)) Q:DA'>0 D
. S GMRVY=$G(^GMRD(120.53,DA(1),1,DA,0))
. D AA($P(GMRVY,"^"),X,.DA,GMRVSK)
. Q
K GMRVDA
Q
ATYP(GMRVSK,DA,X) ; CALLED FROM SET/KILL LOGIC OF ATYP XREF ON VITAL
; TYPE (.01) FIELD OF VITAL TYPE (120.531) SUB-FILE OF GMRV CATEGORY
; (120.53) FILE. THIS PROCEDURE SETS/KILLS THE FOLLOWING MUMPS
; INDICES: "AA", "APRINT", AND "AEDIT".
; 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.53,DA(1),0)),GMRVY=$G(^GMRD(120.53,DA(1),1,DA,0))
D AA(X,$P(GMRVX,"^"),.DA,GMRVSK)
D APRINT(X,$P(GMRVY,"^",5),.DA,GMRVSK)
D AEDIT(X,$P(GMRVY,"^",6),.DA,GMRVSK)
Q
AEDT(GMRVSK,DA,X) ; CALLED FROM SET/KILL LOGIC OF AEDT XREF ON EDIT
; ORDER (.06) FIELD OF VITAL TYPE (120.531) SUB-FILE OF GMRV CATEGORY
; (120.53) FILE. THIS PROCEDURE SETS/KILLS THE FOLLOWING MUMPS
; INDICES: "AEDIT".
; Input variables: GMRVSK=1 if called from SET, 2 if from KILL
; DA=DA array passed by reference.
; X=value being indexed.
;
N GMRVY
S GMRVY=$G(^GMRD(120.53,DA(1),1,DA,0))
D AEDIT($P(GMRVY,"^"),X,.DA,GMRVSK)
Q
APRT(GMRVSK,DA,X) ; CALLED FROM SET/KILL LOGIC OF APRT XREF ON PRINT
; ORDER (.05) FIELD OF VITAL TYPE (120.531) SUB-FILE OF GMRV CATEGORY
; (120.53) FILE. THIS PROCEDURE SETS/KILLS THE FOLLOWING MUMPS
; INDICES: "APRINT".
; Input variables: GMRVSK=1 if called from SET, 2 if from KILL
; DA=DA array passed by reference.
; X=value being indexed.
;
N GMRVY
S GMRVY=$G(^GMRD(120.53,DA(1),1,DA,0))
D APRINT($P(GMRVY,"^"),X,.DA,GMRVSK)
Q
AA(TYPE,CAT,DA,SK) ; This procedure updates the "AA" index for the 120.53
; file. This index has the following format:
; ^GMRD(120.53,"AA",TYPE,CAT,DA(1),DA)=""
; Input variables:
; TYPE=Vital Type (.01) field 120.531 sub-file.
; CAT=Name (.01) field of 120.53 file.
; DA=Passed by reference will have entry in 120.531 sub-file, DA,
; and entry in 120.53 file, DA(1).
; SK=1 if set xref, 2 if kill xref.
;
Q:$G(TYPE)=""!($G(CAT)="")!($G(DA(1))="")!($G(DA)="")
I $G(SK)=1 S ^GMRD(120.53,"AA",TYPE,CAT,DA(1),DA)=""
I $G(SK)=2 K ^GMRD(120.53,"AA",TYPE,CAT,DA(1),DA)
Q
AEDIT(TYPE,EORD,DA,SK) ; This procedure updates the "AEDIT" index for the
; 120.53 file. This index has the following format:
; ^GMRD(120.53,"AEDIT",TYPE,EORD,DA(1),DA)=""
; Input variables:
; TYPE=Vital Type (.01) field 120.531 sub-file.
; EORD=Edit Order (.06) field of 120.531 sub-file.
; DA=Passed by reference will have entry in 120.531 sub-file, DA,
; and entry in 120.53 file, DA(1).
; SK=1 if set xref, 2 if kill xref.
;
Q:$G(TYPE)=""!($G(EORD)="")!($G(DA(1))="")!($G(DA)="")
I $G(SK)=1 S ^GMRD(120.53,"AEDIT",TYPE,EORD,DA(1),DA)=""
I $G(SK)=2 K ^GMRD(120.53,"AEDIT",TYPE,EORD,DA(1),DA)
Q
APRINT(TYPE,PORD,DA,SK) ; This procedure updates the "APRINT" index for the
; 120.53 file. This index has the following format:
; ^GMRD(120.53,"APRINT",TYPE,PORD,DA(1),DA)=""
; Input variables:
; TYPE=Vital Type (.01) field 120.531 sub-file.
; PORD=Print Order (.05) field of 120.531 sub-file.
; DA=Passed by reference will have entry in 120.531 sub-file, DA,
; and entry in 120.53 file, DA(1).
; SK=1 if set xref, 2 if kill xref.
;
Q:$G(TYPE)=""!($G(PORD)="")!($G(DA(1))="")!($G(DA)="")
I $G(SK)=1 S ^GMRD(120.53,"APRINT",TYPE,PORD,DA(1),DA)=""
I $G(SK)=2 K ^GMRD(120.53,"APRINT",TYPE,PORD,DA(1),DA)
Q
SCR07(DA,Y) ; CALLED FROM INPUT TRANSFORM OF DEFAULT QUALIFIER (.07)
; FIELD OF THE VITAL TYPE (120.531) SUB-FILE OF THE GMRV VITAL CATEGORY
; (120.53) FILE. WILL CHECK TO SEE IF QUALIFIER IS VALID FOR THIS
; VITAL TYPE AND CATEGORY.
; Input Variables: DA = DA arrary passed by reference from screen.
; Y = Entry in 120.53 file being validated.
;
N GMRVCHAR,GMRVFXN,GMRVTYP S GMRVFXN=0
S GMRVTYP=$P($G(^GMRD(120.53,DA(1),1,DA,0)),"^"),GMRVCHAR=$P($G(^GMRD(120.52,+Y,0)),"^")
I GMRVTYP>0,GMRVCHAR]"",$D(^GMRD(120.52,"AA",GMRVTYP,DA(1),GMRVCHAR,+Y)) S GMRVFXN=1
Q GMRVFXN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMVFUT3 4965 printed Dec 13, 2024@01:58:46 Page 2
GMVFUT3 ;HOIFO/RM,FT-FILE UTILITIES FOR 120.53 FILE ;5/23/01 15:43
+1 ;;5.0;GEN. MED. REC. - VITALS;;Oct 31, 2002
+2 ;
+3 ; This routine uses the following IAs:
+4 ; <None>
+5 ;
ACAT(GMRVSK,DA,X) ; CALLED FROM SET/KILL LOGIC OF ACAT XREF ON CATEGORY
+1 ; (.01) FIELD OF GMRV CATEGORY (120.53) FILE. THIS PROCEDURE
+2 ; SETS/KILLS THE FOLLOWING MUMPS INDICES: "AA".
+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.53,DA(1),1,DA))
if DA'>0
QUIT
Begin DoDot:1
+10 SET GMRVY=$GET(^GMRD(120.53,DA(1),1,DA,0))
+11 DO AA($PIECE(GMRVY,"^"),X,.DA,GMRVSK)
+12 QUIT
End DoDot:1
+13 KILL GMRVDA
+14 QUIT
ATYP(GMRVSK,DA,X) ; CALLED FROM SET/KILL LOGIC OF ATYP XREF ON VITAL
+1 ; TYPE (.01) FIELD OF VITAL TYPE (120.531) SUB-FILE OF GMRV CATEGORY
+2 ; (120.53) FILE. THIS PROCEDURE SETS/KILLS THE FOLLOWING MUMPS
+3 ; INDICES: "AA", "APRINT", AND "AEDIT".
+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.53,DA(1),0))
SET GMRVY=$GET(^GMRD(120.53,DA(1),1,DA,0))
+10 DO AA(X,$PIECE(GMRVX,"^"),.DA,GMRVSK)
+11 DO APRINT(X,$PIECE(GMRVY,"^",5),.DA,GMRVSK)
+12 DO AEDIT(X,$PIECE(GMRVY,"^",6),.DA,GMRVSK)
+13 QUIT
AEDT(GMRVSK,DA,X) ; CALLED FROM SET/KILL LOGIC OF AEDT XREF ON EDIT
+1 ; ORDER (.06) FIELD OF VITAL TYPE (120.531) SUB-FILE OF GMRV CATEGORY
+2 ; (120.53) FILE. THIS PROCEDURE SETS/KILLS THE FOLLOWING MUMPS
+3 ; INDICES: "AEDIT".
+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 GMRVY
+9 SET GMRVY=$GET(^GMRD(120.53,DA(1),1,DA,0))
+10 DO AEDIT($PIECE(GMRVY,"^"),X,.DA,GMRVSK)
+11 QUIT
APRT(GMRVSK,DA,X) ; CALLED FROM SET/KILL LOGIC OF APRT XREF ON PRINT
+1 ; ORDER (.05) FIELD OF VITAL TYPE (120.531) SUB-FILE OF GMRV CATEGORY
+2 ; (120.53) FILE. THIS PROCEDURE SETS/KILLS THE FOLLOWING MUMPS
+3 ; INDICES: "APRINT".
+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 GMRVY
+9 SET GMRVY=$GET(^GMRD(120.53,DA(1),1,DA,0))
+10 DO APRINT($PIECE(GMRVY,"^"),X,.DA,GMRVSK)
+11 QUIT
AA(TYPE,CAT,DA,SK) ; This procedure updates the "AA" index for the 120.53
+1 ; file. This index has the following format:
+2 ; ^GMRD(120.53,"AA",TYPE,CAT,DA(1),DA)=""
+3 ; Input variables:
+4 ; TYPE=Vital Type (.01) field 120.531 sub-file.
+5 ; CAT=Name (.01) field of 120.53 file.
+6 ; DA=Passed by reference will have entry in 120.531 sub-file, DA,
+7 ; and entry in 120.53 file, DA(1).
+8 ; SK=1 if set xref, 2 if kill xref.
+9 ;
+10 if $GET(TYPE)=""!($GET(CAT)="")!($GET(DA(1))="")!($GET(DA)="")
QUIT
+11 IF $GET(SK)=1
SET ^GMRD(120.53,"AA",TYPE,CAT,DA(1),DA)=""
+12 IF $GET(SK)=2
KILL ^GMRD(120.53,"AA",TYPE,CAT,DA(1),DA)
+13 QUIT
AEDIT(TYPE,EORD,DA,SK) ; This procedure updates the "AEDIT" index for the
+1 ; 120.53 file. This index has the following format:
+2 ; ^GMRD(120.53,"AEDIT",TYPE,EORD,DA(1),DA)=""
+3 ; Input variables:
+4 ; TYPE=Vital Type (.01) field 120.531 sub-file.
+5 ; EORD=Edit Order (.06) field of 120.531 sub-file.
+6 ; DA=Passed by reference will have entry in 120.531 sub-file, DA,
+7 ; and entry in 120.53 file, DA(1).
+8 ; SK=1 if set xref, 2 if kill xref.
+9 ;
+10 if $GET(TYPE)=""!($GET(EORD)="")!($GET(DA(1))="")!($GET(DA)="")
QUIT
+11 IF $GET(SK)=1
SET ^GMRD(120.53,"AEDIT",TYPE,EORD,DA(1),DA)=""
+12 IF $GET(SK)=2
KILL ^GMRD(120.53,"AEDIT",TYPE,EORD,DA(1),DA)
+13 QUIT
APRINT(TYPE,PORD,DA,SK) ; This procedure updates the "APRINT" index for the
+1 ; 120.53 file. This index has the following format:
+2 ; ^GMRD(120.53,"APRINT",TYPE,PORD,DA(1),DA)=""
+3 ; Input variables:
+4 ; TYPE=Vital Type (.01) field 120.531 sub-file.
+5 ; PORD=Print Order (.05) field of 120.531 sub-file.
+6 ; DA=Passed by reference will have entry in 120.531 sub-file, DA,
+7 ; and entry in 120.53 file, DA(1).
+8 ; SK=1 if set xref, 2 if kill xref.
+9 ;
+10 if $GET(TYPE)=""!($GET(PORD)="")!($GET(DA(1))="")!($GET(DA)="")
QUIT
+11 IF $GET(SK)=1
SET ^GMRD(120.53,"APRINT",TYPE,PORD,DA(1),DA)=""
+12 IF $GET(SK)=2
KILL ^GMRD(120.53,"APRINT",TYPE,PORD,DA(1),DA)
+13 QUIT
SCR07(DA,Y) ; CALLED FROM INPUT TRANSFORM OF DEFAULT QUALIFIER (.07)
+1 ; FIELD OF THE VITAL TYPE (120.531) SUB-FILE OF THE GMRV VITAL CATEGORY
+2 ; (120.53) FILE. WILL CHECK TO SEE IF QUALIFIER IS VALID FOR THIS
+3 ; VITAL TYPE AND CATEGORY.
+4 ; Input Variables: DA = DA arrary passed by reference from screen.
+5 ; Y = Entry in 120.53 file being validated.
+6 ;
+7 NEW GMRVCHAR,GMRVFXN,GMRVTYP
SET GMRVFXN=0
+8 SET GMRVTYP=$PIECE($GET(^GMRD(120.53,DA(1),1,DA,0)),"^")
SET GMRVCHAR=$PIECE($GET(^GMRD(120.52,+Y,0)),"^")
+9 IF GMRVTYP>0
IF GMRVCHAR]""
IF $DATA(^GMRD(120.52,"AA",GMRVTYP,DA(1),GMRVCHAR,+Y))
SET GMRVFXN=1
+10 QUIT GMRVFXN
