Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRVQUAL

GMRVQUAL.m

Go to the documentation of this file.
  1. GMRVQUAL ;HIOFO/YH,FT-VITAL QUALIFIERS ;3/26/05 15:12
  1. ;;5.0;GEN. MED. REC. - VITALS;**8**;Oct 31, 2002
  1. ;
  1. ; This routine uses the following IAs:
  1. ; <None>
  1. ;
  1. LISTQ ;
  1. S (I,GMAX,J)=0 K GCHART,GCHART1,GMRW,GCOUNT,GMRENTR,GQUAL,GENTR
  1. 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
  1. . Q:$$ACTIVE^GMVUID(120.52,"",GDA_",","") ;active vuid?
  1. . S GCHA=$P($G(^GMRD(120.52,GDA,0)),"^") Q:GCHA=""
  1. . S GQUAL(GMRVODR,GCHA)=GDA
  1. . Q
  1. 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
  1. . I GMRVITY="BP"!(GMRVITY="CG") S I=I+1,GCHART(I)=GCHA_"^"_GQUAL(GMRVODR,GCHA)_"^"_GMRVODR,GMRLAST(GMRVODR,GORDER(GMRVODR))=I
  1. . I GMRVODR>1,GMRVITY'="BP",GMRVITY'="CG" S I=I+1,GCHART(I)=GCHA_"^"_GQUAL(GMRVODR,GCHA)_"^"_GMRVODR,GMRLAST(GMRVODR,GORDER(GMRVODR))=I
  1. . I GMRVODR=1,GMRVITY'="BP",GMRVITY'="CG" S J=J+1,GCHART1(J)=GCHA_"^"_GQUAL(GMRVODR,GCHA)_"^"_GMRVODR,GMRLAST(GMRVODR,GORDER(GMRVODR))=J
  1. . I $D(GMRDP),GMRVITY="BP" S J=J+1,GCHART1(J)=GCHA_"^"_GQUAL(GMRVODR,GCHA)_"^"_GMRVODR,GMRLAST(GMRVODR,GORDER(GMRVODR))=J
  1. .S GCOUNT(GMRVODR,GORDER(GMRVODR))=$G(GCOUNT(GMRVODR,GORDER(GMRVODR)))+1
  1. .I GMRVITY="BP"!(GMRVITY="CG"),$G(GCOUNT(GMRVODR,GORDER(GMRVODR)))>GMAX S GMAX=$G(GCOUNT(GMRVODR,GORDER(GMRVODR)))
  1. .I GMRVITY'="CG",GMRVITY'="BP",GMRVODR'=1,$G(GCOUNT(GMRVODR,GORDER(GMRVODR)))>GMAX S GMAX=$G(GCOUNT(GMRVODR,GORDER(GMRVODR)))
  1. .Q
  1. Q:GLVL=8 I GLVL=9 D Q
  1. . S I=0 F S I=$O(GCHART1(I)) Q:I'>0 S GMRW($P(GCHART1(I),"^"))=$P(GCHART1(I),"^",2)
  1. . Q
  1. W !,?3,$S($G(GMRVDFLT(1))'="":"Default: "_$P(GMRVDFLT(1),"^"),1:"Qualifiers: ") S GTXT="" D Q
  1. . 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
  1. . I GTXT'="" D WRITE
  1. . Q
  1. Q
  1. OTHERQ ;
  1. Q:'$D(GCHART) S GCOL=1,GFLAG=0,$P(GLABEL," ",80)="",$P(GBLNK," ",80)=""
  1. Q:+$G(GMAX)=0
  1. K GTXT
  1. F I=1:1:GMAX S $P(GTXT(I)," ",80)=""
  1. S GMRVODR=$S(GMRVITY="BP"!(GMRVITY="CG"):0,1:1) F S GMRVODR=$O(GCOUNT(GMRVODR)) Q:GMRVODR'>0 D
  1. . I GMRVITY'="BP",GMRVITY'="CG" S GCOL=$S(GMRVODR=2:1,GMRVODR=3:18,GMRVODR=4:37,1:58)
  1. . E S GCOL=$S(GMRVODR=1:1,GMRVODR=2:18,GMRVODR=3:37,GMRVODR=4:58,1:70)
  1. . S I=0,GCAT="" F S GCAT=$O(GCOUNT(GMRVODR,GCAT)) Q:GCAT="" D
  1. . . S GLABEL=$S(GMRVODR=1:$E(GCAT_GBLNK,1,80),1:$E($E(GLABEL,1,GCOL)_GCAT_GBLNK,1,80))
  1. . . S GMIN=GMRLAST(GMRVODR,GORDER(GMRVODR))-GCOUNT(GMRVODR,GCAT)+1
  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))
  1. . . Q
  1. . Q
  1. D:$D(GLABEL) SELECT Q
  1. ;
  1. SELECT ;OTHER QUALIFIERS
  1. S (GTYPE,GSIDE)=0 W !!,"Qualifiers for "_GMRVIT(1)_": ",!!,GLABEL,!
  1. F I=1:1:GMAX W !,GTXT(I)
  1. I GMRVITY'="CG" W !!,"Select a number under each category (optional).",!,"Separate the numbers with ',': "
  1. E W !!,"Enter a number under each category, separate numbers with a ',' ",!,"DO NOT select SITE if this is a HEAD/ABDOMINAL girth measurement: "
  1. K GMRINF(GMRVITY) S GMRINF="" R GMRINF:DTIME I '$T!(GMRINF["^") S GMROUT=1 Q
  1. I $L(GMRINF)>10 W !,"ERROR ENTRY!!!" G SELECT
  1. STRIP ; strip off trailing commas
  1. S GMRVCOMA=$L(GMRINF)
  1. I GMRVCOMA I $E(GMRINF,GMRVCOMA)="," S GMRINF=$E(GMRINF,1,GMRVCOMA-1) G STRIP
  1. K GMRVCOMA
  1. G:GMRVITY="CG"&(GMRINF="") SELECT
  1. I GMRINF="" D BP Q
  1. 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
  1. I GMRVITY="P",$P(GMRSITE,"^")="APICAL" S GTYPE=1
  1. S GMROUT(1)=0 F I=1:1:$L(GMRINF,",") Q:GMROUT(1) S J=+$P(GMRINF,",",I) D Q:GMROUT(1)
  1. . I '$D(GCHART(J)) S GMROUT(1)=1 Q
  1. . I GTYPE=1,"LEFTRIGHT"[$P(GCHART(J),"^") Q
  1. . S GMRVODR=+$P(GCHART(J),"^",3)
  1. . S GMRENTR(GMRVODR)=GMRENTR(GMRVODR)-1,GMRINF(GMRVITY,GMRVODR,$P(GCHART(J),"^"))=$P(GCHART(J),"^",2,3)
  1. . I $G(GMRENTR(GMRVODR))<0 W !!,"More than maximum qualifier allowed for a category were selected!",! S GMROUT(1)=1 Q
  1. . Q
  1. I GMROUT(1) W !,"ERROR ENTRY!!!",! D RESET G SELECT
  1. D BP Q:'$D(GMRINF(GMRVITY))
  1. 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)
  1. RESET ;
  1. S I=0 F S I=$O(GMRENTR(I)) Q:I'>0 S GMRENTR(I)=GENTR(I)
  1. Q
  1. WRITE ;
  1. N X S DIWR=75,DIWF="",DIWL=0,X=GTXT K ^UTILITY($J) D ^DIWP
  1. S I=0 F S I=$O(^UTILITY($J,"W",0,I)) Q:I'>0 W !,?3,^UTILITY($J,"W",0,I,0)
  1. K ^UTILITY($J) Q
  1. CATLG ;
  1. S GDA(1)=$O(^GMRD(120.53,GCAT(1),1,"B",GMRVIT,0)) Q:GDA(1)'>0
  1. S GLN=$G(^GMRD(120.53,GCAT(1),1,GDA(1),0)) Q:GLN=""
  1. S GCAT=$G(^GMRD(120.53,GCAT(1),0)) Q:GCAT=""
  1. S GMRVODR=+$P(GLN,"^",6),GMRVDFLT=$S($D(^GMRD(120.52,+$P(GLN,"^",7),0)):$P(^(0),"^"),1:"") S:GMRVODR=0 GMRVODR=1
  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))
  1. S GCOUNT(GMRVODR,GCAT)=0
  1. S GORDER(GMRVODR)=GCAT,(GENTR(GMRVODR),GMRENTR(GMRVODR))=+$P(GLN,"^",3) S:GMRENTR(GMRVODR)=0 GMRENTR(GMRVODR)=1
  1. Q
  1. CLEAR ;
  1. K GMRENTR,GDA,I,J,GCH,GCAT,GCHART,GCHART1,GMRW,GMRVODR,GCOUNT,GMRLAST,GMIN,GMAX,GLABEL,GTXT,GMRVDFLT Q
  1. BP ; Blood Pressure Check
  1. I GMRVITY="BP",($D(GMRIN)) D
  1. .F GMRVODR=0:0 S GMRVODR=$O(GMRIN(GMRVODR)) Q:GMRVODR<1 D
  1. ..S GCAT=$O(GMRIN(GMRVODR,""))
  1. ..S GMRINF(GMRVITY,GMRVODR,GCAT)=$G(GMRIN(GMRVODR,GCAT))
  1. ..Q
  1. .Q
  1. Q