GMVWT0.m

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 

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