Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWLRRG

ORWLRRG.m

Go to the documentation of this file.
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
 ;
COMMENT(DFN,START,END,COM) ;
 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
 ;