GMVWT0 ;HIOFO/YH,FT-KYOCERA WEIGHT GRAPH - DATA ARRAY ;12/17/01 09:28
;;5.0;GEN. MED. REC. - VITALS;;Oct 31, 2002
;
; This routine uses the following IAs:
; #10061 - ^VADPT calls (supported)
;
EN1 ;
K ^TMP($J,"GMR"),^TMP($J,"GMRK"),^TMP($J,"GDT"),^TMP($J,"GTNM"),GWT S (GMRHT,GWT)=0
S GSTART1=(9999999-GMRFIN)-.0001,GEND1=9999999-GMRSTRT
F GTYPE="H","W" D SETT
F I=1:1:8 S GWT(I)=""
I GWT>0 S GWT=GWT\10*10+30,J=0 F I=1:1:8 S GWT(I)=GWT-(10*J),J=J+1,GWT(I)=GWT(I)_"/"_$J(GWT(I)/2.2,0,2)
U IO D ^GMVWT1
Q1 K GPG,GPGS,GAGE,GTYP,GTYPE,GX,GCNTD,GDATA,GDOB,GDT1,GEN,GI,GJ,GK,GMRVJ,GTNM,GWT,GINI,GMVDIAG,GMVDOB,GMVGEN,GMVNM,GSTART1,GEND1 D KVAR^VADPT K VA,VAROOT
K ^TMP($J,"GMRK"),^TMP($J,"GMR"),^TMP($J,"GDT"),^TMP($J,"GMRVG"),^TMP($J,"GTNM")
Q
SETT S GTYP=$O(^GMRD(120.51,"B",$S(GTYPE="W":"WEIGHT",1:"HEIGHT"),""))
I GTYP>0 F GX=GSTART1:0 S GX=$O(^GMR(120.5,"AA",DFN,GTYP,GX)) Q:GX>GEND1!(GX'>0) F GEN=0:0 S GEN=$O(^GMR(120.5,"AA",DFN,GTYP,GX,GEN)) Q:GEN'>0 I '$D(^GMR(120.5,GEN,2)) D BLDARR
Q
BLDARR ;
S GDATA=$S($D(^GMR(120.5,GEN,0)):^(0),1:"")
Q:$P(GDATA,U,8)="" ;corrupted record
K GMRVARY S GMRVARY="" I $P($G(^GMR(120.5,GEN,5,0)),"^",4)>0 D CHAR^GMVCHAR(GEN,.GMRVARY,GTYP)
K GG S GG="" I $O(GMRVARY(0)) D
. S GG(1)=0 F S GG(1)=$O(GMRVARY(GG(1))) Q:GG(1)'>0 S GG(2)=0 F S GG(2)=$O(GMRVARY(GG(1),GG(2))) Q:GG(2)'>0 S GG(3)="" F S GG(3)=$O(GMRVARY(GG(1),GG(2),GG(3))) Q:GG(3)="" S GG=GG_$S(GG="":"",1:";")_GG(3)
S ^TMP($J,"GMRVG",GTYPE,9999999-GX,$P(GDATA,"^",8))=GG_"^"_$S($G(GMRVX(1))>0:1,1:"")_"^^"_$P(GDATA,"^",8)
I $P(GDATA,"^",8)>0 S GDATA(0)=$P(GDATA,"^",8) S:GTYPE="W" GWT=GDATA(0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMVWT0 1662 printed Nov 22, 2024@17:10:22 Page 2
GMVWT0 ;HIOFO/YH,FT-KYOCERA WEIGHT GRAPH - DATA ARRAY ;12/17/01 09:28
+1 ;;5.0;GEN. MED. REC. - VITALS;;Oct 31, 2002
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #10061 - ^VADPT calls (supported)
+5 ;
EN1 ;
+1 KILL ^TMP($JOB,"GMR"),^TMP($JOB,"GMRK"),^TMP($JOB,"GDT"),^TMP($JOB,"GTNM"),GWT
SET (GMRHT,GWT)=0
+2 SET GSTART1=(9999999-GMRFIN)-.0001
SET GEND1=9999999-GMRSTRT
+3 FOR GTYPE="H","W"
DO SETT
+4 FOR I=1:1:8
SET GWT(I)=""
+5 IF GWT>0
SET GWT=GWT\10*10+30
SET J=0
FOR I=1:1:8
SET GWT(I)=GWT-(10*J)
SET J=J+1
SET GWT(I)=GWT(I)_"/"_$JUSTIFY(GWT(I)/2.2,0,2)
+6 USE IO
DO ^GMVWT1
Q1 KILL GPG,GPGS,GAGE,GTYP,GTYPE,GX,GCNTD,GDATA,GDOB,GDT1,GEN,GI,GJ,GK,GMRVJ,GTNM,GWT,GINI,GMVDIAG,GMVDOB,GMVGEN,GMVNM,GSTART1,GEND1
DO KVAR^VADPT
KILL VA,VAROOT
+1 KILL ^TMP($JOB,"GMRK"),^TMP($JOB,"GMR"),^TMP($JOB,"GDT"),^TMP($JOB,"GMRVG"),^TMP($JOB,"GTNM")
+2 QUIT
SETT SET GTYP=$ORDER(^GMRD(120.51,"B",$SELECT(GTYPE="W":"WEIGHT",1:"HEIGHT"),""))
+1 IF GTYP>0
FOR GX=GSTART1:0
SET GX=$ORDER(^GMR(120.5,"AA",DFN,GTYP,GX))
if GX>GEND1!(GX'>0)
QUIT
FOR GEN=0:0
SET GEN=$ORDER(^GMR(120.5,"AA",DFN,GTYP,GX,GEN))
if GEN'>0
QUIT
IF '$DATA(^GMR(120.5,GEN,2))
DO BLDARR
+2 QUIT
BLDARR ;
+1 SET GDATA=$SELECT($DATA(^GMR(120.5,GEN,0)):^(0),1:"")
+2 ;corrupted record
if $PIECE(GDATA,U,8)=""
QUIT
+3 KILL GMRVARY
SET GMRVARY=""
IF $PIECE($GET(^GMR(120.5,GEN,5,0)),"^",4)>0
DO CHAR^GMVCHAR(GEN,.GMRVARY,GTYP)
+4 KILL GG
SET GG=""
IF $ORDER(GMRVARY(0))
Begin DoDot:1
+5 SET GG(1)=0
FOR
SET GG(1)=$ORDER(GMRVARY(GG(1)))
if GG(1)'>0
QUIT
SET GG(2)=0
FOR
SET GG(2)=$ORDER(GMRVARY(GG(1),GG(2)))
if GG(2)'>0
QUIT
SET GG(3)=""
FOR
SET GG(3)=$ORDER(GMRVARY(GG(1),GG(2),GG(3)))
if GG(3)=""
QUIT
SET GG=GG_$SELECT(GG="":"",1:";")_GG(3)
End DoDot:1
+6 SET ^TMP($JOB,"GMRVG",GTYPE,9999999-GX,$PIECE(GDATA,"^",8))=GG_"^"_$SELECT($GET(GMRVX(1))>0:1,1:"")_"^^"_$PIECE(GDATA,"^",8)
+7 IF $PIECE(GDATA,"^",8)>0
SET GDATA(0)=$PIECE(GDATA,"^",8)
if GTYPE="W"
SET GWT=GDATA(0)
+8 QUIT
