- 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 Feb 18, 2025@23:23:55 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
