GMVLGQU ;HIOFO/YH,FT-UTILITY FOR LEGEND, PO2 AND QUALIFIER ;11/8/01 14:31
;;5.0;GEN. MED. REC. - VITALS;;Oct 31, 2002
;
; This routine uses the following IAs:
; #10104 - ^XLFSTR calls (supported)
;
LEGEND ;CREATE VITAL/QUALIFIER/SYNONYM LEGEND STORED IN GLINE LOCAL GLOBAL
N I,X,J,K,G,B S (I,J,B)=0,(X,GLINE(1),GLINE(2),GLINE(3),GLINE(4),GLINE(5),GLINE)=""
F G(1)="T","P","R","B","H","W","PO2","CG","CVP","PN" I $D(GMRQUAL(G(1))) D LEGEND1
S J=J+1,GLINE(J)=X
K ^UTILITY($J),DIWF,DIWL,WIWR Q
LEGEND1 ;
S G=$S(G(1)="CG":"CIRC/GIRTH",G(1)="PO2":"PULSE OX",G(1)="B":"BP",G(1)="W":"WT",G(1)="H":"HT",G(1)="T":"TEMP",G(1)="P":"PULSE",G(1)="R":"RESP",G(1)="PN":"PAIN",1:G(1))_" - "
S X=X_$S(B=0:"",1:" ")_G S B=1 D:$L(X)>150 CUT D
. S G="" F S G=$O(GMRQUAL(G(1),G)) Q:G="" S X=X_G_" " I $L(X)>150 D CUT
Q
CUT ;
S DIWF="",DIWL=0,DIWR=$S(+$G(GLPRNTR):120,1:150) K ^UTILITY($J) D ^DIWP
S I=+$P(^UTILITY($J,"W",0),"^")
S J=J+1,GLINE(J)=$G(^UTILITY($J,"W",0,1,0)),X=$G(^UTILITY($J,"W",0,2,0))
K ^UTILITY($J)
Q
SYNOARY ;
K GG S GG=$L(GMRSITE(1),";") F GG(1)=1:1:GG S GG(2)=$P(GMRSITE(1),";",GG(1)) S GG(3)=$O(^GMRD(120.52,"B",GG(2),0)) D:GG(3)>0
. S GMRSITE=GMRSITE_$S(GMRSITE="":"",1:" "),GSYNO=""
. I $P($G(^GMRD(120.52,GG(3),0)),"^",2)'="" S GSYNO=$P(^(0),"^",2)
. E S GCHA=GG(2) D
. . I GCHA["-" S GCHA=$P(GCHA,"-")_" "_$P(GCHA,"-",2)
. . I $L(GCHA," ")<2 S GSYNO=$E(GCHA)_$$LOW^XLFSTR($E(GCHA,2,3))
. . E S GLEN=$L(GCHA," ") F I=1:1:GLEN S GSYNO=GSYNO_$S($E($P(GCHA," ",I))'="(":$E($P(GCHA," ",I)),1:"")
. I GG(2)'="" S GG(2)=$E(GG(2))_$$LOW^XLFSTR($E(GG(2),2,30))
. S GMRSITE=GMRSITE_GSYNO S:GI'="C" GMRQUAL(GI,GSYNO_": "_GG(2))="" K GLEN
Q
PO2(X) ;
I X="" Q
I X["%" D
. S X(2)=$P(X,"%")
. I X(2)["l/min" S X(2)=$P(X(2),"l/min",2)
I X["l/min" D
. S X(1)=$P(X,"l/min")
. I X(1)["%" S X(1)=$P(X(1),"%",2)
S X(1)=$$STRIP^XLFSTR(X(1)," "),X(2)=$$STRIP^XLFSTR(X(2)," ")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMVLGQU 1958 printed Dec 13, 2024@01:59:37 Page 2
GMVLGQU ;HIOFO/YH,FT-UTILITY FOR LEGEND, PO2 AND QUALIFIER ;11/8/01 14:31
+1 ;;5.0;GEN. MED. REC. - VITALS;;Oct 31, 2002
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #10104 - ^XLFSTR calls (supported)
+5 ;
LEGEND ;CREATE VITAL/QUALIFIER/SYNONYM LEGEND STORED IN GLINE LOCAL GLOBAL
+1 NEW I,X,J,K,G,B
SET (I,J,B)=0
SET (X,GLINE(1),GLINE(2),GLINE(3),GLINE(4),GLINE(5),GLINE)=""
+2 FOR G(1)="T","P","R","B","H","W","PO2","CG","CVP","PN"
IF $DATA(GMRQUAL(G(1)))
DO LEGEND1
+3 SET J=J+1
SET GLINE(J)=X
+4 KILL ^UTILITY($JOB),DIWF,DIWL,WIWR
QUIT
LEGEND1 ;
+1 SET G=$SELECT(G(1)="CG":"CIRC/GIRTH",G(1)="PO2":"PULSE OX",G(1)="B":"BP",G(1)="W":"WT",G(1)="H":"HT",G(1)="T":"TEMP",G(1)="P":"PULSE",G(1)="R":"RESP",G(1)="PN":"PAIN",1:G(1))_" - "
+2 SET X=X_$SELECT(B=0:"",1:" ")_G
SET B=1
if $LENGTH(X)>150
DO CUT
Begin DoDot:1
+3 SET G=""
FOR
SET G=$ORDER(GMRQUAL(G(1),G))
if G=""
QUIT
SET X=X_G_" "
IF $LENGTH(X)>150
DO CUT
End DoDot:1
+4 QUIT
CUT ;
+1 SET DIWF=""
SET DIWL=0
SET DIWR=$SELECT(+$GET(GLPRNTR):120,1:150)
KILL ^UTILITY($JOB)
DO ^DIWP
+2 SET I=+$PIECE(^UTILITY($JOB,"W",0),"^")
+3 SET J=J+1
SET GLINE(J)=$GET(^UTILITY($JOB,"W",0,1,0))
SET X=$GET(^UTILITY($JOB,"W",0,2,0))
+4 KILL ^UTILITY($JOB)
+5 QUIT
SYNOARY ;
+1 KILL GG
SET GG=$LENGTH(GMRSITE(1),";")
FOR GG(1)=1:1:GG
SET GG(2)=$PIECE(GMRSITE(1),";",GG(1))
SET GG(3)=$ORDER(^GMRD(120.52,"B",GG(2),0))
if GG(3)>0
Begin DoDot:1
+2 SET GMRSITE=GMRSITE_$SELECT(GMRSITE="":"",1:" ")
SET GSYNO=""
+3 IF $PIECE($GET(^GMRD(120.52,GG(3),0)),"^",2)'=""
SET GSYNO=$PIECE(^(0),"^",2)
+4 IF '$TEST
SET GCHA=GG(2)
Begin DoDot:2
+5 IF GCHA["-"
SET GCHA=$PIECE(GCHA,"-")_" "_$PIECE(GCHA,"-",2)
+6 IF $LENGTH(GCHA," ")<2
SET GSYNO=$EXTRACT(GCHA)_$$LOW^XLFSTR($EXTRACT(GCHA,2,3))
+7 IF '$TEST
SET GLEN=$LENGTH(GCHA," ")
FOR I=1:1:GLEN
SET GSYNO=GSYNO_$SELECT($EXTRACT($PIECE(GCHA," ",I))'="(":$EXTRACT($PIECE(GCHA," ",I)),1:"")
End DoDot:2
+8 IF GG(2)'=""
SET GG(2)=$EXTRACT(GG(2))_$$LOW^XLFSTR($EXTRACT(GG(2),2,30))
+9 SET GMRSITE=GMRSITE_GSYNO
if GI'="C"
SET GMRQUAL(GI,GSYNO_": "_GG(2))=""
KILL GLEN
End DoDot:1
+10 QUIT
PO2(X) ;
+1 IF X=""
QUIT
+2 IF X["%"
Begin DoDot:1
+3 SET X(2)=$PIECE(X,"%")
+4 IF X(2)["l/min"
SET X(2)=$PIECE(X(2),"l/min",2)
End DoDot:1
+5 IF X["l/min"
Begin DoDot:1
+6 SET X(1)=$PIECE(X,"l/min")
+7 IF X(1)["%"
SET X(1)=$PIECE(X(1),"%",2)
End DoDot:1
+8 SET X(1)=$$STRIP^XLFSTR(X(1)," ")
SET X(2)=$$STRIP^XLFSTR(X(2)," ")
+9 QUIT
