GMRVSITE ;HIOFO/YH,FT-V/M SITE FILE EDIT/ENTRY ;2/17/05 14:38
;;5.0;GEN. MED. REC. - VITALS;**8**;Oct 31, 2002
;
; This routine uses the following IAs:
; <None>
;
; This routine supports the following IAs:
; #1938 - CHAR & DEFAULT entry points (private)
;
CHAR ;Enter/edit qualifier
; Due to the data standardization project, the package will no
; longer allow users to modify FILE 120.52.
Q
DEFAULT ;Enter/edit location default for TEMP./PULSE
N DA,I
N GMRDEF,GMRVCAT,GMRVIT,GMRX,GMRV,GMRY,GMROUT
S GMROUT=0,GMRVCAT="LOCATION"
S GMRVCAT(1)=$O(^GMRD(120.53,"B",GMRVCAT,0))
Q:GMRVCAT(1)'>0
Q:$$ACTIVE^GMVUID(120.53,"",GMRVCAT(1)_",","") ;active vuid?
F GMRVIT(1)="TEMPERATURE","PULSE" D
.S GMRVIT=$O(^GMRD(120.51,"B",GMRVIT(1),0)) Q:GMRVIT'>0!GMROUT D
..Q:$$ACTIVE^GMVUID(120.51,"",GMRVIT_",","") ;active vuid?
..S DA(1)=GMRVCAT(1),DA=$O(^GMRD(120.53,DA(1),1,"B",GMRVIT,0)) Q:DA'>0
..I '$D(^GMRD(120.53,DA(1),1,DA,0)) Q
..S GMRDEF=+$P(^GMRD(120.53,DA(1),1,DA,0),"^",7)
..I $$ACTIVE^GMVUID(120.52,"",GMRDEF_",","") D
...D CAT2^GMVUID(DA(1),DA)
...S GMRDEF=""
...Q
..S GMRDEF=$S($D(^GMRD(120.52,+GMRDEF,0)):$P(^(0),"^"),1:"")
..D GETQUAL
..Q:GMRV'>0
..D SELECT
..Q
.Q
Q
SELECT ;
W !!,GMRVIT(1)_" has the following location qualifiers:",!
F I=1:1:GMRV W !,I_" "_$P(GMRV(I),"^")
W !!,"Enter a number for "_GMRVIT(1)_" default qualifier",!,"or ^ to quit or @ to delete: "_$S(GMRDEF'="":GMRDEF_"// ",1:"")
S GMRX="" R GMRX:DTIME
I '$T!(GMRX["^") S GMROUT=1 Q
Q:GMRX=""
G:$L(GMRX)>4 SELECT
I GMRX["?" W !,"Enter an appropriate qualifier as a default qualifier for this type of",!,"vital measurement",! G SELECT
I GMRX="@" S $P(^GMRD(120.53,DA(1),1,DA,0),"^",7)="" W:GMRDEF'="" !,GMRDEF_" has been deleted" Q
I '$D(GMRV(GMRX)) W !,"ERROR ENTRY!!!",! G SELECT
S $P(^GMRD(120.53,DA(1),1,DA,0),"^",7)=$P(GMRV(GMRX),"^",2)
W " ",$P(GMRV(GMRX),"^")
Q
GETQUAL ;Extract qualifiers for the VITAL TYPE and the CATEGORY
K GMRV
S GMRV=0,GMRX=""
F S GMRX=$O(^GMRD(120.52,"AA",GMRVIT,1,GMRX)) Q:GMRX="" D
.S GMRY=0
.F S GMRY=$O(^GMRD(120.52,"AA",GMRVIT,1,GMRX,GMRY)) Q:GMRY'>0 D
..Q:$$ACTIVE^GMVUID(120.52,"",GMRY_",","") ;active vuid?
..S GMRV=GMRV+1
..S GMRV(GMRV)=$P(^GMRD(120.52,GMRY,0),"^")_"^"_GMRY
..Q
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVSITE 2329 printed Dec 13, 2024@01:57:33 Page 2
GMRVSITE ;HIOFO/YH,FT-V/M SITE FILE EDIT/ENTRY ;2/17/05 14:38
+1 ;;5.0;GEN. MED. REC. - VITALS;**8**;Oct 31, 2002
+2 ;
+3 ; This routine uses the following IAs:
+4 ; <None>
+5 ;
+6 ; This routine supports the following IAs:
+7 ; #1938 - CHAR & DEFAULT entry points (private)
+8 ;
CHAR ;Enter/edit qualifier
+1 ; Due to the data standardization project, the package will no
+2 ; longer allow users to modify FILE 120.52.
+3 QUIT
DEFAULT ;Enter/edit location default for TEMP./PULSE
+1 NEW DA,I
+2 NEW GMRDEF,GMRVCAT,GMRVIT,GMRX,GMRV,GMRY,GMROUT
+3 SET GMROUT=0
SET GMRVCAT="LOCATION"
+4 SET GMRVCAT(1)=$ORDER(^GMRD(120.53,"B",GMRVCAT,0))
+5 if GMRVCAT(1)'>0
QUIT
+6 ;active vuid?
if $$ACTIVE^GMVUID(120.53,"",GMRVCAT(1)_",","")
QUIT
+7 FOR GMRVIT(1)="TEMPERATURE","PULSE"
Begin DoDot:1
+8 SET GMRVIT=$ORDER(^GMRD(120.51,"B",GMRVIT(1),0))
if GMRVIT'>0!GMROUT
QUIT
Begin DoDot:2
+9 ;active vuid?
if $$ACTIVE^GMVUID(120.51,"",GMRVIT_",","")
QUIT
+10 SET DA(1)=GMRVCAT(1)
SET DA=$ORDER(^GMRD(120.53,DA(1),1,"B",GMRVIT,0))
if DA'>0
QUIT
+11 IF '$DATA(^GMRD(120.53,DA(1),1,DA,0))
QUIT
+12 SET GMRDEF=+$PIECE(^GMRD(120.53,DA(1),1,DA,0),"^",7)
+13 IF $$ACTIVE^GMVUID(120.52,"",GMRDEF_",","")
Begin DoDot:3
+14 DO CAT2^GMVUID(DA(1),DA)
+15 SET GMRDEF=""
+16 QUIT
End DoDot:3
+17 SET GMRDEF=$SELECT($DATA(^GMRD(120.52,+GMRDEF,0)):$PIECE(^(0),"^"),1:"")
+18 DO GETQUAL
+19 if GMRV'>0
QUIT
+20 DO SELECT
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 QUIT
SELECT ;
+1 WRITE !!,GMRVIT(1)_" has the following location qualifiers:",!
+2 FOR I=1:1:GMRV
WRITE !,I_" "_$PIECE(GMRV(I),"^")
+3 WRITE !!,"Enter a number for "_GMRVIT(1)_" default qualifier",!,"or ^ to quit or @ to delete: "_$SELECT(GMRDEF'="":GMRDEF_"// ",1:"")
+4 SET GMRX=""
READ GMRX:DTIME
+5 IF '$TEST!(GMRX["^")
SET GMROUT=1
QUIT
+6 if GMRX=""
QUIT
+7 if $LENGTH(GMRX)>4
GOTO SELECT
+8 IF GMRX["?"
WRITE !,"Enter an appropriate qualifier as a default qualifier for this type of",!,"vital measurement",!
GOTO SELECT
+9 IF GMRX="@"
SET $PIECE(^GMRD(120.53,DA(1),1,DA,0),"^",7)=""
if GMRDEF'=""
WRITE !,GMRDEF_" has been deleted"
QUIT
+10 IF '$DATA(GMRV(GMRX))
WRITE !,"ERROR ENTRY!!!",!
GOTO SELECT
+11 SET $PIECE(^GMRD(120.53,DA(1),1,DA,0),"^",7)=$PIECE(GMRV(GMRX),"^",2)
+12 WRITE " ",$PIECE(GMRV(GMRX),"^")
+13 QUIT
GETQUAL ;Extract qualifiers for the VITAL TYPE and the CATEGORY
+1 KILL GMRV
+2 SET GMRV=0
SET GMRX=""
+3 FOR
SET GMRX=$ORDER(^GMRD(120.52,"AA",GMRVIT,1,GMRX))
if GMRX=""
QUIT
Begin DoDot:1
+4 SET GMRY=0
+5 FOR
SET GMRY=$ORDER(^GMRD(120.52,"AA",GMRVIT,1,GMRX,GMRY))
if GMRY'>0
QUIT
Begin DoDot:2
+6 ;active vuid?
if $$ACTIVE^GMVUID(120.52,"",GMRY_",","")
QUIT
+7 SET GMRV=GMRV+1
+8 SET GMRV(GMRV)=$PIECE(^GMRD(120.52,GMRY,0),"^")_"^"_GMRY
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 QUIT
