- GMRVQUAL ;HIOFO/YH,FT-VITAL QUALIFIERS ;3/26/05 15:12
- ;;5.0;GEN. MED. REC. - VITALS;**8**;Oct 31, 2002
- ;
- ; This routine uses the following IAs:
- ; <None>
- ;
- LISTQ ;
- S (I,GMAX,J)=0 K GCHART,GCHART1,GMRW,GCOUNT,GMRENTR,GQUAL,GENTR
- S GCAT(1)=0 F S GCAT(1)=$O(^GMRD(120.52,"AA",GMRVIT,GCAT(1))) Q:GCAT(1)'>0 D CATLG S GCHA="" F S GCHA=$O(^GMRD(120.52,"AA",GMRVIT,GCAT(1),GCHA)) Q:GCHA="" S GDA=$O(^GMRD(120.52,"AA",GMRVIT,GCAT(1),GCHA,0)) Q:GDA'>0 D
- . Q:$$ACTIVE^GMVUID(120.52,"",GDA_",","") ;active vuid?
- . S GCHA=$P($G(^GMRD(120.52,GDA,0)),"^") Q:GCHA=""
- . S GQUAL(GMRVODR,GCHA)=GDA
- . Q
- S (I,J,GMRVODR)=0 F S GMRVODR=$O(GQUAL(GMRVODR)) Q:GMRVODR'>0 S GCHA="" F S GCHA=$O(GQUAL(GMRVODR,GCHA)) Q:GCHA="" D
- . I GMRVITY="BP"!(GMRVITY="CG") S I=I+1,GCHART(I)=GCHA_"^"_GQUAL(GMRVODR,GCHA)_"^"_GMRVODR,GMRLAST(GMRVODR,GORDER(GMRVODR))=I
- . I GMRVODR>1,GMRVITY'="BP",GMRVITY'="CG" S I=I+1,GCHART(I)=GCHA_"^"_GQUAL(GMRVODR,GCHA)_"^"_GMRVODR,GMRLAST(GMRVODR,GORDER(GMRVODR))=I
- . I GMRVODR=1,GMRVITY'="BP",GMRVITY'="CG" S J=J+1,GCHART1(J)=GCHA_"^"_GQUAL(GMRVODR,GCHA)_"^"_GMRVODR,GMRLAST(GMRVODR,GORDER(GMRVODR))=J
- . I $D(GMRDP),GMRVITY="BP" S J=J+1,GCHART1(J)=GCHA_"^"_GQUAL(GMRVODR,GCHA)_"^"_GMRVODR,GMRLAST(GMRVODR,GORDER(GMRVODR))=J
- .S GCOUNT(GMRVODR,GORDER(GMRVODR))=$G(GCOUNT(GMRVODR,GORDER(GMRVODR)))+1
- .I GMRVITY="BP"!(GMRVITY="CG"),$G(GCOUNT(GMRVODR,GORDER(GMRVODR)))>GMAX S GMAX=$G(GCOUNT(GMRVODR,GORDER(GMRVODR)))
- .I GMRVITY'="CG",GMRVITY'="BP",GMRVODR'=1,$G(GCOUNT(GMRVODR,GORDER(GMRVODR)))>GMAX S GMAX=$G(GCOUNT(GMRVODR,GORDER(GMRVODR)))
- .Q
- Q:GLVL=8 I GLVL=9 D Q
- . S I=0 F S I=$O(GCHART1(I)) Q:I'>0 S GMRW($P(GCHART1(I),"^"))=$P(GCHART1(I),"^",2)
- . Q
- W !,?3,$S($G(GMRVDFLT(1))'="":"Default: "_$P(GMRVDFLT(1),"^"),1:"Qualifiers: ") S GTXT="" D Q
- . S I=0 F S I=$O(GCHART1(I)) Q:I'>0 S GCHA=$P(GCHART1(I),"^") Q:GCHA="" S GTXT=GTXT_$S(GTXT="":"",1:", ")_GCHA
- . I GTXT'="" D WRITE
- . Q
- Q
- OTHERQ ;
- Q:'$D(GCHART) S GCOL=1,GFLAG=0,$P(GLABEL," ",80)="",$P(GBLNK," ",80)=""
- Q:+$G(GMAX)=0
- K GTXT
- F I=1:1:GMAX S $P(GTXT(I)," ",80)=""
- S GMRVODR=$S(GMRVITY="BP"!(GMRVITY="CG"):0,1:1) F S GMRVODR=$O(GCOUNT(GMRVODR)) Q:GMRVODR'>0 D
- . I GMRVITY'="BP",GMRVITY'="CG" S GCOL=$S(GMRVODR=2:1,GMRVODR=3:18,GMRVODR=4:37,1:58)
- . E S GCOL=$S(GMRVODR=1:1,GMRVODR=2:18,GMRVODR=3:37,GMRVODR=4:58,1:70)
- . S I=0,GCAT="" F S GCAT=$O(GCOUNT(GMRVODR,GCAT)) Q:GCAT="" D
- . . S GLABEL=$S(GMRVODR=1:$E(GCAT_GBLNK,1,80),1:$E($E(GLABEL,1,GCOL)_GCAT_GBLNK,1,80))
- . . S GMIN=GMRLAST(GMRVODR,GORDER(GMRVODR))-GCOUNT(GMRVODR,GCAT)+1
- . . F J=GMIN:1:GMRLAST(GMRVODR,GORDER(GMRVODR)) S I=I+1,GTXT(I)=$S(GMRVODR=1:$E(J_" "_$E($P(GCHART(J),"^"),1,16)_GBLNK,1,80),1:$E($E(GTXT(I),1,GCOL)_J_" "_$E($P(GCHART(J),"^"),1,16)_GBLNK,1,80))
- . . Q
- . Q
- D:$D(GLABEL) SELECT Q
- ;
- SELECT ;OTHER QUALIFIERS
- S (GTYPE,GSIDE)=0 W !!,"Qualifiers for "_GMRVIT(1)_": ",!!,GLABEL,!
- F I=1:1:GMAX W !,GTXT(I)
- I GMRVITY'="CG" W !!,"Select a number under each category (optional).",!,"Separate the numbers with ',': "
- E W !!,"Enter a number under each category, separate numbers with a ',' ",!,"DO NOT select SITE if this is a HEAD/ABDOMINAL girth measurement: "
- K GMRINF(GMRVITY) S GMRINF="" R GMRINF:DTIME I '$T!(GMRINF["^") S GMROUT=1 Q
- I $L(GMRINF)>10 W !,"ERROR ENTRY!!!" G SELECT
- STRIP ; strip off trailing commas
- S GMRVCOMA=$L(GMRINF)
- I GMRVCOMA I $E(GMRINF,GMRVCOMA)="," S GMRINF=$E(GMRINF,1,GMRVCOMA-1) G STRIP
- K GMRVCOMA
- G:GMRVITY="CG"&(GMRINF="") SELECT
- I GMRINF="" D BP Q
- I GMRVITY="CG" S GTYPE=0 F I=1:1:$L(GMRINF,",") S J=+$P(GMRINF,",",I) I $D(GCHART(J)) S:"HEADABDOMINAL"[$P(GCHART(J),"^") GTYPE=1
- I GMRVITY="P",$P(GMRSITE,"^")="APICAL" S GTYPE=1
- S GMROUT(1)=0 F I=1:1:$L(GMRINF,",") Q:GMROUT(1) S J=+$P(GMRINF,",",I) D Q:GMROUT(1)
- . I '$D(GCHART(J)) S GMROUT(1)=1 Q
- . I GTYPE=1,"LEFTRIGHT"[$P(GCHART(J),"^") Q
- . S GMRVODR=+$P(GCHART(J),"^",3)
- . S GMRENTR(GMRVODR)=GMRENTR(GMRVODR)-1,GMRINF(GMRVITY,GMRVODR,$P(GCHART(J),"^"))=$P(GCHART(J),"^",2,3)
- . I $G(GMRENTR(GMRVODR))<0 W !!,"More than maximum qualifier allowed for a category were selected!",! S GMROUT(1)=1 Q
- . Q
- I GMROUT(1) W !,"ERROR ENTRY!!!",! D RESET G SELECT
- D BP Q:'$D(GMRINF(GMRVITY))
- W ! S I=0 F S I=$O(GMRINF(GMRVITY,I)) Q:I'>0 S I(1)="" F S I(1)=$O(GMRINF(GMRVITY,I,I(1))) Q:I(1)="" W " "_I(1)
- RESET ;
- S I=0 F S I=$O(GMRENTR(I)) Q:I'>0 S GMRENTR(I)=GENTR(I)
- Q
- WRITE ;
- N X S DIWR=75,DIWF="",DIWL=0,X=GTXT K ^UTILITY($J) D ^DIWP
- S I=0 F S I=$O(^UTILITY($J,"W",0,I)) Q:I'>0 W !,?3,^UTILITY($J,"W",0,I,0)
- K ^UTILITY($J) Q
- CATLG ;
- S GDA(1)=$O(^GMRD(120.53,GCAT(1),1,"B",GMRVIT,0)) Q:GDA(1)'>0
- S GLN=$G(^GMRD(120.53,GCAT(1),1,GDA(1),0)) Q:GLN=""
- S GCAT=$G(^GMRD(120.53,GCAT(1),0)) Q:GCAT=""
- S GMRVODR=+$P(GLN,"^",6),GMRVDFLT=$S($D(^GMRD(120.52,+$P(GLN,"^",7),0)):$P(^(0),"^"),1:"") S:GMRVODR=0 GMRVODR=1
- S GMRVDFLT(GMRVODR)=GMRVDFLT I GMRVDFLT'="",$D(^GMRD(120.52,"B",GMRVDFLT)) S GMRVDFLT(GMRVODR)=GMRVDFLT(GMRVODR)_"^"_$O(^GMRD(120.52,"B",GMRVDFLT,0))
- S GCOUNT(GMRVODR,GCAT)=0
- S GORDER(GMRVODR)=GCAT,(GENTR(GMRVODR),GMRENTR(GMRVODR))=+$P(GLN,"^",3) S:GMRENTR(GMRVODR)=0 GMRENTR(GMRVODR)=1
- Q
- CLEAR ;
- K GMRENTR,GDA,I,J,GCH,GCAT,GCHART,GCHART1,GMRW,GMRVODR,GCOUNT,GMRLAST,GMIN,GMAX,GLABEL,GTXT,GMRVDFLT Q
- BP ; Blood Pressure Check
- I GMRVITY="BP",($D(GMRIN)) D
- .F GMRVODR=0:0 S GMRVODR=$O(GMRIN(GMRVODR)) Q:GMRVODR<1 D
- ..S GCAT=$O(GMRIN(GMRVODR,""))
- ..S GMRINF(GMRVITY,GMRVODR,GCAT)=$G(GMRIN(GMRVODR,GCAT))
- ..Q
- .Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVQUAL 5539 printed Feb 18, 2025@23:23:51 Page 2
- GMRVQUAL ;HIOFO/YH,FT-VITAL QUALIFIERS ;3/26/05 15:12
- +1 ;;5.0;GEN. MED. REC. - VITALS;**8**;Oct 31, 2002
- +2 ;
- +3 ; This routine uses the following IAs:
- +4 ; <None>
- +5 ;
- LISTQ ;
- +1 SET (I,GMAX,J)=0
- KILL GCHART,GCHART1,GMRW,GCOUNT,GMRENTR,GQUAL,GENTR
- +2 SET GCAT(1)=0
- FOR
- SET GCAT(1)=$ORDER(^GMRD(120.52,"AA",GMRVIT,GCAT(1)))
- if GCAT(1)'>0
- QUIT
- DO CATLG
- SET GCHA=""
- FOR
- SET GCHA=$ORDER(^GMRD(120.52,"AA",GMRVIT,GCAT(1),GCHA))
- if GCHA=""
- QUIT
- SET GDA=$ORDER(^GMRD(120.52,"AA",GMRVIT,GCAT(1),GCHA,0))
- if GDA'>0
- QUIT
- Begin DoDot:1
- +3 ;active vuid?
- if $$ACTIVE^GMVUID(120.52,"",GDA_",","")
- QUIT
- +4 SET GCHA=$PIECE($GET(^GMRD(120.52,GDA,0)),"^")
- if GCHA=""
- QUIT
- +5 SET GQUAL(GMRVODR,GCHA)=GDA
- +6 QUIT
- End DoDot:1
- +7 SET (I,J,GMRVODR)=0
- FOR
- SET GMRVODR=$ORDER(GQUAL(GMRVODR))
- if GMRVODR'>0
- QUIT
- SET GCHA=""
- FOR
- SET GCHA=$ORDER(GQUAL(GMRVODR,GCHA))
- if GCHA=""
- QUIT
- Begin DoDot:1
- +8 IF GMRVITY="BP"!(GMRVITY="CG")
- SET I=I+1
- SET GCHART(I)=GCHA_"^"_GQUAL(GMRVODR,GCHA)_"^"_GMRVODR
- SET GMRLAST(GMRVODR,GORDER(GMRVODR))=I
- +9 IF GMRVODR>1
- IF GMRVITY'="BP"
- IF GMRVITY'="CG"
- SET I=I+1
- SET GCHART(I)=GCHA_"^"_GQUAL(GMRVODR,GCHA)_"^"_GMRVODR
- SET GMRLAST(GMRVODR,GORDER(GMRVODR))=I
- +10 IF GMRVODR=1
- IF GMRVITY'="BP"
- IF GMRVITY'="CG"
- SET J=J+1
- SET GCHART1(J)=GCHA_"^"_GQUAL(GMRVODR,GCHA)_"^"_GMRVODR
- SET GMRLAST(GMRVODR,GORDER(GMRVODR))=J
- +11 IF $DATA(GMRDP)
- IF GMRVITY="BP"
- SET J=J+1
- SET GCHART1(J)=GCHA_"^"_GQUAL(GMRVODR,GCHA)_"^"_GMRVODR
- SET GMRLAST(GMRVODR,GORDER(GMRVODR))=J
- +12 SET GCOUNT(GMRVODR,GORDER(GMRVODR))=$GET(GCOUNT(GMRVODR,GORDER(GMRVODR)))+1
- +13 IF GMRVITY="BP"!(GMRVITY="CG")
- IF $GET(GCOUNT(GMRVODR,GORDER(GMRVODR)))>GMAX
- SET GMAX=$GET(GCOUNT(GMRVODR,GORDER(GMRVODR)))
- +14 IF GMRVITY'="CG"
- IF GMRVITY'="BP"
- IF GMRVODR'=1
- IF $GET(GCOUNT(GMRVODR,GORDER(GMRVODR)))>GMAX
- SET GMAX=$GET(GCOUNT(GMRVODR,GORDER(GMRVODR)))
- +15 QUIT
- End DoDot:1
- +16 if GLVL=8
- QUIT
- IF GLVL=9
- Begin DoDot:1
- +17 SET I=0
- FOR
- SET I=$ORDER(GCHART1(I))
- if I'>0
- QUIT
- SET GMRW($PIECE(GCHART1(I),"^"))=$PIECE(GCHART1(I),"^",2)
- +18 QUIT
- End DoDot:1
- QUIT
- +19 WRITE !,?3,$SELECT($GET(GMRVDFLT(1))'="":"Default: "_$PIECE(GMRVDFLT(1),"^"),1:"Qualifiers: ")
- SET GTXT=""
- Begin DoDot:1
- +20 SET I=0
- FOR
- SET I=$ORDER(GCHART1(I))
- if I'>0
- QUIT
- SET GCHA=$PIECE(GCHART1(I),"^")
- if GCHA=""
- QUIT
- SET GTXT=GTXT_$SELECT(GTXT="":"",1:", ")_GCHA
- +21 IF GTXT'=""
- DO WRITE
- +22 QUIT
- End DoDot:1
- QUIT
- +23 QUIT
- OTHERQ ;
- +1 if '$DATA(GCHART)
- QUIT
- SET GCOL=1
- SET GFLAG=0
- SET $PIECE(GLABEL," ",80)=""
- SET $PIECE(GBLNK," ",80)=""
- +2 if +$GET(GMAX)=0
- QUIT
- +3 KILL GTXT
- +4 FOR I=1:1:GMAX
- SET $PIECE(GTXT(I)," ",80)=""
- +5 SET GMRVODR=$SELECT(GMRVITY="BP"!(GMRVITY="CG"):0,1:1)
- FOR
- SET GMRVODR=$ORDER(GCOUNT(GMRVODR))
- if GMRVODR'>0
- QUIT
- Begin DoDot:1
- +6 IF GMRVITY'="BP"
- IF GMRVITY'="CG"
- SET GCOL=$SELECT(GMRVODR=2:1,GMRVODR=3:18,GMRVODR=4:37,1:58)
- +7 IF '$TEST
- SET GCOL=$SELECT(GMRVODR=1:1,GMRVODR=2:18,GMRVODR=3:37,GMRVODR=4:58,1:70)
- +8 SET I=0
- SET GCAT=""
- FOR
- SET GCAT=$ORDER(GCOUNT(GMRVODR,GCAT))
- if GCAT=""
- QUIT
- Begin DoDot:2
- +9 SET GLABEL=$SELECT(GMRVODR=1:$EXTRACT(GCAT_GBLNK,1,80),1:$EXTRACT($EXTRACT(GLABEL,1,GCOL)_GCAT_GBLNK,1,80))
- +10 SET GMIN=GMRLAST(GMRVODR,GORDER(GMRVODR))-GCOUNT(GMRVODR,GCAT)+1
- +11 FOR J=GMIN:1:GMRLAST(GMRVODR,GORDER(GMRVODR))
- SET I=I+1
- SET GTXT(I)=$SELECT(GMRVODR=1:$EXTRACT(J_" "_$EXTRACT($PIECE(GCHART(J),"^"),1,16)_GBLNK,1,80),1:$EXTRACT($EXTRACT(GTXT(I),1,GCOL)_J_" "_$EXTRACT($PIECE(GCHART(J),"^"),1,16)_GBLNK,1,80))
- +12 QUIT
- End DoDot:2
- +13 QUIT
- End DoDot:1
- +14 if $DATA(GLABEL)
- DO SELECT
- QUIT
- +15 ;
- SELECT ;OTHER QUALIFIERS
- +1 SET (GTYPE,GSIDE)=0
- WRITE !!,"Qualifiers for "_GMRVIT(1)_": ",!!,GLABEL,!
- +2 FOR I=1:1:GMAX
- WRITE !,GTXT(I)
- +3 IF GMRVITY'="CG"
- WRITE !!,"Select a number under each category (optional).",!,"Separate the numbers with ',': "
- +4 IF '$TEST
- WRITE !!,"Enter a number under each category, separate numbers with a ',' ",!,"DO NOT select SITE if this is a HEAD/ABDOMINAL girth measurement: "
- +5 KILL GMRINF(GMRVITY)
- SET GMRINF=""
- READ GMRINF:DTIME
- IF '$TEST!(GMRINF["^")
- SET GMROUT=1
- QUIT
- +6 IF $LENGTH(GMRINF)>10
- WRITE !,"ERROR ENTRY!!!"
- GOTO SELECT
- STRIP ; strip off trailing commas
- +1 SET GMRVCOMA=$LENGTH(GMRINF)
- +2 IF GMRVCOMA
- IF $EXTRACT(GMRINF,GMRVCOMA)=","
- SET GMRINF=$EXTRACT(GMRINF,1,GMRVCOMA-1)
- GOTO STRIP
- +3 KILL GMRVCOMA
- +4 if GMRVITY="CG"&(GMRINF="")
- GOTO SELECT
- +5 IF GMRINF=""
- DO BP
- QUIT
- +6 IF GMRVITY="CG"
- SET GTYPE=0
- FOR I=1:1:$LENGTH(GMRINF,",")
- SET J=+$PIECE(GMRINF,",",I)
- IF $DATA(GCHART(J))
- if "HEADABDOMINAL"[$PIECE(GCHART(J),"^")
- SET GTYPE=1
- +7 IF GMRVITY="P"
- IF $PIECE(GMRSITE,"^")="APICAL"
- SET GTYPE=1
- +8 SET GMROUT(1)=0
- FOR I=1:1:$LENGTH(GMRINF,",")
- if GMROUT(1)
- QUIT
- SET J=+$PIECE(GMRINF,",",I)
- Begin DoDot:1
- +9 IF '$DATA(GCHART(J))
- SET GMROUT(1)=1
- QUIT
- +10 IF GTYPE=1
- IF "LEFTRIGHT"[$PIECE(GCHART(J),"^")
- QUIT
- +11 SET GMRVODR=+$PIECE(GCHART(J),"^",3)
- +12 SET GMRENTR(GMRVODR)=GMRENTR(GMRVODR)-1
- SET GMRINF(GMRVITY,GMRVODR,$PIECE(GCHART(J),"^"))=$PIECE(GCHART(J),"^",2,3)
- +13 IF $GET(GMRENTR(GMRVODR))<0
- WRITE !!,"More than maximum qualifier allowed for a category were selected!",!
- SET GMROUT(1)=1
- QUIT
- +14 QUIT
- End DoDot:1
- if GMROUT(1)
- QUIT
- +15 IF GMROUT(1)
- WRITE !,"ERROR ENTRY!!!",!
- DO RESET
- GOTO SELECT
- +16 DO BP
- if '$DATA(GMRINF(GMRVITY))
- QUIT
- +17 WRITE !
- SET I=0
- FOR
- SET I=$ORDER(GMRINF(GMRVITY,I))
- if I'>0
- QUIT
- SET I(1)=""
- FOR
- SET I(1)=$ORDER(GMRINF(GMRVITY,I,I(1)))
- if I(1)=""
- QUIT
- WRITE " "_I(1)
- RESET ;
- +1 SET I=0
- FOR
- SET I=$ORDER(GMRENTR(I))
- if I'>0
- QUIT
- SET GMRENTR(I)=GENTR(I)
- +2 QUIT
- WRITE ;
- +1 NEW X
- SET DIWR=75
- SET DIWF=""
- SET DIWL=0
- SET X=GTXT
- KILL ^UTILITY($JOB)
- DO ^DIWP
- +2 SET I=0
- FOR
- SET I=$ORDER(^UTILITY($JOB,"W",0,I))
- if I'>0
- QUIT
- WRITE !,?3,^UTILITY($JOB,"W",0,I,0)
- +3 KILL ^UTILITY($JOB)
- QUIT
- CATLG ;
- +1 SET GDA(1)=$ORDER(^GMRD(120.53,GCAT(1),1,"B",GMRVIT,0))
- if GDA(1)'>0
- QUIT
- +2 SET GLN=$GET(^GMRD(120.53,GCAT(1),1,GDA(1),0))
- if GLN=""
- QUIT
- +3 SET GCAT=$GET(^GMRD(120.53,GCAT(1),0))
- if GCAT=""
- QUIT
- +4 SET GMRVODR=+$PIECE(GLN,"^",6)
- SET GMRVDFLT=$SELECT($DATA(^GMRD(120.52,+$PIECE(GLN,"^",7),0)):$PIECE(^(0),"^"),1:"")
- if GMRVODR=0
- SET GMRVODR=1
- +5 SET GMRVDFLT(GMRVODR)=GMRVDFLT
- IF GMRVDFLT'=""
- IF $DATA(^GMRD(120.52,"B",GMRVDFLT))
- SET GMRVDFLT(GMRVODR)=GMRVDFLT(GMRVODR)_"^"_$ORDER(^GMRD(120.52,"B",GMRVDFLT,0))
- +6 SET GCOUNT(GMRVODR,GCAT)=0
- +7 SET GORDER(GMRVODR)=GCAT
- SET (GENTR(GMRVODR),GMRENTR(GMRVODR))=+$PIECE(GLN,"^",3)
- if GMRENTR(GMRVODR)=0
- SET GMRENTR(GMRVODR)=1
- +8 QUIT
- CLEAR ;
- +1 KILL GMRENTR,GDA,I,J,GCH,GCAT,GCHART,GCHART1,GMRW,GMRVODR,GCOUNT,GMRLAST,GMIN,GMAX,GLABEL,GTXT,GMRVDFLT
- QUIT
- BP ; Blood Pressure Check
- +1 IF GMRVITY="BP"
- IF ($DATA(GMRIN))
- Begin DoDot:1
- +2 FOR GMRVODR=0:0
- SET GMRVODR=$ORDER(GMRIN(GMRVODR))
- if GMRVODR<1
- QUIT
- Begin DoDot:2
- +3 SET GCAT=$ORDER(GMRIN(GMRVODR,""))
- +4 SET GMRINF(GMRVITY,GMRVODR,GCAT)=$GET(GMRIN(GMRVODR,GCAT))
- +5 QUIT
- End DoDot:2
- +6 QUIT
- End DoDot:1
- +7 QUIT