PXRMCWH ; SLC/AGP - Computed findings for WH project. ;06/09/2006
;;2.0;CLINICAL REMINDERS;**1,4**;Feb 4, 2005;Build 21
;
MAM(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
;mammogram screening and review
;
N CNT,CNT1,RESULT,WHDATE
S NGET=$S(NGET<0:-NGET,1:NGET)
S (CNT1,CNT,NFOUND)=0,DATE=$$NOW^PXRMDATE,TEST(1)=0
I $G(BDT)'="",$G(EDT)'="" S WHDATE=BDT_U_EDT
D LATEST^WVRPCPR(.RESULT,DFN,"M",$G(WHDATE),$G(NGET),"*")
I $D(RESULT)>0 D PROCESS(.RESULT,.CNT1,.TEST,.DATA,.TEXT,NGET,BDT,EDT,NFOUND)
I $G(CNT1)>0 S NFOUND=CNT1
Q
;
MAMA(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
;mammogram abnormal result
;
N CNT,CNT1,RESULT,WHDATE
S NGET=$S(NGET<0:-NGET,1:NGET)
S (CNT1,CNT,NFOUND)=0,DATE=$$NOW^PXRMDATE,TEST(1)=0
I $G(BDT)'="",$G(EDT)'="" S WHDATE=BDT_U_EDT
D LATEST^WVRPCPR(.RESULT,DFN,"M",$G(WHDATE),$G(NGET),"A")
I $D(RESULT)>0 D PROCESS(.RESULT,.CNT1,.TEST,.DATA,.TEXT,NGET,BDT,EDT,NFOUND)
I $G(CNT1)>0 S NFOUND=CNT1
Q
;
PAP(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed
;finding for pap smear screening and review
;
N CNT,CNT1,RESULT,WHDATE
S NGET=$S(NGET<0:-NGET,1:NGET)
S (CNT1,CNT,NFOUND)=0,DATE=$$NOW^PXRMDATE,TEST(1)=0
I $G(BDT)'="",$G(EDT)'="" S WHDATE=BDT_U_EDT
D LATEST^WVRPCPR(.RESULT,DFN,"P",$G(WHDATE),$G(NGET),"*")
I $D(RESULT)>0 D PROCESS(.RESULT,.CNT1,.TEST,.DATA,.TEXT,NGET,BDT,EDT,NFOUND)
I $G(CNT1)>0 S NFOUND=CNT1
Q
;
;
PAPA(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
;pap smear abnormal result
;
N CNT,CNT1,RESULT,WHDATE
S NGET=$S(NGET<0:-NGET,1:NGET)
S (CNT1,CNT,NFOUND)=0,DATE=$$NOW^PXRMDATE,TEST(1)=0
I $G(BDT)'="",$G(EDT)'="" S WHDATE=BDT_U_EDT
D LATEST^WVRPCPR(.RESULT,DFN,"P",$G(WHDATE),$G(NGET),"A")
I $D(RESULT)>0 D PROCESS(.RESULT,.CNT1,.TEST,.DATA,.TEXT,NGET,BDT,EDT,NFOUND)
I $G(CNT1)>0 S NFOUND=CNT1
Q
;
;
PROCESS(RESULT,CNT1,TEST,DATA,TEXT,NGET,BDT,EDT,NFOUND) ;
;Pieces out data in Result for Reminder evaluation
N DATE1
I $P($G(RESULT(0)),U)<0 Q
F S CNT=$O(RESULT(CNT)) Q:CNT=""!(CNT1>$G(NGET)) I CNT'=0 D
. S DATE1=$P($G(RESULT(CNT)),U,3)
. I $G(BDT)'="",$G(EDT)'="",EDT<BDT Q
. S CNT1=CNT1+1
. S TEST(CNT1)=0
. S DATA(CNT1,"LINK")=$P($G(RESULT(CNT)),U,7)
. S DATA(CNT1,"STATUS")=$P($G(RESULT(CNT)),U,8)
. S DATA(CNT1,"VALUE")=$P($G(RESULT(CNT)),U,5)
. S DATA(CNT1,"WVIEN")=$P($G(RESULT(CNT)),U)
. S TEST(CNT1)=1,DATE(CNT1)=$G(DATE1)
. S TEXT(CNT1)=$P($G(RESULT(CNT)),U,4)_" "_$P($G(RESULT(CNT)),U,6)
. ;S VALUE(CNT1)=$P($G(RESULT(CNT)),U,5)
Q
;
PAPSCR(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
;pap smear screening and f/u
;
N CNT,CNT1,CNT2,DATE1,DS,EDTT,IND,JND,MOR,MORIEN,NODE,OD
N PXRMWVT,PXRMWVM
N SDIR,SNOWCNT,TDATA,TDATE,TOP,TTEST,TTEXT,SNOWTOP,NODE,WVPAP
N DAS,DAS0,DAS1,DAS2,DAS3,DAS4,DAS5
S NFOUND=0
S WVPAP=$O(^WV(790.2,"B","PAP SMEAR",""))
S SNOWCNT=0,CNT=0
;Get SNOMED Morphology codes from file 790.2
F S SNOWCNT=$O(^WV(790.2,WVPAP,1,SNOWCNT)) Q:+SNOWCNT'>0 D
.S PXRMWVM($P($G(^WV(790.2,WVPAP,1,SNOWCNT,0)),U))=$P($G(^WV(790.2,WVPAP,1,SNOWCNT,0)),U,2)
;
;Get SNOMED Topography codes from file 790.2
S SNOWCNT=0 F S SNOWCNT=$O(^WV(790.2,WVPAP,2,SNOWCNT)) Q:+SNOWCNT'>0 D
.S PXRMWVT($P($G(^WV(790.2,WVPAP,2,SNOWCNT,0)),U))=""
;
;If no topography codes quit
I $D(PXRMWVT)'>0 S DATA(1,"VALUE")="NO TOPOGRAPHY CODES FOUND",TEST(1)=0,TEXT(1)=" " Q
;
;Handle search direction and date ranges
S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
S SDIR=$S(NGET<0:+1,1:-1)
S DS=$S(SDIR=+1:BDT-.000001,1:EDTT)
S NGET=$S(NGET<0:-NGET,1:NGET)
;
;Match Topography codes in PXRMINDX for Lab
N DTARRAY,NODE1,TCNT,ODATE1
S TOP=0,CNT1=0,TCNT=0,ODATE1=0 F S TOP=$O(PXRMWVT(TOP)) Q:+TOP'>0!(CNT1=NGET) D
.S SNOWTOP="A;O;"_TOP,DATE1=DS
.F S DATE1=+$O(^PXRMINDX(63,"PI",DFN,SNOWTOP,DATE1),SDIR) Q:$S(DATE1'>0:1,DATE1<BDT:1,DATE1>EDTT:1,1:0) D
..S DAS=$O(^PXRMINDX(63,"PI",DFN,SNOWTOP,DATE1,""))
..;
..;set date to dtarray to hanle multiple snomed done on the same date
..S DTARRAY(DATE1)=$S($D(DTARRAY(DATE1)):DTARRAY(DATE1)+1,1:1)
..S DTARRAY(DATE1,DTARRAY(DATE1))=TOP_U_DAS
;
;loop through date array
N DAS
S DATE1=DS F S DATE1=$O(DTARRAY(DATE1),SDIR) Q:$S(DATE1'>0:1,CNT1=NGET:1,1:0) D
.S TCNT=0,CNT1=CNT1+1 F S TCNT=$O(DTARRAY(DATE1,TCNT)) Q:TCNT'>0 D
..S NODE1=$G(DTARRAY(DATE1,TCNT))
..S TDATE(CNT1)=DATE1,NODE=$G(^LAB(61,$P(NODE1,U),0)),DAS=$P(NODE1,U,2)
..S TTEST(CNT1)=0
..;
..;set TDATA to value
..S TDATA(CNT1,"SNOMED",TCNT,"VALUE")="T-"_$P(NODE,U,2)_" "_$P(NODE,U)
..I '$D(TTEXT(CNT1)) S TTEXT(CNT1)=TDATA(CNT1,"SNOMED",TCNT,"VALUE")_" - "
..E I $L(TTEXT(CNT1))+$L(TDATA(CNT1,"SNOMED",TCNT,"VALUE"))<255 D
...I $E(TTEXT(CNT1),$L(TTEXT(CNT1)))="\" S TTEXT(CNT1)=TTEXT(CNT1)_TDATA(CNT1,"SNOMED",TCNT,"VALUE")_" - "
..S TDATA(CNT1,"SNOMED",TCNT,"TOPH")="T-"_$P(NODE,U,2)
..;
..;Dig down into Lab file to find a match for morphology codes
..S SNOWCNT=0,DAS0=$P($G(DAS),";"),DAS1=$P($G(DAS),";",3)
..S DAS2=$P(DAS,";",4),DAS3=$P(DAS,";",5)
..S CNT2=0,NODE=""
..;
..;get Morphology results
..N MCNT S MCNT=0
..S TDATA(CNT1,"UNSATISFACTORY")="F"
..F S SNOWCNT=$O(^LR(DAS0,"CY",DAS1,DAS2,DAS3,2,SNOWCNT)) Q:+SNOWCNT'>0 D
...S MORIEN=^LR(DAS0,"CY",DAS1,DAS2,DAS3,2,SNOWCNT,0)
...I $D(PXRMWVM(MORIEN))>0 D
....S TTEST(CNT1)=1,MCNT=MCNT+1
....;
....;handle multiple SNOMED entries for the same date
....S NODE=^LAB(61.1,MORIEN,0)
....N STR
....I '$D(TTEXT(CNT1)) S TTEXT(CNT1)="M-"_$P(NODE,U,2)_" "_$P(NODE,U)
....E D
.....S STR="M-"_$P(NODE,U,2)_" "_$P(NODE,U)
.....I $L(TTEXT(CNT1))+STR'<255 Q
.....S TTEXT(CNT1)=TTEXT(CNT1)_STR_";"
....;
....S TDATA(CNT1,"SNOMED",TCNT,MCNT,"MORP")="M-"_$P(NODE,U,2)
....S TDATA(CNT1,"SNOMED",TCNT,MCNT,"RESULT STATUS")=$S(PXRMWVM(MORIEN)="0":"NEM",PXRMWVM(MORIEN)="1":"Abnormal",PXRMWVM(MORIEN)="2":"Unsatisfactory",1:"Unknown")
....I TDATA(CNT1,"SNOMED",TCNT,MCNT,"RESULT STATUS")["Un" S TDATA(CNT1,"UNSATISFACTORY")="T"
....I $L(TTEXT(CNT1))+$L("\\")<255 S TTEXT(CNT1)=TTEXT(CNT1)_"\\"
S NFOUND=CNT1
N DATE1,CNT,TCNT
F IND=1:1:NFOUND S OD(TDATE(IND),IND)=""
S CNT1=0,IND=""
F S IND=$O(OD(IND),SDIR) Q:IND="" D
. S JND=0
. F S JND=$O(OD(IND,JND)) Q:JND="" D
.. S CNT1=CNT1+1
.. S DATE(CNT1)=IND
.. S TEST(CNT1)=TTEST(JND)
.. M DATA(CNT1)=TDATA(JND)
.. S TEXT(CNT1)=TTEXT(JND)
Q
;
PXRMCWH ; SLC/AGP - Computed findings for WH project. ;06/09/2006
+1 ;;2.0;CLINICAL REMINDERS;**1,4**;Feb 4, 2005;Build 21
+2 ;
MAM(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
+1 ;mammogram screening and review
+2 ;
+3 NEW CNT,CNT1,RESULT,WHDATE
+4 SET NGET=$SELECT(NGET<0:-NGET,1:NGET)
+5 SET (CNT1,CNT,NFOUND)=0
SET DATE=$$NOW^PXRMDATE
SET TEST(1)=0
+6 IF $GET(BDT)'=""
IF $GET(EDT)'=""
SET WHDATE=BDT_U_EDT
+7 DO LATEST^WVRPCPR(.RESULT,DFN,"M",$GET(WHDATE),$GET(NGET),"*")
+8 IF $DATA(RESULT)>0
DO PROCESS(.RESULT,.CNT1,.TEST,.DATA,.TEXT,NGET,BDT,EDT,NFOUND)
+9 IF $GET(CNT1)>0
SET NFOUND=CNT1
+10 QUIT
+11 ;
MAMA(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
+1 ;mammogram abnormal result
+2 ;
+3 NEW CNT,CNT1,RESULT,WHDATE
+4 SET NGET=$SELECT(NGET<0:-NGET,1:NGET)
+5 SET (CNT1,CNT,NFOUND)=0
SET DATE=$$NOW^PXRMDATE
SET TEST(1)=0
+6 IF $GET(BDT)'=""
IF $GET(EDT)'=""
SET WHDATE=BDT_U_EDT
+7 DO LATEST^WVRPCPR(.RESULT,DFN,"M",$GET(WHDATE),$GET(NGET),"A")
+8 IF $DATA(RESULT)>0
DO PROCESS(.RESULT,.CNT1,.TEST,.DATA,.TEXT,NGET,BDT,EDT,NFOUND)
+9 IF $GET(CNT1)>0
SET NFOUND=CNT1
+10 QUIT
+11 ;
PAP(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed
+1 ;finding for pap smear screening and review
+2 ;
+3 NEW CNT,CNT1,RESULT,WHDATE
+4 SET NGET=$SELECT(NGET<0:-NGET,1:NGET)
+5 SET (CNT1,CNT,NFOUND)=0
SET DATE=$$NOW^PXRMDATE
SET TEST(1)=0
+6 IF $GET(BDT)'=""
IF $GET(EDT)'=""
SET WHDATE=BDT_U_EDT
+7 DO LATEST^WVRPCPR(.RESULT,DFN,"P",$GET(WHDATE),$GET(NGET),"*")
+8 IF $DATA(RESULT)>0
DO PROCESS(.RESULT,.CNT1,.TEST,.DATA,.TEXT,NGET,BDT,EDT,NFOUND)
+9 IF $GET(CNT1)>0
SET NFOUND=CNT1
+10 QUIT
+11 ;
+12 ;
PAPA(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
+1 ;pap smear abnormal result
+2 ;
+3 NEW CNT,CNT1,RESULT,WHDATE
+4 SET NGET=$SELECT(NGET<0:-NGET,1:NGET)
+5 SET (CNT1,CNT,NFOUND)=0
SET DATE=$$NOW^PXRMDATE
SET TEST(1)=0
+6 IF $GET(BDT)'=""
IF $GET(EDT)'=""
SET WHDATE=BDT_U_EDT
+7 DO LATEST^WVRPCPR(.RESULT,DFN,"P",$GET(WHDATE),$GET(NGET),"A")
+8 IF $DATA(RESULT)>0
DO PROCESS(.RESULT,.CNT1,.TEST,.DATA,.TEXT,NGET,BDT,EDT,NFOUND)
+9 IF $GET(CNT1)>0
SET NFOUND=CNT1
+10 QUIT
+11 ;
+12 ;
PROCESS(RESULT,CNT1,TEST,DATA,TEXT,NGET,BDT,EDT,NFOUND) ;
+1 ;Pieces out data in Result for Reminder evaluation
+2 NEW DATE1
+3 IF $PIECE($GET(RESULT(0)),U)<0
QUIT
+4 FOR
SET CNT=$ORDER(RESULT(CNT))
IF CNT=""!(CNT1>$GET(NGET))
QUIT
IF CNT'=0
Begin DoDot:1
+5 SET DATE1=$PIECE($GET(RESULT(CNT)),U,3)
+6 IF $GET(BDT)'=""
IF $GET(EDT)'=""
IF EDT<BDT
QUIT
+7 SET CNT1=CNT1+1
+8 SET TEST(CNT1)=0
+9 SET DATA(CNT1,"LINK")=$PIECE($GET(RESULT(CNT)),U,7)
+10 SET DATA(CNT1,"STATUS")=$PIECE($GET(RESULT(CNT)),U,8)
+11 SET DATA(CNT1,"VALUE")=$PIECE($GET(RESULT(CNT)),U,5)
+12 SET DATA(CNT1,"WVIEN")=$PIECE($GET(RESULT(CNT)),U)
+13 SET TEST(CNT1)=1
SET DATE(CNT1)=$GET(DATE1)
+14 SET TEXT(CNT1)=$PIECE($GET(RESULT(CNT)),U,4)_" "_$PIECE($GET(RESULT(CNT)),U,6)
+15 ;S VALUE(CNT1)=$P($G(RESULT(CNT)),U,5)
End DoDot:1
+16 QUIT
+17 ;
PAPSCR(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
+1 ;pap smear screening and f/u
+2 ;
+3 NEW CNT,CNT1,CNT2,DATE1,DS,EDTT,IND,JND,MOR,MORIEN,NODE,OD
+4 NEW PXRMWVT,PXRMWVM
+5 NEW SDIR,SNOWCNT,TDATA,TDATE,TOP,TTEST,TTEXT,SNOWTOP,NODE,WVPAP
+6 NEW DAS,DAS0,DAS1,DAS2,DAS3,DAS4,DAS5
+7 SET NFOUND=0
+8 SET WVPAP=$ORDER(^WV(790.2,"B","PAP SMEAR",""))
+9 SET SNOWCNT=0
SET CNT=0
+10 ;Get SNOMED Morphology codes from file 790.2
+11 FOR
SET SNOWCNT=$ORDER(^WV(790.2,WVPAP,1,SNOWCNT))
IF +SNOWCNT'>0
QUIT
Begin DoDot:1
+12 SET PXRMWVM($PIECE($GET(^WV(790.2,WVPAP,1,SNOWCNT,0)),U))=$PIECE($GET(^WV(790.2,WVPAP,1,SNOWCNT,0)),U,2)
End DoDot:1
+13 ;
+14 ;Get SNOMED Topography codes from file 790.2
+15 SET SNOWCNT=0
FOR
SET SNOWCNT=$ORDER(^WV(790.2,WVPAP,2,SNOWCNT))
IF +SNOWCNT'>0
QUIT
Begin DoDot:1
+16 SET PXRMWVT($PIECE($GET(^WV(790.2,WVPAP,2,SNOWCNT,0)),U))=""
End DoDot:1
+17 ;
+18 ;If no topography codes quit
+19 IF $DATA(PXRMWVT)'>0
SET DATA(1,"VALUE")="NO TOPOGRAPHY CODES FOUND"
SET TEST(1)=0
SET TEXT(1)=" "
QUIT
+20 ;
+21 ;Handle search direction and date ranges
+22 SET EDTT=$SELECT(EDT[".":EDT+.0000001,1:EDT+.240001)
+23 SET SDIR=$SELECT(NGET<0:+1,1:-1)
+24 SET DS=$SELECT(SDIR=+1:BDT-.000001,1:EDTT)
+25 SET NGET=$SELECT(NGET<0:-NGET,1:NGET)
+26 ;
+27 ;Match Topography codes in PXRMINDX for Lab
+28 NEW DTARRAY,NODE1,TCNT,ODATE1
+29 SET TOP=0
SET CNT1=0
SET TCNT=0
SET ODATE1=0
FOR
SET TOP=$ORDER(PXRMWVT(TOP))
IF +TOP'>0!(CNT1=NGET)
QUIT
Begin DoDot:1
+30 SET SNOWTOP="A;O;"_TOP
SET DATE1=DS
+31 FOR
SET DATE1=+$ORDER(^PXRMINDX(63,"PI",DFN,SNOWTOP,DATE1),SDIR)
IF $SELECT(DATE1'>0
QUIT
Begin DoDot:2
+32 SET DAS=$ORDER(^PXRMINDX(63,"PI",DFN,SNOWTOP,DATE1,""))
+33 ;
+34 ;set date to dtarray to hanle multiple snomed done on the same date
+35 SET DTARRAY(DATE1)=$SELECT($DATA(DTARRAY(DATE1)):DTARRAY(DATE1)+1,1:1)
+36 SET DTARRAY(DATE1,DTARRAY(DATE1))=TOP_U_DAS
End DoDot:2
End DoDot:1
+37 ;
+38 ;loop through date array
+39 NEW DAS
+40 SET DATE1=DS
FOR
SET DATE1=$ORDER(DTARRAY(DATE1),SDIR)
IF $SELECT(DATE1'>0
QUIT
Begin DoDot:1
+41 SET TCNT=0
SET CNT1=CNT1+1
FOR
SET TCNT=$ORDER(DTARRAY(DATE1,TCNT))
IF TCNT'>0
QUIT
Begin DoDot:2
+42 SET NODE1=$GET(DTARRAY(DATE1,TCNT))
+43 SET TDATE(CNT1)=DATE1
SET NODE=$GET(^LAB(61,$PIECE(NODE1,U),0))
SET DAS=$PIECE(NODE1,U,2)
+44 SET TTEST(CNT1)=0
+45 ;
+46 ;set TDATA to value
+47 SET TDATA(CNT1,"SNOMED",TCNT,"VALUE")="T-"_$PIECE(NODE,U,2)_" "_$PIECE(NODE,U)
+48 IF '$DATA(TTEXT(CNT1))
SET TTEXT(CNT1)=TDATA(CNT1,"SNOMED",TCNT,"VALUE")_" - "
+49 IF '$TEST
IF $LENGTH(TTEXT(CNT1))+$LENGTH(TDATA(CNT1,"SNOMED",TCNT,"VALUE"))<255
Begin DoDot:3
+50 IF $EXTRACT(TTEXT(CNT1),$LENGTH(TTEXT(CNT1)))="\"
SET TTEXT(CNT1)=TTEXT(CNT1)_TDATA(CNT1,"SNOMED",TCNT,"VALUE")_" - "
End DoDot:3
+51 SET TDATA(CNT1,"SNOMED",TCNT,"TOPH")="T-"_$PIECE(NODE,U,2)
+52 ;
+53 ;Dig down into Lab file to find a match for morphology codes
+54 SET SNOWCNT=0
SET DAS0=$PIECE($GET(DAS),";")
SET DAS1=$PIECE($GET(DAS),";",3)
+55 SET DAS2=$PIECE(DAS,";",4)
SET DAS3=$PIECE(DAS,";",5)
+56 SET CNT2=0
SET NODE=""
+57 ;
+58 ;get Morphology results
+59 NEW MCNT
SET MCNT=0
+60 SET TDATA(CNT1,"UNSATISFACTORY")="F"
+61 FOR
SET SNOWCNT=$ORDER(^LR(DAS0,"CY",DAS1,DAS2,DAS3,2,SNOWCNT))
IF +SNOWCNT'>0
QUIT
Begin DoDot:3
+62 SET MORIEN=^LR(DAS0,"CY",DAS1,DAS2,DAS3,2,SNOWCNT,0)
+63 IF $DATA(PXRMWVM(MORIEN))>0
Begin DoDot:4
+64 SET TTEST(CNT1)=1
SET MCNT=MCNT+1
+65 ;
+66 ;handle multiple SNOMED entries for the same date
+67 SET NODE=^LAB(61.1,MORIEN,0)
+68 NEW STR
+69 IF '$DATA(TTEXT(CNT1))
SET TTEXT(CNT1)="M-"_$PIECE(NODE,U,2)_" "_$PIECE(NODE,U)
+70 IF '$TEST
Begin DoDot:5
+71 SET STR="M-"_$PIECE(NODE,U,2)_" "_$PIECE(NODE,U)
+72 IF $LENGTH(TTEXT(CNT1))+STR'<255
QUIT
+73 SET TTEXT(CNT1)=TTEXT(CNT1)_STR_";"
End DoDot:5
+74 ;
+75 SET TDATA(CNT1,"SNOMED",TCNT,MCNT,"MORP")="M-"_$PIECE(NODE,U,2)
+76 SET TDATA(CNT1,"SNOMED",TCNT,MCNT,"RESULT STATUS")=$SELECT(PXRMWVM(MORIEN)="0":"NEM",PXRMWVM(MORIEN)="1":"Abnormal",PXRMWVM(MORIEN)="2":"Unsatisfactory",1:"Unknown")
+77 IF TDATA(CNT1,"SNOMED",TCNT,MCNT,"RESULT STATUS")["Un"
SET TDATA(CNT1,"UNSATISFACTORY")="T"
+78 IF $LENGTH(TTEXT(CNT1))+$LENGTH("\\")<255
SET TTEXT(CNT1)=TTEXT(CNT1)_"\\"
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+79 SET NFOUND=CNT1
+80 NEW DATE1,CNT,TCNT
+81 FOR IND=1:1:NFOUND
SET OD(TDATE(IND),IND)=""
+82 SET CNT1=0
SET IND=""
+83 FOR
SET IND=$ORDER(OD(IND),SDIR)
IF IND=""
QUIT
Begin DoDot:1
+84 SET JND=0
+85 FOR
SET JND=$ORDER(OD(IND,JND))
IF JND=""
QUIT
Begin DoDot:2
+86 SET CNT1=CNT1+1
+87 SET DATE(CNT1)=IND
+88 SET TEST(CNT1)=TTEST(JND)
+89 MERGE DATA(CNT1)=TDATA(JND)
+90 SET TEXT(CNT1)=TTEXT(JND)
End DoDot:2
End DoDot:1
+91 QUIT
+92 ;
