- GMVQUAL ;HOIFO/YH,FT-VITAL QUALIFIERS ;2/17/05 14:39
- ;;5.0;GEN. MED. REC. - VITALS;**8**;Oct 31, 2002
- ;
- ; This routine uses the following IAs:
- ; <None>
- ;
- LISTQ ; {called from GMVCAQU}
- 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
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMVQUAL 2208 printed Mar 13, 2025@21:04:32 Page 2
- GMVQUAL ;HOIFO/YH,FT-VITAL QUALIFIERS ;2/17/05 14:39
- +1 ;;5.0;GEN. MED. REC. - VITALS;**8**;Oct 31, 2002
- +2 ;
- +3 ; This routine uses the following IAs:
- +4 ; <None>
- +5 ;
- LISTQ ; {called from GMVCAQU}
- +1 SET (I,GMAX,J)=0
- +2 KILL GCHART,GCHART1,GMRW,GCOUNT,GMRENTR,GQUAL,GENTR
- +3 SET GCAT(1)=0
- +4 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
- +5 ;active vuid?
- if $$ACTIVE^GMVUID(120.52,"",GDA_",","")
- QUIT
- +6 SET GCHA=$PIECE($GET(^GMRD(120.52,GDA,0)),"^")
- if GCHA=""
- QUIT
- +7 SET GQUAL(GMRVODR,GCHA)=GDA
- +8 QUIT
- End DoDot:1
- +9 SET (I,J,GMRVODR)=0
- +10 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
- +11 IF GMRVITY="BP"!(GMRVITY="CG")
- SET I=I+1
- SET GCHART(I)=GCHA_"^"_GQUAL(GMRVODR,GCHA)_"^"_GMRVODR
- SET GMRLAST(GMRVODR,GORDER(GMRVODR))=I
- +12 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
- +13 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
- +14 IF $DATA(GMRDP)
- IF GMRVITY="BP"
- SET J=J+1
- SET GCHART1(J)=GCHA_"^"_GQUAL(GMRVODR,GCHA)_"^"_GMRVODR
- SET GMRLAST(GMRVODR,GORDER(GMRVODR))=J
- +15 SET GCOUNT(GMRVODR,GORDER(GMRVODR))=$GET(GCOUNT(GMRVODR,GORDER(GMRVODR)))+1
- +16 IF GMRVITY="BP"!(GMRVITY="CG")
- IF $GET(GCOUNT(GMRVODR,GORDER(GMRVODR)))>GMAX
- SET GMAX=$GET(GCOUNT(GMRVODR,GORDER(GMRVODR)))
- +17 IF GMRVITY'="CG"
- IF GMRVITY'="BP"
- IF GMRVODR'=1
- IF $GET(GCOUNT(GMRVODR,GORDER(GMRVODR)))>GMAX
- SET GMAX=$GET(GCOUNT(GMRVODR,GORDER(GMRVODR)))
- +18 QUIT
- End DoDot:1
- +19 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
