GMVLWT1 ;HIOFO/YH,FT-DOT MATRIX PATIENT WEIGHT GRAPH - 2 ;11/6/01 15:31
;;5.0;GEN. MED. REC. - VITALS;;Oct 31, 2002
;
; This routine uses the following IAs:
; #10061 - ^VADPT calls (supported)
; #10104 - ^XLFSTR calls (supported)
;
VAF ;WEIGHT GRAPH
D DEM^VADPT,INP^VADPT S GMRBTH=$P(VADM(3),"^",2),GMRNAM=VADM(1)
F GMRK="W","H" D GMRDT
S (GMRTNM,GMRI)=0 I $D(^TMP($J,"GMRDT")) F S GMRI=$O(^TMP($J,"GMRDT",GMRI)) Q:GMRI'>0 S GMRTNM=GMRTNM+1
D GRAPH K GMR3,GMRDAT,GMREN,GMRHDR1,GMRHDR11,GMRHDR10,GMRHDR2,GMRHT,GMRI,GMRJ,GMRK,GMRLINE,GDATA,GMROLD,GMRW,GMRWDIF,GMRPG,GMRPGC,GMRPGS,GMRWHI,GMRWLO,GMRWOFF,GMRSITE,GMRTNM
K GMRWT,GLPRNTR,GMRTY,GMRNM,GMRVX,GMRVX1,GMRVX2,^TMP($J,"GMRDT"),^TMP($J,"GMRG"),^TMP($J,"GMRVG")
Q
GRAPH ;
S:'$D(GFLAG) GFLAG=0 S GMRPGC=0,GMRX1="" F X=1:1:10 S GMRX1=GMRX1_" "_"|"
S (GMRX,GMRX2)=GMRX1 F X=1:1:10 S $P(GMRX,"|",X)="__________",$P(GMRX2,"|",X)="----------"
S GMRPG=$S(GMRTNM=0:1,1:GMRTNM\10+$S(GMRTNM#10>0:1,1:0)) F GMRPGS=1:1:GMRPG S GMRWT=$G(GWT(1))+14.165,GMRWT(1)=9,GMRWT(2)=1 D PAGE Q:GMROUT ;GMRWT = WEIGHT VALUE WHEN $Y=1
Q
PAGE ;
K GMRQUAL W:'($E(IOST)'="C"&'GFLAG) @IOF S GFLAG=1,GMRPGC=GMRPGC+1 W !
I '$D(^TMP($J,"GMRVG")) W !!!!!!!!,?5,"THERE IS NO DATA FOR THIS PERIOD" X "F Y=$Y:1:(IOSL-6) W !" D FOOTER^GMVLWT3 Q
W ! D DATES^GMVVS2 W !,?6,"Pounds/Kgs",?17,"|",?18,GMRX
F GMRI=0:0 Q:$Y>55 W ! D SETHD^GMVLWT2 W ?5,GMRHDR10,?16,$S(GMR3:"-",1:""),?17,"|" D DATAPRT^GMVLWT2
W !,?17,"|",GMRX2 F GMRI="W","W1","WQUAL","H","H1","HQUAL","BMI" S GMRLINE(GMRI)=GMRX1
S GMRNM=0 F GMRDT=0:0 S GMRDT=$O(^TMP($J,"GMRDT",GMRDT)) Q:GMRDT'>0 S GMRNM=GMRNM+1 Q:GMRNM>10 F GMRI="W","H" D:$D(^TMP($J,"GMRVG",GMRI,GMRDT)) STLNP^GMVLWT3
F GMRI="W","W1","WQUAL","BMI","H","H1","HQUAL" D
.S G=$S(GMRI="W":"Weight (lb)",GMRI="W1":" (kg)",GMRI="WQUAL":"Qualifier",GMRI="H":"Height (in)",GMRI="H1":" (cm)",GMRI="HQUAL":"Qualifier",GMRI="BMI":"Body Mass Index",1:"")
. W !,G,?17,"|",GMRLINE(GMRI)
I 'GMROUT W !,?17,$$REPEAT^XLFSTR("-",111)
W !,"W: Weight ** - Abnormal value off of graph"
W ! I $D(GMRQUAL) S GLPRNTR=1 D LEGEND^GMVLGQU F I=1:1:5 W !,GLINE(I)
I IOSL'<($Y+10) F X=1:1 W ! Q:IOSL<($Y+10)
D FOOTER^GMVLWT3 S GMRDT="" F GMRNM=1:1:10 S GMRDT=$O(^TMP($J,"GMRDT",GMRDT)) Q:GMRDT'>0 K ^TMP($J,"GMRDT",GMRDT)
K GG,GI,GMRVJ,GSYNO Q
GMRDT S GMRTNM(GMRK)=0 F GMRI=0:0 S GMRI=$O(^TMP($J,"GMRVG",GMRK,GMRI)) Q:GMRI'>0 S GMRJ="" F X=0:0 S GMRJ=$O(^TMP($J,"GMRVG",GMRK,GMRI,GMRJ)) Q:GMRJ="" S GMRTNM(GMRK)=GMRTNM(GMRK)+1 S:GMRK'="XI1" ^TMP($J,"GMRDT",GMRI)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMVLWT1 2608 printed Nov 22, 2024@17:09:50 Page 2
GMVLWT1 ;HIOFO/YH,FT-DOT MATRIX PATIENT WEIGHT GRAPH - 2 ;11/6/01 15:31
+1 ;;5.0;GEN. MED. REC. - VITALS;;Oct 31, 2002
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #10061 - ^VADPT calls (supported)
+5 ; #10104 - ^XLFSTR calls (supported)
+6 ;
VAF ;WEIGHT GRAPH
+1 DO DEM^VADPT
DO INP^VADPT
SET GMRBTH=$PIECE(VADM(3),"^",2)
SET GMRNAM=VADM(1)
+2 FOR GMRK="W","H"
DO GMRDT
+3 SET (GMRTNM,GMRI)=0
IF $DATA(^TMP($JOB,"GMRDT"))
FOR
SET GMRI=$ORDER(^TMP($JOB,"GMRDT",GMRI))
if GMRI'>0
QUIT
SET GMRTNM=GMRTNM+1
+4 DO GRAPH
KILL GMR3,GMRDAT,GMREN,GMRHDR1,GMRHDR11,GMRHDR10,GMRHDR2,GMRHT,GMRI,GMRJ,GMRK,GMRLINE,GDATA,GMROLD,GMRW,GMRWDIF,GMRPG,GMRPGC,GMRPGS,GMRWHI,GMRWLO,GMRWOFF,GMRSITE,GMRTNM
+5 KILL GMRWT,GLPRNTR,GMRTY,GMRNM,GMRVX,GMRVX1,GMRVX2,^TMP($JOB,"GMRDT"),^TMP($JOB,"GMRG"),^TMP($JOB,"GMRVG")
+6 QUIT
GRAPH ;
+1 if '$DATA(GFLAG)
SET GFLAG=0
SET GMRPGC=0
SET GMRX1=""
FOR X=1:1:10
SET GMRX1=GMRX1_" "_"|"
+2 SET (GMRX,GMRX2)=GMRX1
FOR X=1:1:10
SET $PIECE(GMRX,"|",X)="__________"
SET $PIECE(GMRX2,"|",X)="----------"
+3 ;GMRWT = WEIGHT VALUE WHEN $Y=1
SET GMRPG=$SELECT(GMRTNM=0:1,1:GMRTNM\10+$SELECT(GMRTNM#10>0:1,1:0))
FOR GMRPGS=1:1:GMRPG
SET GMRWT=$GET(GWT(1))+14.165
SET GMRWT(1)=9
SET GMRWT(2)=1
DO PAGE
if GMROUT
QUIT
+4 QUIT
PAGE ;
+1 KILL GMRQUAL
if '($EXTRACT(IOST)'="C"&'GFLAG)
WRITE @IOF
SET GFLAG=1
SET GMRPGC=GMRPGC+1
WRITE !
+2 IF '$DATA(^TMP($JOB,"GMRVG"))
WRITE !!!!!!!!,?5,"THERE IS NO DATA FOR THIS PERIOD"
XECUTE "F Y=$Y:1:(IOSL-6) W !"
DO FOOTER^GMVLWT3
QUIT
+3 WRITE !
DO DATES^GMVVS2
WRITE !,?6,"Pounds/Kgs",?17,"|",?18,GMRX
+4 FOR GMRI=0:0
if $Y>55
QUIT
WRITE !
DO SETHD^GMVLWT2
WRITE ?5,GMRHDR10,?16,$SELECT(GMR3:"-",1:""),?17,"|"
DO DATAPRT^GMVLWT2
+5 WRITE !,?17,"|",GMRX2
FOR GMRI="W","W1","WQUAL","H","H1","HQUAL","BMI"
SET GMRLINE(GMRI)=GMRX1
+6 SET GMRNM=0
FOR GMRDT=0:0
SET GMRDT=$ORDER(^TMP($JOB,"GMRDT",GMRDT))
if GMRDT'>0
QUIT
SET GMRNM=GMRNM+1
if GMRNM>10
QUIT
FOR GMRI="W","H"
if $DATA(^TMP($JOB,"GMRVG",GMRI,GMRDT))
DO STLNP^GMVLWT3
+7 FOR GMRI="W","W1","WQUAL","BMI","H","H1","HQUAL"
Begin DoDot:1
+8 SET G=$SELECT(GMRI="W":"Weight (lb)",GMRI="W1":" (kg)",GMRI="WQUAL":"Qualifier",GMRI="H":"Height (in)",GMRI="H1":" (cm)",GMRI="HQUAL":"Qualifier",GMRI="BMI":"Body Mass Index",1:"")
+9 WRITE !,G,?17,"|",GMRLINE(GMRI)
End DoDot:1
+10 IF 'GMROUT
WRITE !,?17,$$REPEAT^XLFSTR("-",111)
+11 WRITE !,"W: Weight ** - Abnormal value off of graph"
+12 WRITE !
IF $DATA(GMRQUAL)
SET GLPRNTR=1
DO LEGEND^GMVLGQU
FOR I=1:1:5
WRITE !,GLINE(I)
+13 IF IOSL'<($Y+10)
FOR X=1:1
WRITE !
if IOSL<($Y+10)
QUIT
+14 DO FOOTER^GMVLWT3
SET GMRDT=""
FOR GMRNM=1:1:10
SET GMRDT=$ORDER(^TMP($JOB,"GMRDT",GMRDT))
if GMRDT'>0
QUIT
KILL ^TMP($JOB,"GMRDT",GMRDT)
+15 KILL GG,GI,GMRVJ,GSYNO
QUIT
GMRDT SET GMRTNM(GMRK)=0
FOR GMRI=0:0
SET GMRI=$ORDER(^TMP($JOB,"GMRVG",GMRK,GMRI))
if GMRI'>0
QUIT
SET GMRJ=""
FOR X=0:0
SET GMRJ=$ORDER(^TMP($JOB,"GMRVG",GMRK,GMRI,GMRJ))
if GMRJ=""
QUIT
SET GMRTNM(GMRK)=GMRTNM(GMRK)+1
if GMRK'="XI1"
SET ^TMP($JOB,"GMRDT",GMRI)=""
+1 QUIT
