ORWLRRG ;SLC/STAFF- lab worksheet data ;4/9/10 12:52
;;3.0;ORDER ENTRY/RESULTS REPORTING;**280**;Dec 17, 1997;Build 85
;
GRID(ROOT,DFN,START,END,SPEC,TESTS) ; from ORWLRR
D GRID^LR7OGG(.ROOT,DFN,START,END,SPEC,.TESTS) Q ; **** remove when correct
S ROOT=$NA(^TMP("ORGRID",$J))
K ^TMP("ORGRID",$J),^TMP("ORWORK",$J)
D GETTEST(DFN,START,END,SPEC,.TESTS)
D GETDATA(DFN,START,END)
D NTESTS^ORWLRRG1
D NRESULTS^ORWLRRG1
D SPECREF^ORWLRRG1
D COMBINE^ORWLRRG1
K ^TMP("ORWORK",$J)
Q
;
GETTEST(DFN,START,END,SPEC,ORTESTS) ;
N FIRST,LAST,XX K XX
D GRID^LR7OGG(.XX,DFN,START,START,SPEC,.ORTESTS) ; just get test info
M ^TMP("ORWORK",$J,"TEST")=@XX
S FIRST=$O(^TMP("ORWORK",$J,"TEST",0))
S LAST=$O(^TMP("ORWORK",$J,"TEST",""),-1)
I $L(FIRST) K ^TMP("ORWORK",$J,"TEST",FIRST)
I $L(LAST) K ^TMP("ORWORK",$J,"TEST",LAST)
K @XX,XX
;
GETDATA(DFN,START,END) ;
N COL,CNT,NUM,REFCHECK,RESULTS,RNUM,SPEC,TEST,TESTINFO,TESTSPEC,TYPEITEM,XX
K TESTSPEC,XX
S CNT=0
S NUM=1
F S NUM=$O(^TMP("ORWORK",$J,"TEST",NUM)) Q:NUM<1 D
. S TESTINFO=^TMP("ORWORK",$J,"TEST",NUM)
. S TYPEITEM="63^"_$P(TESTINFO,U,2)
. D ITEMDATA^ORWGAPI(.XX,TYPEITEM,START,DFN,END)
. S RNUM=0
. F S RNUM=$O(XX(RNUM)) Q:RNUM<1 D
.. S RESULTS=XX(RNUM)
.. S REFCHECK=$P(RESULTS,U,2)_U_$P(RESULTS,U,7)_U_$P(RESULTS,U,10,11)
.. S REFCHECK=$$UP^XLFSTR(REFCHECK)
.. S CNT=CNT+1
.. S ^TMP("ORWORK",$J,"RESULTS",CNT)=RESULTS
.. S ^TMP("ORWORK",$J,"REFCHECK",REFCHECK)=""
.. S COL=$P(RESULTS,U,3)
.. I COL S ^TMP("ORWORK",$J,"COL",COL)=""
.. S TEST=$P(RESULTS,U,2),SPEC=$P(RESULTS,U,7)
.. I TEST,SPEC S TESTSPEC(TEST,SPEC)=$P(RESULTS,U,8)
D REREF(DFN,.TESTSPEC)
D COLLECT(DFN,START,END)
K XX
Q
;
REREF(DFN,TESTSPEC) ;
N AGE,DATA,DOB,HIGH,LOW,NUM,SEX,SPEC,SREF,SUB,TEST
K DATA
D DEMOG(.DFN,.SEX,.DOB)
S AGE=$$FMDIFF^XLFDT(DT,DOB)\1
D TESTSPEC^ORWGAPIC(.DATA)
S NUM=0
F S NUM=$O(DATA(NUM)) Q:NUM<1 D
. S SREF=DATA(NUM)
. S TEST=$P(SREF,U,1),SPEC=$P(SREF,U,2)
. I TEST,SPEC,$L($G(TESTSPEC(TEST,SPEC))) D
.. S LOW=$P(SREF,U,3) I $E(LOW,1,2)="$S" S @("LOW="_LOW)
.. S HIGH=$P(SREF,U,4) I $E(HIGH,1,2)="$S" S @("HIGH="_HIGH)
.. S SREF=$$UP^XLFSTR($P(SREF,U,1,2)_U_LOW_"!"_HIGH_U_$P(SREF,U,8))
.. S SUB=TEST_U_SPEC_U
.. S ^TMP("ORWORK",$J,"TESTSPEC",SUB)=SREF
.. S ^TMP("ORWORK",$J,"SPECNAME",SPEC)=TESTSPEC(TEST,SPEC)
.. I '$D(^TMP("ORWORK",$J,"REFCHECK",SREF)) S ^(SREF)=""
.. K ^TMP("ORWORK",$J,"REFCHECK",SUB)
K DATA
Q
;
DEMOG(DFN,SEX,DOB) ;
N INFO
D DEMOG^ORWPT16(.INFO,DFN)
S SEX=$P(INFO,U,2),DOB=$P(INFO,U,3)
Q
;
COLLECT(DFN,START,END) ;
N COL,COLCNT,COM,COMMENT,CNT,ERR,RESULTS
K COM,RESULTS
S COLCNT=0
S CNT=0
K RESULTS
S COL=START
F S COL=$O(^TMP("ORWORK",$J,"COL",COL),-1) Q:COL="" D Q:COL<END
. S COLCNT=COLCNT+1
. S ^TMP("ORWORK",$J,"COL",COL)=COLCNT
. D SPEC^LRPXAPI(.RESULTS,DFN,COL,"S",.ERR)
. I $L($G(RESULTS("S"))) D
.. S COMMENT=""
.. I $$COMMENT^LRPXAPI($$LRDFN^LRPXAPIU(DFN),$$LRIDT^LRPXAPIU(COL)) S COMMENT="**"
.. S CNT=CNT+1
.. S ^TMP("ORWORK",$J,"SPEC",CNT)=COMMENT_U_RESULTS("S")
.. S ^TMP("ORWORK",$J,"SPECNUM",$P(RESULTS("S"),U))=CNT
.. S COM(COL)=""
. K RESULTS
S ^TMP("ORWORK",$J,"COL",0)=COLCNT
D NCOL
D COMMENT(DFN,START,END,.COM)
K COM,RESULTS
Q
;
NCOL ;
N CNT,COL,COMMENT,INEXACT,INFO,NUM,SNUM,SPEC,SPECNAME
S CNT=0
S NUM=0
F S NUM=$O(^TMP("ORWORK",$J,"SPEC",NUM)) Q:NUM<1 D
. S INFO=^TMP("ORWORK",$J,"SPEC",NUM)
. S COL=$P(INFO,U,2)
. S SNUM=$G(^TMP("ORWORK",$J,"COL",COL)) I SNUM D
.. S COMMENT=$P(INFO,U,1),INEXACT=$P(INFO,U,3),SPEC=$P(INFO,U,6)
.. S SPECNAME=$G(^TMP("ORWORK",$J,"SPECNAME",SPEC))
.. I INEXACT=1 S INEXACT=COL\1
.. E S INEXACT=COL
.. S ^TMP("ORWORK",$J,"NCOL",NUM)=SNUM_U_COL_U_SPEC_U_SPECNAME_U_COMMENT_U_INEXACT
.. S CNT=CNT+1
S ^TMP("ORWORK",$J,"NCOL",0)=CNT
Q
;
N COL,COLCNT,COMMENT,CNT,ERR,RESULTS
K RESULTS
S CNT=0
S COL=START
F S COL=$O(COM(COL),-1) Q:COL="" D Q:COL<END
. D SPEC^LRPXAPI(.RESULTS,DFN,COL,"C",.ERR)
. I $L($O(RESULTS("C",0))) D
.. S CNT=CNT+1
.. S ^TMP("ORWORK",$J,"COMMENTS",CNT)=$P($$FMTE^XLFDT(COL),":",1,2)_" ** Comments:"
.. S NUM=0
.. F S NUM=$O(RESULTS("C",NUM)) Q:NUM<1 D
... S CNT=CNT+1
... S ^TMP("ORWORK",$J,"COMMENTS",CNT)=RESULTS("C",NUM)
.. S CNT=CNT+1
.. S ^TMP("ORWORK",$J,"COMMENTS",CNT)=""
. K RESULTS
S ^TMP("ORWORK",$J,"COMMENTS",0)=CNT
K RESULTS
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWLRRG 4500 printed Dec 13, 2024@02:36:43 Page 2
ORWLRRG ;SLC/STAFF- lab worksheet data ;4/9/10 12:52
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**280**;Dec 17, 1997;Build 85
+2 ;
GRID(ROOT,DFN,START,END,SPEC,TESTS) ; from ORWLRR
+1 ; **** remove when correct
DO GRID^LR7OGG(.ROOT,DFN,START,END,SPEC,.TESTS)
QUIT
+2 SET ROOT=$NAME(^TMP("ORGRID",$JOB))
+3 KILL ^TMP("ORGRID",$JOB),^TMP("ORWORK",$JOB)
+4 DO GETTEST(DFN,START,END,SPEC,.TESTS)
+5 DO GETDATA(DFN,START,END)
+6 DO NTESTS^ORWLRRG1
+7 DO NRESULTS^ORWLRRG1
+8 DO SPECREF^ORWLRRG1
+9 DO COMBINE^ORWLRRG1
+10 KILL ^TMP("ORWORK",$JOB)
+11 QUIT
+12 ;
GETTEST(DFN,START,END,SPEC,ORTESTS) ;
+1 NEW FIRST,LAST,XX
KILL XX
+2 ; just get test info
DO GRID^LR7OGG(.XX,DFN,START,START,SPEC,.ORTESTS)
+3 MERGE ^TMP("ORWORK",$JOB,"TEST")=@XX
+4 SET FIRST=$ORDER(^TMP("ORWORK",$JOB,"TEST",0))
+5 SET LAST=$ORDER(^TMP("ORWORK",$JOB,"TEST",""),-1)
+6 IF $LENGTH(FIRST)
KILL ^TMP("ORWORK",$JOB,"TEST",FIRST)
+7 IF $LENGTH(LAST)
KILL ^TMP("ORWORK",$JOB,"TEST",LAST)
+8 KILL @XX,XX
+9 ;
GETDATA(DFN,START,END) ;
+1 NEW COL,CNT,NUM,REFCHECK,RESULTS,RNUM,SPEC,TEST,TESTINFO,TESTSPEC,TYPEITEM,XX
+2 KILL TESTSPEC,XX
+3 SET CNT=0
+4 SET NUM=1
+5 FOR
SET NUM=$ORDER(^TMP("ORWORK",$JOB,"TEST",NUM))
if NUM<1
QUIT
Begin DoDot:1
+6 SET TESTINFO=^TMP("ORWORK",$JOB,"TEST",NUM)
+7 SET TYPEITEM="63^"_$PIECE(TESTINFO,U,2)
+8 DO ITEMDATA^ORWGAPI(.XX,TYPEITEM,START,DFN,END)
+9 SET RNUM=0
+10 FOR
SET RNUM=$ORDER(XX(RNUM))
if RNUM<1
QUIT
Begin DoDot:2
+11 SET RESULTS=XX(RNUM)
+12 SET REFCHECK=$PIECE(RESULTS,U,2)_U_$PIECE(RESULTS,U,7)_U_$PIECE(RESULTS,U,10,11)
+13 SET REFCHECK=$$UP^XLFSTR(REFCHECK)
+14 SET CNT=CNT+1
+15 SET ^TMP("ORWORK",$JOB,"RESULTS",CNT)=RESULTS
+16 SET ^TMP("ORWORK",$JOB,"REFCHECK",REFCHECK)=""
+17 SET COL=$PIECE(RESULTS,U,3)
+18 IF COL
SET ^TMP("ORWORK",$JOB,"COL",COL)=""
+19 SET TEST=$PIECE(RESULTS,U,2)
SET SPEC=$PIECE(RESULTS,U,7)
+20 IF TEST
IF SPEC
SET TESTSPEC(TEST,SPEC)=$PIECE(RESULTS,U,8)
End DoDot:2
End DoDot:1
+21 DO REREF(DFN,.TESTSPEC)
+22 DO COLLECT(DFN,START,END)
+23 KILL XX
+24 QUIT
+25 ;
REREF(DFN,TESTSPEC) ;
+1 NEW AGE,DATA,DOB,HIGH,LOW,NUM,SEX,SPEC,SREF,SUB,TEST
+2 KILL DATA
+3 DO DEMOG(.DFN,.SEX,.DOB)
+4 SET AGE=$$FMDIFF^XLFDT(DT,DOB)\1
+5 DO TESTSPEC^ORWGAPIC(.DATA)
+6 SET NUM=0
+7 FOR
SET NUM=$ORDER(DATA(NUM))
if NUM<1
QUIT
Begin DoDot:1
+8 SET SREF=DATA(NUM)
+9 SET TEST=$PIECE(SREF,U,1)
SET SPEC=$PIECE(SREF,U,2)
+10 IF TEST
IF SPEC
IF $LENGTH($GET(TESTSPEC(TEST,SPEC)))
Begin DoDot:2
+11 SET LOW=$PIECE(SREF,U,3)
IF $EXTRACT(LOW,1,2)="$S"
SET @("LOW="_LOW)
+12 SET HIGH=$PIECE(SREF,U,4)
IF $EXTRACT(HIGH,1,2)="$S"
SET @("HIGH="_HIGH)
+13 SET SREF=$$UP^XLFSTR($PIECE(SREF,U,1,2)_U_LOW_"!"_HIGH_U_$PIECE(SREF,U,8))
+14 SET SUB=TEST_U_SPEC_U
+15 SET ^TMP("ORWORK",$JOB,"TESTSPEC",SUB)=SREF
+16 SET ^TMP("ORWORK",$JOB,"SPECNAME",SPEC)=TESTSPEC(TEST,SPEC)
+17 IF '$DATA(^TMP("ORWORK",$JOB,"REFCHECK",SREF))
SET ^(SREF)=""
+18 KILL ^TMP("ORWORK",$JOB,"REFCHECK",SUB)
End DoDot:2
End DoDot:1
+19 KILL DATA
+20 QUIT
+21 ;
DEMOG(DFN,SEX,DOB) ;
+1 NEW INFO
+2 DO DEMOG^ORWPT16(.INFO,DFN)
+3 SET SEX=$PIECE(INFO,U,2)
SET DOB=$PIECE(INFO,U,3)
+4 QUIT
+5 ;
COLLECT(DFN,START,END) ;
+1 NEW COL,COLCNT,COM,COMMENT,CNT,ERR,RESULTS
+2 KILL COM,RESULTS
+3 SET COLCNT=0
+4 SET CNT=0
+5 KILL RESULTS
+6 SET COL=START
+7 FOR
SET COL=$ORDER(^TMP("ORWORK",$JOB,"COL",COL),-1)
if COL=""
QUIT
Begin DoDot:1
+8 SET COLCNT=COLCNT+1
+9 SET ^TMP("ORWORK",$JOB,"COL",COL)=COLCNT
+10 DO SPEC^LRPXAPI(.RESULTS,DFN,COL,"S",.ERR)
+11 IF $LENGTH($GET(RESULTS("S")))
Begin DoDot:2
+12 SET COMMENT=""
+13 IF $$COMMENT^LRPXAPI($$LRDFN^LRPXAPIU(DFN),$$LRIDT^LRPXAPIU(COL))
SET COMMENT="**"
+14 SET CNT=CNT+1
+15 SET ^TMP("ORWORK",$JOB,"SPEC",CNT)=COMMENT_U_RESULTS("S")
+16 SET ^TMP("ORWORK",$JOB,"SPECNUM",$PIECE(RESULTS("S"),U))=CNT
+17 SET COM(COL)=""
End DoDot:2
+18 KILL RESULTS
End DoDot:1
if COL<END
QUIT
+19 SET ^TMP("ORWORK",$JOB,"COL",0)=COLCNT
+20 DO NCOL
+21 DO COMMENT(DFN,START,END,.COM)
+22 KILL COM,RESULTS
+23 QUIT
+24 ;
NCOL ;
+1 NEW CNT,COL,COMMENT,INEXACT,INFO,NUM,SNUM,SPEC,SPECNAME
+2 SET CNT=0
+3 SET NUM=0
+4 FOR
SET NUM=$ORDER(^TMP("ORWORK",$JOB,"SPEC",NUM))
if NUM<1
QUIT
Begin DoDot:1
+5 SET INFO=^TMP("ORWORK",$JOB,"SPEC",NUM)
+6 SET COL=$PIECE(INFO,U,2)
+7 SET SNUM=$GET(^TMP("ORWORK",$JOB,"COL",COL))
IF SNUM
Begin DoDot:2
+8 SET COMMENT=$PIECE(INFO,U,1)
SET INEXACT=$PIECE(INFO,U,3)
SET SPEC=$PIECE(INFO,U,6)
+9 SET SPECNAME=$GET(^TMP("ORWORK",$JOB,"SPECNAME",SPEC))
+10 IF INEXACT=1
SET INEXACT=COL\1
+11 IF '$TEST
SET INEXACT=COL
+12 SET ^TMP("ORWORK",$JOB,"NCOL",NUM)=SNUM_U_COL_U_SPEC_U_SPECNAME_U_COMMENT_U_INEXACT
+13 SET CNT=CNT+1
End DoDot:2
End DoDot:1
+14 SET ^TMP("ORWORK",$JOB,"NCOL",0)=CNT
+15 QUIT
+16 ;
+1 NEW COL,COLCNT,COMMENT,CNT,ERR,RESULTS
+2 KILL RESULTS
+3 SET CNT=0
+4 SET COL=START
+5 FOR
SET COL=$ORDER(COM(COL),-1)
if COL=""
QUIT
Begin DoDot:1
+6 DO SPEC^LRPXAPI(.RESULTS,DFN,COL,"C",.ERR)
+7 IF $LENGTH($ORDER(RESULTS("C",0)))
Begin DoDot:2
+8 SET CNT=CNT+1
+9 SET ^TMP("ORWORK",$JOB,"COMMENTS",CNT)=$PIECE($$FMTE^XLFDT(COL),":",1,2)_" ** Comments:"
+10 SET NUM=0
+11 FOR
SET NUM=$ORDER(RESULTS("C",NUM))
if NUM<1
QUIT
Begin DoDot:3
+12 SET CNT=CNT+1
+13 SET ^TMP("ORWORK",$JOB,"COMMENTS",CNT)=RESULTS("C",NUM)
End DoDot:3
+14 SET CNT=CNT+1
+15 SET ^TMP("ORWORK",$JOB,"COMMENTS",CNT)=""
End DoDot:2
+16 KILL RESULTS
End DoDot:1
if COL<END
QUIT
+17 SET ^TMP("ORWORK",$JOB,"COMMENTS",0)=CNT
+18 KILL RESULTS
+19 QUIT
+20 ;
