- 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 Feb 19, 2025@00:03:15 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 ;
