Released LR*5.2*372 SEQ #300 Extracted from mail message **KIDS**:LR*5.2*372^ **INSTALL NAME** LR*5.2*372 "BLD",7387,0) LR*5.2*372^LAB SERVICE^0^3080319^y "BLD",7387,1,0) ^^5^5^3080311^ "BLD",7387,1,1,0) Patch LR*5.2*356 made changes to the way Laboratory Test results are "BLD",7387,1,2,0) displayed on the Labs Tab of CPRS GUI. "BLD",7387,1,3,0) "BLD",7387,1,4,0) This patch will make further modifications to the reports on the Labs Tab "BLD",7387,1,5,0) and Coversheet of CPRS GUI. "BLD",7387,4,0) ^9.64PA^^0 "BLD",7387,6) 2^ "BLD",7387,6.3) 11 "BLD",7387,"ABPKG") n "BLD",7387,"KRN",0) ^9.67PA^8989.52^19 "BLD",7387,"KRN",.4,0) .4 "BLD",7387,"KRN",.401,0) .401 "BLD",7387,"KRN",.402,0) .402 "BLD",7387,"KRN",.403,0) .403 "BLD",7387,"KRN",.5,0) .5 "BLD",7387,"KRN",.84,0) .84 "BLD",7387,"KRN",3.6,0) 3.6 "BLD",7387,"KRN",3.8,0) 3.8 "BLD",7387,"KRN",9.2,0) 9.2 "BLD",7387,"KRN",9.8,0) 9.8 "BLD",7387,"KRN",9.8,"NM",0) ^9.68A^9^7 "BLD",7387,"KRN",9.8,"NM",3,0) LR7OR2^^0^B17036514 "BLD",7387,"KRN",9.8,"NM",4,0) LR7OB63^^0^B23763803 "BLD",7387,"KRN",9.8,"NM",5,0) LR7OGMC^^0^B9381223 "BLD",7387,"KRN",9.8,"NM",6,0) LR7OSUM5^^0^B33173238 "BLD",7387,"KRN",9.8,"NM",7,0) LR7OSUM6^^0^B12896437 "BLD",7387,"KRN",9.8,"NM",8,0) LRRP1^^0^B21664619 "BLD",7387,"KRN",9.8,"NM",9,0) LRLRRVF^^0^B826556 "BLD",7387,"KRN",9.8,"NM","B","LR7OB63",4) "BLD",7387,"KRN",9.8,"NM","B","LR7OGMC",5) "BLD",7387,"KRN",9.8,"NM","B","LR7OR2",3) "BLD",7387,"KRN",9.8,"NM","B","LR7OSUM5",6) "BLD",7387,"KRN",9.8,"NM","B","LR7OSUM6",7) "BLD",7387,"KRN",9.8,"NM","B","LRLRRVF",9) "BLD",7387,"KRN",9.8,"NM","B","LRRP1",8) "BLD",7387,"KRN",19,0) 19 "BLD",7387,"KRN",19,"NM",0) ^9.68A^^ "BLD",7387,"KRN",19.1,0) 19.1 "BLD",7387,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",7387,"KRN",101,0) 101 "BLD",7387,"KRN",409.61,0) 409.61 "BLD",7387,"KRN",771,0) 771 "BLD",7387,"KRN",870,0) 870 "BLD",7387,"KRN",8989.51,0) 8989.51 "BLD",7387,"KRN",8989.52,0) 8989.52 "BLD",7387,"KRN",8994,0) 8994 "BLD",7387,"KRN","B",.4,.4) "BLD",7387,"KRN","B",.401,.401) "BLD",7387,"KRN","B",.402,.402) "BLD",7387,"KRN","B",.403,.403) "BLD",7387,"KRN","B",.5,.5) "BLD",7387,"KRN","B",.84,.84) "BLD",7387,"KRN","B",3.6,3.6) "BLD",7387,"KRN","B",3.8,3.8) "BLD",7387,"KRN","B",9.2,9.2) "BLD",7387,"KRN","B",9.8,9.8) "BLD",7387,"KRN","B",19,19) "BLD",7387,"KRN","B",19.1,19.1) "BLD",7387,"KRN","B",101,101) "BLD",7387,"KRN","B",409.61,409.61) "BLD",7387,"KRN","B",771,771) "BLD",7387,"KRN","B",870,870) "BLD",7387,"KRN","B",8989.51,8989.51) "BLD",7387,"KRN","B",8989.52,8989.52) "BLD",7387,"KRN","B",8994,8994) "BLD",7387,"QUES",0) ^9.62^^ "BLD",7387,"REQB",0) ^9.611^4^1 "BLD",7387,"REQB",4,0) LR*5.2*356^2 "BLD",7387,"REQB","B","LR*5.2*356",4) "MBREQ") 0 "PKG",26,-1) 1^1 "PKG",26,0) LAB SERVICE^LR^CORE LAB SYSTEM "PKG",26,20,0) ^9.402P^1^1 "PKG",26,20,1,0) 2^^LRXDRPT "PKG",26,20,1,1) "PKG",26,20,"B",2,1) "PKG",26,22,0) ^9.49I^1^1 "PKG",26,22,1,0) 5.2^2940927^2950304 "PKG",26,22,1,"PAH",1,0) 372^3080319^33308 "PKG",26,22,1,"PAH",1,1,0) ^^5^5^3080319 "PKG",26,22,1,"PAH",1,1,1,0) Patch LR*5.2*356 made changes to the way Laboratory Test results are "PKG",26,22,1,"PAH",1,1,2,0) displayed on the Labs Tab of CPRS GUI. "PKG",26,22,1,"PAH",1,1,3,0) "PKG",26,22,1,"PAH",1,1,4,0) This patch will make further modifications to the reports on the Labs Tab "PKG",26,22,1,"PAH",1,1,5,0) and Coversheet of CPRS GUI. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 7 "RTN","LR7OB63") 0^4^B23763803^B23872851 "RTN","LR7OB63",1,0) LR7OB63 ; DALOI/dcm - Get Lab data from 63 ;8/11/97 "RTN","LR7OB63",2,0) ;;5.2;LAB SERVICE;**121,187,286,372**;Sep 27, 1994;Build 11 "RTN","LR7OB63",3,0) ; "RTN","LR7OB63",4,0) 63(CTR,LRDFN,SS,IVDT,CORRECT) ;Get data from file 63 "RTN","LR7OB63",5,0) ;CTR=Counter "RTN","LR7OB63",6,0) ;LRDFN=Patient ID "RTN","LR7OB63",7,0) ;SS=Subscript for results 'CH'-Chem Tox 'MI'-Microbiology, etc. "RTN","LR7OB63",8,0) ;IVDT=Inverse D/T verified "RTN","LR7OB63",9,0) ;CORRECT=1 if a corrected result, 0 if not "RTN","LR7OB63",10,0) ;See ^LR7OB69 for description of LRX array "RTN","LR7OB63",11,0) I $G(CONTROL)="ZC" Q "RTN","LR7OB63",12,0) N IFN "RTN","LR7OB63",13,0) I $L(SS),$L($T(@SS)) G @SS "RTN","LR7OB63",14,0) Q "RTN","LR7OB63",15,0) ; "RTN","LR7OB63",16,0) ; "RTN","LR7OB63",17,0) CH ;Chem, Hem, Tox, Ria, Ser, etc. "RTN","LR7OB63",18,0) N LRX,X0,Y1,Y2,Y3,Y4,Y5,Y6,Y12,Y14,Y15,Y16,Y17,Y18 "RTN","LR7OB63",19,0) Q:'$D(^LR(LRDFN,"CH",+$G(IVDT),0)) S X0=^(0) "RTN","LR7OB63",20,0) S Y6=$S(+$G(CORRECT):"C",$P(X0,"^",3):"F",1:"") "RTN","LR7OB63",21,0) S Y16=$P(X0,"^",6) "RTN","LR7OB63",22,0) S Y17=$$ORD^LR7OR2(LRDFN,IVDT),Y18=";CH;"_IVDT "RTN","LR7OB63",23,0) ; "RTN","LR7OB63",24,0) I '$D(SEX) N SEX S SEX=$P($G(@("^"_$P(LRDPF,"^",2)_+DFN_",0)")),"^",2) "RTN","LR7OB63",25,0) ; "RTN","LR7OB63",26,0) I '$D(DOB)!'$D(AGE) N AGE,DOB D "RTN","LR7OB63",27,0) . S DOB=$P($G(@("^"_$P(LRDPF,"^",2)_+DFN_",0)")),"^",3) "RTN","LR7OB63",28,0) . S AGE=$S($D(DT)&(DOB?7N):DT-DOB\10000,1:"??") "RTN","LR7OB63",29,0) ; "RTN","LR7OB63",30,0) S IFN=1 "RTN","LR7OB63",31,0) F S IFN=$O(^LR(LRDFN,"CH",IVDT,IFN)) Q:IFN<1 S X=^(IFN) I $D(TSTY(IFN))!($D(BYPASS)),$S('$D(LRSB):1,$D(LRSB(IFN)):1,1:0) D "RTN","LR7OB63",32,0) . I $D(LRSB(IFN)),$D(LRSA(IFN)),'$D(LRSA(IFN,2)) Q ;Only re-transmit changed results "RTN","LR7OB63",33,0) . S Y1=IFN,Y1=$O(^LAB(60,"C","CH;"_Y1_";1",0)),Y2=$P(X,"^"),Y3=$P(X,"^",2),Y12=$P(X,"^",4) "RTN","LR7OB63",34,0) . S:Y2="pending" Y6="P" ;Set result status to P for pending results "RTN","LR7OB63",35,0) . Q:"IN"[$P(^LAB(60,Y1,0),"^",3) S Y15=$P($G(^LAB(60,Y1,.1)),"^") "RTN","LR7OB63",36,0) . S (Y9,Y10,Y11,Y14)="" "RTN","LR7OB63",37,0) . I $P($G(^LAB(60,Y1,64)),"^") S Y9=$P(^(64),"^"),Y9=$P(^LAM(Y9,0),"^",2),Y10=$P(^(0),"^"),Y11="99NLT" "RTN","LR7OB63",38,0) . ;D UNIT(Y1,$P(X0,"^",5),SEX,DOB,AGE) "RTN","LR7OB63",39,0) . S LRX=$$TSTRES^LRRPU(LRDFN,"CH",IVDT,IFN,Y1) "RTN","LR7OB63",40,0) . S Y2=$P(LRX,"^"),Y3=$P(LRX,"^",2),Y4=$P(LRX,"^",5),Y5=$$EN^LRLRRVF($P(LRX,"^",3),$P(LRX,"^",4)) "RTN","LR7OB63",41,0) . I $P(LRX,"^",7) S Y14="T" "RTN","LR7OB63",42,0) . S Y2=$$TRIM^XLFSTR($$RESULT(Y1,Y2),"LR"," ") "RTN","LR7OB63",43,0) . S ^TMP("LRX",$J,69,CTR,63,IFN)=Y1_"^"_Y2_"^"_Y3_"^"_Y4_"^"_Y5_"^"_Y6_"^^^"_Y9_"^"_Y10_"^"_Y11_"^"_Y12_"^^"_Y14_"^"_Y15_"^"_Y16_"^"_Y17_"^"_Y18 "RTN","LR7OB63",44,0) ; "RTN","LR7OB63",45,0) I $D(GOTCOM(LRDFN,"CH",IVDT)) Q "RTN","LR7OB63",46,0) S GOTCOM(LRDFN,"CH",IVDT)="",IFN=0 "RTN","LR7OB63",47,0) F S IFN=$O(^LR(LRDFN,"CH",IVDT,1,IFN)) Q:IFN<1 S ^TMP("LRX",$J,69,CTR,63,"N",IFN)=$P(^LR(LRDFN,"CH",IVDT,1,IFN,0),"^") "RTN","LR7OB63",48,0) ; "RTN","LR7OB63",49,0) Q "RTN","LR7OB63",50,0) ; "RTN","LR7OB63",51,0) ; "RTN","LR7OB63",52,0) MI ;Microbiology "RTN","LR7OB63",53,0) D MI^LR7OB63A() "RTN","LR7OB63",54,0) Q "RTN","LR7OB63",55,0) ; "RTN","LR7OB63",56,0) ; "RTN","LR7OB63",57,0) BB ;Blood bank "RTN","LR7OB63",58,0) D BB1() "RTN","LR7OB63",59,0) Q "RTN","LR7OB63",60,0) ; "RTN","LR7OB63",61,0) ; "RTN","LR7OB63",62,0) BB1(SPECMEN) ;Blood bank "RTN","LR7OB63",63,0) ;SPECMEN=ptr to 61, to specify specimen (optional) "RTN","LR7OB63",64,0) N X0,Y1,Y2,Y3,Y4,Y5,Y6,Y15,Y18,Y19,CTR1 "RTN","LR7OB63",65,0) Q:'$D(^LR(LRDFN,"BB",+$G(IVDT),0)) S X0=^(0),Y6=$S(+$G(CORRECT):"C",$P(X0,"^",3):"F",1:""),Y19=$P(X0,"^",5),CTR1=0,Y18=";BB;"_IVDT "RTN","LR7OB63",66,0) ;There are other multiples for blood bank in file 63 that also need to be processed, this is just a start. "RTN","LR7OB63",67,0) I $G(SPECMEN),Y19'=SPECMEN Q "RTN","LR7OB63",68,0) S IFN=1 F S IFN=$O(^LR(LRDFN,"BB",IVDT,IFN)) Q:IFN<1 I $D(^(IFN))#2 S XNODE=^(IFN) F IFN1=1:1:$L(XNODE,"^") S X1=$P(XNODE,"^",IFN1) I $L(X1) D "RTN","LR7OB63",69,0) . S X=$$NODEPIK(63.01,IFN,IFN1,X1) ;X=field^data "RTN","LR7OB63",70,0) . I $L($P(X,"^")) S CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=X_"^^^^"_Y6_"^^^^^^^^^"_X_"^^^"_Y18_"^"_Y19 "RTN","LR7OB63",71,0) I $D(^LR(LRDFN,"BB",IVDT,99)) S Y1="Specimen Comment: " S IFN=0 F S IFN=$O(^LR(LRDFN,"BB",IVDT,99,IFN)) Q:IFN<1 S Y2=^(IFN,0),^TMP("LRX",$J,69,CTR,63,"N",IFN)=Y1_"^"_Y2 "RTN","LR7OB63",72,0) Q "RTN","LR7OB63",73,0) ; "RTN","LR7OB63",74,0) ; "RTN","LR7OB63",75,0) EM ;Electron Microscopy "RTN","LR7OB63",76,0) D SS^LR7OB63C("EM") "RTN","LR7OB63",77,0) Q "RTN","LR7OB63",78,0) ; "RTN","LR7OB63",79,0) ; "RTN","LR7OB63",80,0) SP ;Surgical Pathology "RTN","LR7OB63",81,0) D SS^LR7OB63C("SP") "RTN","LR7OB63",82,0) Q "RTN","LR7OB63",83,0) ; "RTN","LR7OB63",84,0) ; "RTN","LR7OB63",85,0) CY ;Cytology "RTN","LR7OB63",86,0) D SS^LR7OB63C("CY") "RTN","LR7OB63",87,0) Q "RTN","LR7OB63",88,0) ; "RTN","LR7OB63",89,0) ; "RTN","LR7OB63",90,0) AU ;Autopsy "RTN","LR7OB63",91,0) D AU^LR7OB63D "RTN","LR7OB63",92,0) Q "RTN","LR7OB63",93,0) ; "RTN","LR7OB63",94,0) ; "RTN","LR7OB63",95,0) NODEPIK(FILE,NODE,PIECE,DATA) ;Set field name and data into X "RTN","LR7OB63",96,0) N Z,Y,Y1,Y2 "RTN","LR7OB63",97,0) S Z=$O(^DD(FILE,"GL",NODE,PIECE,0)),X="" "RTN","LR7OB63",98,0) I Z S Y=^DD(FILE,Z,0),Y1=$P(Y,"^"),Y2=DATA S:$P(Y,"^",2)["S" Y2=$$SET(FILE,Z,Y2) S:$P(Y,"^",2)["P"!($P(Y,"^",2)["V") Y2=$$POINTER(FILE,Z,Y2) S X=Y1_"^"_Y2 "RTN","LR7OB63",99,0) Q X "RTN","LR7OB63",100,0) ; "RTN","LR7OB63",101,0) ; "RTN","LR7OB63",102,0) UNIT(X,SPEC,SEX,DOB,AGE) ;Find units and ref range "RTN","LR7OB63",103,0) ;X=Result "RTN","LR7OB63",104,0) ;SPEC=Specimen ptr "RTN","LR7OB63",105,0) ;SEX=Patient sex "RTN","LR7OB63",106,0) ;DOB=Patient Date of birth "RTN","LR7OB63",107,0) ;AGE=Patient age "RTN","LR7OB63",108,0) ;Output: Y4=Units, Y5=Ref Range, Y14=T or "" (If T, range is theraputic) "RTN","LR7OB63",109,0) N LO,HI "RTN","LR7OB63",110,0) S (Y4,Y5,Y14)="" "RTN","LR7OB63",111,0) Q:'$D(^LAB(60,+X,1,+SPEC,0)) S X=^(0) ;No units/ranges defined "RTN","LR7OB63",112,0) S Y4=$P(X,"^",7) "RTN","LR7OB63",113,0) S @("LO="_$S($L($P(X,"^",2)):$P(X,"^",2),$L($P(X,"^",11)):$P(X,"^",11),1:"""""")) "RTN","LR7OB63",114,0) S @("HI="_$S($L($P(X,"^",3)):$P(X,"^",3),$L($P(X,"^",12)):$P(X,"^",12),1:"""""")) "RTN","LR7OB63",115,0) S Y5=$S($L(HI):LO_"-"_HI,1:LO) "RTN","LR7OB63",116,0) S Y14=$S('$L($P(X,"^",2))&$L($P(X,"^",11)):"T",1:"") "RTN","LR7OB63",117,0) Q "RTN","LR7OB63",118,0) ; "RTN","LR7OB63",119,0) ; "RTN","LR7OB63",120,0) RESULT(TEST,RESULT) ;Convert result to external format "RTN","LR7OB63",121,0) ;TEST=Test ptr to file 60 "RTN","LR7OB63",122,0) ;RESULT=Test result "RTN","LR7OB63",123,0) N X,X1,LRCW "RTN","LR7OB63",124,0) S LRCW="",X1=$P($G(^LAB(60,TEST,.1)),"^",3),X1=$S($L(X1):X1,1:"$J(X,8)"),X=RESULT,@("X="_X1) "RTN","LR7OB63",125,0) Q X "RTN","LR7OB63",126,0) ; "RTN","LR7OB63",127,0) ; "RTN","LR7OB63",128,0) STRIP(TEXT) ;Strips white space from text "RTN","LR7OB63",129,0) N I,X "RTN","LR7OB63",130,0) S X="" F I=1:1:$L(TEXT," ") S:$A($P(TEXT," ",I))>0 X=X_$P(TEXT," ",I) "RTN","LR7OB63",131,0) Q X "RTN","LR7OB63",132,0) ; "RTN","LR7OB63",133,0) ; "RTN","LR7OB63",134,0) SET(FILE,FIELD,RESULT) ;Interpret set of codes "RTN","LR7OB63",135,0) S X=$P(^DD(FILE,FIELD,0),"^",3),X=$P($P(";"_X,";"_RESULT_":",2),";") "RTN","LR7OB63",136,0) Q X "RTN","LR7OB63",137,0) ; "RTN","LR7OB63",138,0) ; "RTN","LR7OB63",139,0) POINTER(FILE,FIELD,RESULT) ;Interpret pointer values "RTN","LR7OB63",140,0) N X "RTN","LR7OB63",141,0) S X=$P(^DD(FILE,FIELD,0),"^",2) "RTN","LR7OB63",142,0) I X["V" S X1=@("^"_$P(RESULT,";",2)_+RESULT_",0)") "RTN","LR7OB63",143,0) I X'["V" S X1=$P(@("^"_$P(^DD(FILE,FIELD,0),"^",3)_RESULT_",0)"),"^") "RTN","LR7OB63",144,0) Q X1 "RTN","LR7OGMC") 0^5^B9381223^B10197738 "RTN","LR7OGMC",1,0) LR7OGMC ;DALOI/STAFF- Interim report rpc memo chem ; Aug 16, 2004 "RTN","LR7OGMC",2,0) ;;5.2;LAB SERVICE;**187,230,312,286,356,372**;Sep 27, 1994;Build 11 "RTN","LR7OGMC",3,0) ; "RTN","LR7OGMC",4,0) ; sets lab data into ^TMP("LR7OG",$J,"TP" "RTN","LR7OGMC",5,0) ; ^TMP("LR7OG",$J,"G")=dfn^pnm^lrdfn^age^sex^lrcw "RTN","LR7OGMC",6,0) ; ^TMP("LR7OG",$J,"TMP",test subscript in data)=zero node of test "RTN","LR7OGMC",7,0) ; ^TMP("LR7OG",$J,"TP",collect date/time)=zero node from data "RTN","LR7OGMC",8,0) ; ^TMP("LR7OG",$J,"TP",collect date/time,printorder)=test#^name^printname^^printcode^dataname^result^flag^units^range^performing site "RTN","LR7OGMC",9,0) ; ^TMP("LR7OG",$J,"TP",collect date/time,printorder,#)=interpretation "RTN","LR7OGMC",10,0) ; ^TMP("LR7OG",$J,"TP",collect date/time,"C",#)=comment "RTN","LR7OGMC",11,0) ; "RTN","LR7OGMC",12,0) ; "RTN","LR7OGMC",13,0) CH(LRDFN,IDT,ALL,OUTCNT,FORMAT,DONE) ; from LR7OGM "RTN","LR7OGMC",14,0) N CDT,CHSUB,CMNT,INTP,LABSUB,PNODE,PORDER,SPEC,TCNT,TESTNUM,TESTSUB,ZERO "RTN","LR7OGMC",15,0) S ZERO=$G(^LR(LRDFN,"CH",IDT,0)) "RTN","LR7OGMC",16,0) I '$P(ZERO,U,3) Q "RTN","LR7OGMC",17,0) S CDT=+ZERO,LABSUB="CH",TCNT=0,SPEC=$P(ZERO,U,5) "RTN","LR7OGMC",18,0) S CHSUB=1 "RTN","LR7OGMC",19,0) F S CHSUB=$O(^LR(LRDFN,"CH",IDT,CHSUB)) Q:CHSUB="" I ALL!$D(^TMP("LR7OG",$J,"TMP",CHSUB)) D Q "RTN","LR7OGMC",20,0) . I FORMAT D "RTN","LR7OGMC",21,0) .. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="0^CH^"_(9999999-IDT) "RTN","LR7OGMC",22,0) .. S OUTCNT=OUTCNT+1 "RTN","LR7OGMC",23,0) .. S DONE=1 "RTN","LR7OGMC",24,0) . K ^TMP("LR7OG",$J,"TP") "RTN","LR7OGMC",25,0) . I ALL S TESTSUB=1 F S TESTSUB=$O(^LR(LRDFN,"CH",IDT,TESTSUB)) Q:TESTSUB<1 S TESTNUM=$O(^LAB(60,"C","CH;"_TESTSUB_";1",0)) D CHSETUP "RTN","LR7OGMC",26,0) . I 'ALL S TESTSUB=1 F S TESTSUB=$O(^TMP("LR7OG",$J,"TMP",TESTSUB)) Q:TESTSUB<1 S TESTNUM=+^(TESTSUB) D CHSETUP "RTN","LR7OGMC",27,0) . I TCNT D "RTN","LR7OGMC",28,0) .. S ^TMP("LR7OG",$J,"TP",CDT)=ZERO,CMNT=0 "RTN","LR7OGMC",29,0) .. F S CMNT=+$O(^LR(LRDFN,LABSUB,IDT,1,CMNT)) Q:CMNT<1 S ^TMP("LR7OG",$J,"TP",CDT,"C",CMNT)=^(CMNT,0) S TCNT=TCNT+1 "RTN","LR7OGMC",30,0) . I FORMAT D GRID^LR7OGMG(.OUTCNT) "RTN","LR7OGMC",31,0) . I 'FORMAT D PRINT^LR7OGMP(.OUTCNT) "RTN","LR7OGMC",32,0) . K ^TMP("LR7OG",$J,"TP") "RTN","LR7OGMC",33,0) Q "RTN","LR7OGMC",34,0) ; "RTN","LR7OGMC",35,0) ; "RTN","LR7OGMC",36,0) CHSETUP ; within scope of CH "RTN","LR7OGMC",37,0) ; "RTN","LR7OGMC",38,0) N LRX "RTN","LR7OGMC",39,0) I 'TESTNUM Q "RTN","LR7OGMC",40,0) Q:'$D(^LAB(60,TESTNUM,.1)) S PNODE=^(.1) I '("BO"[$P($G(^(0)),U,3)) Q "RTN","LR7OGMC",41,0) Q:'$D(^LR(LRDFN,LABSUB,IDT,TESTSUB)) Q:'$L($P(^(TESTSUB),U)) "RTN","LR7OGMC",42,0) ; "RTN","LR7OGMC",43,0) S PORDER=$P(PNODE,U,6),PORDER=$S(PORDER:PORDER,1:TESTSUB/1000000) "RTN","LR7OGMC",44,0) F Q:'$D(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q:TESTNUM=+^(PORDER) S PORDER=PORDER+1 "RTN","LR7OGMC",45,0) ; "RTN","LR7OGMC",46,0) I $D(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q "RTN","LR7OGMC",47,0) ; "RTN","LR7OGMC",48,0) S LRX=$$TSTRES^LRRPU(LRDFN,LABSUB,IDT,TESTSUB,TESTNUM) "RTN","LR7OGMC",49,0) S ^TMP("LR7OG",$J,"TP",CDT,PORDER)=TESTNUM_U_$P(^LAB(60,TESTNUM,0),U)_U_$P(PNODE,U)_U_$P(PNODE,U,2)_U_$P(PNODE,U,3)_U_$P(^(0),U,5)_U_$P(LRX,U)_U_$P(LRX,U,2)_U_$P(LRX,U,5)_U_$$EN^LRLRRVF($P(LRX,U,3),$P(LRX,U,4))_U_$P(LRX,U,6) "RTN","LR7OGMC",50,0) ; "RTN","LR7OGMC",51,0) ; Save performing lab ien in list "RTN","LR7OGMC",52,0) I $P(LRX,U,6) S ^TMP("LRPLS",$J,$P(LRX,U,6))="" "RTN","LR7OGMC",53,0) ; "RTN","LR7OGMC",54,0) S TCNT=TCNT+1 "RTN","LR7OGMC",55,0) I $D(^LAB(60,TESTNUM,1,SPEC,1,0)) D "RTN","LR7OGMC",56,0) . S INTP=0 "RTN","LR7OGMC",57,0) . F S INTP=+$O(^LAB(60,TESTNUM,1,SPEC,1,INTP)) Q:INTP<1 D "RTN","LR7OGMC",58,0) . . S ^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP)=^(INTP,0) "RTN","LR7OGMC",59,0) . . S TCNT=TCNT+1 "RTN","LR7OGMC",60,0) Q "RTN","LR7OR2") 0^3^B17036514^B17139954 "RTN","LR7OR2",1,0) LR7OR2 ;DALOI/dcm - Get Lab results (cont.) ;8/11/97 "RTN","LR7OR2",2,0) ;;5.2;LAB SERVICE;**121,187,219,285,286,372**;Sep 27, 1994;Build 11 "RTN","LR7OR2",3,0) ; "RTN","LR7OR2",4,0) ; "RTN","LR7OR2",5,0) CH(SDATE,EDATE,TEST,COUNT,SPEC,UNVER) ;Get CH subscript data "RTN","LR7OR2",6,0) Q:'$D(SDATE) Q:'$D(EDATE) Q:'$D(COUNT) Q:'$D(CT1) "RTN","LR7OR2",7,0) N GOTIT,IVDT,ITST,IST,TSTY,X,X0,ORD,Y6,Y12,Y16,Y19 "RTN","LR7OR2",8,0) I $G(TEST) Q:'$D(^LAB(60,TEST,0)) S X=^(0) Q:$P(X,"^",4)'="CH" D "RTN","LR7OR2",9,0) . I $L($P(X,"^",5)) S TSTY($P($P(X,"^",5),";",2))=TEST "RTN","LR7OR2",10,0) . I '$L($P(X,"^",5)) D EN^LR7OU1(TEST) "RTN","LR7OR2",11,0) S IVDT=SDATE "RTN","LR7OR2",12,0) F S IVDT=$O(^LR(LRDFN,"CH",IVDT)) Q:IVDT<1!(IVDT>EDATE)!(CT1>COUNT) D "RTN","LR7OR2",13,0) . S X0=^LR(LRDFN,"CH",IVDT,0),Y6=$S($P(X0,"^",3):"F",1:"P"),Y12=$P(X0,"^",4),Y19=$P(X0,"^",5),Y16=$P(X0,"^",6),ORD=$$ORD(LRDFN,IVDT) "RTN","LR7OR2",14,0) . S GOTIT=0 "RTN","LR7OR2",15,0) . I '$G(UNVER),Y6="P" Q ;Unverified data not requested "RTN","LR7OR2",16,0) . I $G(SPEC),Y19'=SPEC Q ;Specimen specified "RTN","LR7OR2",17,0) . I '$D(TSTY) S ITST=1 F S ITST=$O(^LR(LRDFN,"CH",IVDT,ITST)) Q:ITST<1 S X=^(ITST) D SETTST(ITST,X) "RTN","LR7OR2",18,0) . S IST=0 F S IST=$O(TSTY(IST)) Q:IST<1 I $D(^LR(LRDFN,"CH",IVDT,IST)) S X=^(IST) D SETTST(IST,X) "RTN","LR7OR2",19,0) . I $O(^TMP("LRRR",$J,DFN,"CH",IVDT,0)) D NOTE(LRDFN,IVDT) "RTN","LR7OR2",20,0) . I GOTIT S CT1=CT1+1 "RTN","LR7OR2",21,0) Q "RTN","LR7OR2",22,0) ; "RTN","LR7OR2",23,0) ; "RTN","LR7OR2",24,0) SETTST(ISUB,ZERO) ;Set test data in ^TMP "RTN","LR7OR2",25,0) ;ISUB= test subscript "RTN","LR7OR2",26,0) ;ZERO= 0th node at ^LR(LRDFN,"CH",IVDT,TST) "RTN","LR7OR2",27,0) N LRX,X,Y,Y1,Y2,Y3,Y4,Y5,Y9,Y10,Y11,Y14 "RTN","LR7OR2",28,0) S X=ZERO,Y1=ISUB,Y1=$O(^LAB(60,"C","CH;"_Y1_";1",0)),Y2=$P(X,"^"),Y3=$P(X,"^",2) "RTN","LR7OR2",29,0) Q:'Y1 Q:"IN"[$P(^LAB(60,Y1,0),"^",3) S Y15=$P($G(^LAB(60,Y1,.1)),"^") "RTN","LR7OR2",30,0) S (Y9,Y10,Y11,Y14)="" "RTN","LR7OR2",31,0) I $P($G(^LAB(60,Y1,64)),"^") S Y9=$P(^(64),"^"),Y9=$P(^LAM(Y9,0),"^",2),Y10=$P(^(0),"^"),Y11="99NLT" "RTN","LR7OR2",32,0) ;D UNIT^LR7OB63(Y1,$P(X0,"^",5),SEX,DOB,AGE) "RTN","LR7OR2",33,0) S LRX=$$TSTRES^LRRPU(LRDFN,"CH",IVDT,ISUB,Y1) "RTN","LR7OR2",34,0) S Y2=$P(LRX,"^"),Y3=$P(LRX,"^",2),Y4=$P(LRX,"^",5),Y5=$$EN^LRLRRVF($P(LRX,"^",3),$P(LRX,"^",4)) "RTN","LR7OR2",35,0) I $P(LRX,"^",7) S Y14="T" "RTN","LR7OR2",36,0) S Y2=$$TRIM^XLFSTR($$RESULT^LR7OB63(Y1,Y2),"RL"," ") "RTN","LR7OR2",37,0) S ^TMP("LRRR",$J,DFN,"CH",IVDT,ISUB)=Y1_"^"_Y2_"^"_Y3_"^"_Y4_"^"_Y5_"^"_Y6_"^^^"_Y9_"^"_Y10_"^"_Y11_"^"_Y12_"^^"_Y14_"^"_Y15_"^"_Y16_"^"_$G(ORD)_"^^"_Y19 "RTN","LR7OR2",38,0) S GOTIT=1 "RTN","LR7OR2",39,0) Q "RTN","LR7OR2",40,0) ; "RTN","LR7OR2",41,0) ; "RTN","LR7OR2",42,0) NOTE(LRDFN,IVDT) ;Get comments "RTN","LR7OR2",43,0) N IFN "RTN","LR7OR2",44,0) S IFN=0 F S IFN=$O(^LR(LRDFN,"CH",IVDT,1,IFN)) Q:IFN<1 S X=^(IFN,0),^TMP("LRRR",$J,DFN,"CH",IVDT,"N",IFN)=X "RTN","LR7OR2",45,0) Q "RTN","LR7OR2",46,0) ; "RTN","LR7OR2",47,0) ; "RTN","LR7OR2",48,0) TEST(Y,DFN,ORD,SDATE,EDATE,SUB,TEST,FLAG,COUNT) ;Test network calls "RTN","LR7OR2",49,0) ;Called from TIU "RTN","LR7OR2",50,0) ;COUNT = count of results to send, results with the same date/time "RTN","LR7OR2",51,0) ; count as 1 "RTN","LR7OR2",52,0) N IVDT,SSUB,SEQ,CTR "RTN","LR7OR2",53,0) Q:'$G(DFN) "RTN","LR7OR2",54,0) D RR^LR7OR1(DFN,$G(ORD),$G(SDATE),$G(EDATE),$G(SUB),$G(TEST),$G(FLAG),$G(COUNT)) "RTN","LR7OR2",55,0) I '$D(^TMP("LRRR",$J)) S Y(1)="No Lab Data" Q "RTN","LR7OR2",56,0) S CTR=0,SSUB="",COUNT=$S($G(COUNT):COUNT,1:9999999) "RTN","LR7OR2",57,0) F S SSUB=$O(^TMP("LRRR",$J,DFN,SSUB)) Q:SSUB="" S IVDT=0 F S IVDT=$O(^TMP("LRRR",$J,DFN,SSUB,IVDT)) Q:IVDT<1 S SEQ=0 F S SEQ=$O(^TMP("LRRR",$J,DFN,SSUB,IVDT,SEQ)) Q:SEQ<1 D "RTN","LR7OR2",58,0) . S CTR=CTR+1,^TMP("LRAPI",$J,CTR)=9999999-IVDT_"^"_SSUB_"^"_^TMP("LRRR",$J,DFN,SSUB,IVDT,SEQ) "RTN","LR7OR2",59,0) S Y=$NA(^TMP("LRAPI",$J)) "RTN","LR7OR2",60,0) Q "RTN","LR7OR2",61,0) ; "RTN","LR7OR2",62,0) ; "RTN","LR7OR2",63,0) T60(Y,IFN) ;Get tests from file 60 "RTN","LR7OR2",64,0) ;If IFN is not passed then the whole file is sent. "RTN","LR7OR2",65,0) N CTR S CTR=0 "RTN","LR7OR2",66,0) I $D(IFN) Q:'$D(^LAB(60,IFN,0)) S Y(1)=IFN_"^"_$P(^LAB(60,IFN,0),"^") Q "RTN","LR7OR2",67,0) S NAME="" F S NAME=$O(^LAB(60,"B",NAME)) Q:NAME="" S IFN=0 F S IFN=$O(^LAB(60,"B",NAME,IFN)) Q:IFN<1 I $D(^LAB(60,IFN,0)) S CTR=CTR+1,Y(CTR)=IFN_"^"_NAME "RTN","LR7OR2",68,0) Q "RTN","LR7OR2",69,0) ; "RTN","LR7OR2",70,0) ; "RTN","LR7OR2",71,0) T64(Y,IFN) ;Get tests from file 64 "RTN","LR7OR2",72,0) ;If IFN is not passed then the whole file is sent, if entry has a link to file 60 "RTN","LR7OR2",73,0) N CTR S CTR=0 "RTN","LR7OR2",74,0) I $D(IFN) Q:'$D(^LAM(IFN,0)) Q:'$D(^LAB(60,"AC",IFN)) S Y(1)=IFN_"^"_$P(^LAM(IFN,0),"^") Q "RTN","LR7OR2",75,0) S NAME="" F S NAME=$O(^LAM("B",NAME)) Q:NAME="" S IFN=0 F S IFN=$O(^LAM("B",NAME,IFN)) Q:IFN<1 I $D(^LAM(IFN,0)),$D(^LAB(60,"AC",IFN)) S CTR=CTR+1,Y(CTR)=IFN_"^"_NAME "RTN","LR7OR2",76,0) Q "RTN","LR7OR2",77,0) ; "RTN","LR7OR2",78,0) ; "RTN","LR7OR2",79,0) ORD(LRDFN,IVDT) ;Get order # for entry in file 63 "RTN","LR7OR2",80,0) ;LRDFN=Lab Patient # "RTN","LR7OR2",81,0) ;IVDT=Inverse Date/time in 63 (^LR(LRDFN,"CH",IVDT)) "RTN","LR7OR2",82,0) Q:'$G(LRDFN) Q:'$G(IVDT) "RTN","LR7OR2",83,0) N X0,X6,X,AC,ACD,ACN "RTN","LR7OR2",84,0) S X0=$G(^LR(LRDFN,"CH",IVDT,0)),X6=$P(X0,"^",6) I '$L(X6) Q "" "RTN","LR7OR2",85,0) S X=$P(X6," "),X=$O(^LRO(68,"B",X,0)) I 'X Q "" "RTN","LR7OR2",86,0) S AC=X,ACD=+$P(X0,"."),ACN=$P(X6," ",3) I '$D(^LRO(68,AC,1,ACD,1,ACN,0)) Q "" "RTN","LR7OR2",87,0) S X=$P($G(^LRO(68,AC,1,ACD,1,ACN,.1)),"^") "RTN","LR7OR2",88,0) Q X "RTN","LR7OSUM5") 0^6^B33173238^B34508107 "RTN","LR7OSUM5",1,0) LR7OSUM5 ;slc/dcm - Silent Patient cum cont. ;8/11/97 "RTN","LR7OSUM5",2,0) ;;5.2;LAB SERVICE;**121,187,228,241,250,251,256,356,372**;Sep 27, 1994;Build 11 "RTN","LR7OSUM5",3,0) TS ;from LR7OSUM3 "RTN","LR7OSUM5",4,0) N A,B,I,J,LRII,LRCTR,LRFALT,LRCL,LRCW,LRTLOC,X,XZ,Z "RTN","LR7OSUM5",5,0) I LRACT'=0 S X="",$P(X,"=",GIOM)="" D LN S ^TMP("LRC",$J,GCNT,0)=X "RTN","LR7OSUM5",6,0) S I=0,LRII=0 "RTN","LR7OSUM5",7,0) F S LRII=$O(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRII)) Q:LRII<1 S I=I+1,I(I)=LRII "RTN","LR7OSUM5",8,0) S LRFALT=0,LRCTR=0,LRACT=LRACT+1,J=LRJS+1,LRCL=20 "RTN","LR7OSUM5",9,0) I J'>LRSHD D LINE^LR7OSUM4,LN S ^TMP("LRC",$J,GCNT,0)="",^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,LRTOPP)_$$S^LR7OS(LRCL,CCNT,"") "RTN","LR7OSUM5",10,0) F I=J:1:LRSHD S Z=^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),LRCW=$P(Z,U,2) Q:(GIOM-LRCL)LRLFDT LRLFDT=LRFDT "RTN","LR7OSUM5",34,0) GOUT ; "RTN","LR7OSUM5",35,0) D QRS "RTN","LR7OSUM5",36,0) I LRCTR>LRLNS&(LRACT'LRLNS&(LRACT1 D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,"") "RTN","LR7OSUM5",63,0) . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,X) "RTN","LR7OSUM5",64,0) Q "RTN","LR7OSUM5",65,0) LRLO ;from LR7OSUM4 "RTN","LR7OSUM5",66,0) S @("LRLO="_$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,2)):$P(^(I(I)),U,2),$L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,11)):$P(^(I(I)),U,11),1:"""""")) "RTN","LR7OSUM5",67,0) LRHI S @("LRHI="_$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,3)):$P(^(I(I)),U,3),$L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,12)):$P(^(I(I)),U,12),1:"""""")),P7=$P(^(I(I)),U,7) "RTN","LR7OSUM5",68,0) S LRLOHI=$$EN^LRLRRVF(LRLO,LRHI) "RTN","LR7OSUM5",69,0) Q "RTN","LR7OSUM5",70,0) TXT1 ;from LR7OSUM3, LR7OSUM4 "RTN","LR7OSUM5",71,0) S XZ="",$P(XZ,"=",GIOM)="" "RTN","LR7OSUM5",72,0) Q:'$D(LRTM(0)) "RTN","LR7OSUM5",73,0) N C6,I,L "RTN","LR7OSUM5",74,0) S C6=0 "RTN","LR7OSUM5",75,0) F S C6=$O(^TMP($J,"TM",C6)) Q:C6<1 S X=^(C6) D "RTN","LR7OSUM5",76,0) . D LN "RTN","LR7OSUM5",77,0) . S I=$S($L($P(X,"^"))>1:2,1:3),^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(I,CCNT,$P(X,U)_". "),L(0)=0,L=0 D "RTN","LR7OSUM5",78,0) . F S L=$O(^TMP($J,"TM",C6,L)) Q:L<1 S X=^(L),L(0)=L(0)+1 D "RTN","LR7OSUM5",79,0) .. I L(0)>1 D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(6,CCNT,"") "RTN","LR7OSUM5",80,0) .. S ^(0)=^TMP("LRC",$J,GCNT,0)_X "RTN","LR7OSUM5",81,0) Q "RTN","LR7OSUM5",82,0) C(X,X1) ; "RTN","LR7OSUM5",83,0) N X2 "RTN","LR7OSUM5",84,0) S X1=" "_$P(X,U,2),X=$P(X,U,1) "RTN","LR7OSUM5",85,0) I $L($P(LRG,U,4)) S LRCW=LRCW-3 Q "RTN","LR7OSUM5",86,0) I "<>"[$E(X,1),$E(X,2,$L(X))?.N.P1N S X2=$E(X,1),X=$E(X,2,$L(X)) "RTN","LR7OSUM5",87,0) S LRCW(1)=LRCW-3 "RTN","LR7OSUM5",88,0) I X?.N.P1N!(LRDP="")!(X?.N1".".N) S X=$S(LRDP="":$J(X,LRCW(1)),1:$J(X,LRCW(1),LRDP)) D C2(.X,.X2) "RTN","LR7OSUM5",89,0) Q "RTN","LR7OSUM5",90,0) C1(X,X1) ;from LR7OSUM4 "RTN","LR7OSUM5",91,0) S LRCW=$S('$L(X1):7,1:10),X1=$S($L(X1)=1:" "_X1_" ",$L(X1)=0:X1,1:" "_X1) "RTN","LR7OSUM5",92,0) I $L($P(LRG,U,4)) S LRCW=7 Q "RTN","LR7OSUM5",93,0) S X=$S($L(X1):X_X1,1:X) "RTN","LR7OSUM5",94,0) Q "RTN","LR7OSUM5",95,0) C2(X,X2) ; "RTN","LR7OSUM5",96,0) Q:'$D(X2) "RTN","LR7OSUM5",97,0) Q:'$D(X) "RTN","LR7OSUM5",98,0) N X3 "RTN","LR7OSUM5",99,0) F X3=1:1:$L(X) I $E(X,X3)'=" " S X=$E(X,1,X3-2)_X2_$E(X,X3,$L(X)) Q "RTN","LR7OSUM5",100,0) Q "RTN","LR7OSUM5",101,0) TS1 ;Print low therapeutic or reference range values "RTN","LR7OSUM5",102,0) F I=J:1:LRJS S LRCW=$P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2),LRCL=LRCL+LRCW D "RTN","LR7OSUM5",103,0) . S @("LRLO="_$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,2)):$P(^(I(I)),U,2),$L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,11)):$P(^(I(I)),U,11),1:"""""")) "RTN","LR7OSUM5",104,0) . S A=$L(LRLO)\2,B=LRCW\2 "RTN","LR7OSUM5",105,0) . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$J(LRLO,(A+B))),^(0)=^(0)_$$S^LR7OS(LRCL,CCNT,"") "RTN","LR7OSUM5",106,0) Q "RTN","LR7OSUM5",107,0) TS2 ;Print high therapeutic or reference range values "RTN","LR7OSUM5",108,0) F I=J:1:LRJS S LRCW=$P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2),LRCL=LRCL+LRCW D "RTN","LR7OSUM5",109,0) . S @("LRHI="_$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,3)):$P(^(I(I)),U,3),$L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,12)):$P(^(I(I)),U,12),1:"""""")),P7=$P(^(I(I)),U,7) "RTN","LR7OSUM5",110,0) . S A=$L(LRHI)\2,B=LRCW\2 "RTN","LR7OSUM5",111,0) . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$J(LRHI,(A+B))),^(0)=^(0)_$$S^LR7OS(LRCL,CCNT,"") "RTN","LR7OSUM5",112,0) Q "RTN","LR7OSUM5",113,0) TS3 ;Print units "RTN","LR7OSUM5",114,0) S LRCW=$P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2) "RTN","LR7OSUM5",115,0) Q:(GIOM-LRCL)0 S LRDATA=^(LRPO) D DATA Q:LRSTOP "RTN","LRRP1",43,0) Q:LRSTOP "RTN","LRRP1",44,0) ; "RTN","LRRP1",45,0) I $D(^TMP("LR",$J,"TP",LRAAO,LRCDT,"C")) D "RTN","LRRP1",46,0) . W !,"Comment: " S LRCMNT=0 "RTN","LRRP1",47,0) . F S LRCMNT=+$O(^TMP("LR",$J,"TP",LRAAO,LRCDT,"C",LRCMNT)) Q:LRCMNT<1 D Q:LRSTOP "RTN","LRRP1",48,0) . . W ^TMP("LR",$J,"TP",LRAAO,LRCDT,"C",LRCMNT) "RTN","LRRP1",49,0) . . D CONT Q:LRSTOP "RTN","LRRP1",50,0) . . W:$O(^TMP("LR",$J,"TP",LRAAO,LRCDT,"C",LRCMNT)) !?9 "RTN","LRRP1",51,0) Q:LRSTOP D EQUALS^LRX "RTN","LRRP1",52,0) W !?7,"KEY: ""L""=Abnormal low, ""H""=Abnormal high, ""*""=Critical value" "RTN","LRRP1",53,0) S LRFOOT=1 "RTN","LRRP1",54,0) Q "RTN","LRRP1",55,0) ; "RTN","LRRP1",56,0) ; "RTN","LRRP1",57,0) DATA ; "RTN","LRRP1",58,0) N LR63DATA "RTN","LRRP1",59,0) ; "RTN","LRRP1",60,0) S LRTSTS=+LRDATA,LRPC=$P(LRDATA,U,5),LRSUB=$P(LRDATA,U,6) "RTN","LRRP1",61,0) S X=$P(LRDATA,U,7) Q:X="" "RTN","LRRP1",62,0) S LR63DATA=$$TSTRES^LRRPU(LRDFN,LRSS,LRIDT,$P(LRDATA,U,10),LRTSTS) "RTN","LRRP1",63,0) S LRLO=$P(LR63DATA,"^",3),LRHI=$P(LR63DATA,"^",4),LRREFS=$$EN^LRLRRVF(LRLO,LRHI),LRPLS=$P(LR63DATA,"^",6),LRTHER=$P(LR63DATA,"^",7) "RTN","LRRP1",64,0) I LRPLS S LRPLS(LRPLS)=LRPLS "RTN","LRRP1",65,0) ; "RTN","LRRP1",66,0) W !?5,$S($L($P(LRDATA,U,2))>20:$P(LRDATA,U,3),1:$P(LRDATA,U,2)) "RTN","LRRP1",67,0) S X=$P(LR63DATA,"^") "RTN","LRRP1",68,0) W ?27,@$S(LRPC="":"$J(X,LRCW)",1:LRPC)," ",$P(LR63DATA,"^",2) "RTN","LRRP1",69,0) I $X>39 W ! "RTN","LRRP1",70,0) W ?40,$P(LR63DATA,U,5) "RTN","LRRP1",71,0) I $X>50 W ! "RTN","LRRP1",72,0) W ?51,LRREFS K LRREFS "RTN","LRRP1",73,0) ; "RTN","LRRP1",74,0) I LRPLS'="" D "RTN","LRRP1",75,0) . I $X>67 W ! "RTN","LRRP1",76,0) . W ?68,"[",LRPLS,"]" "RTN","LRRP1",77,0) D CONT Q:LRSTOP "RTN","LRRP1",78,0) ; "RTN","LRRP1",79,0) I $O(^TMP("LR",$J,"TP",LRAAO,LRCDT,LRPO,0))>0 D Q:LRSTOP "RTN","LRRP1",80,0) . S LRINTP=0 "RTN","LRRP1",81,0) . F S LRINTP=+$O(^TMP("LR",$J,"TP",LRAAO,LRCDT,LRPO,LRINTP)) Q:LRINTP<1 W !?7,"Eval: ",^(LRINTP) D CONT Q:LRSTOP "RTN","LRRP1",82,0) ; "RTN","LRRP1",83,0) Q "RTN","LRRP1",84,0) ; "RTN","LRRP1",85,0) ; "RTN","LRRP1",86,0) CHECK I LRTC+11>(IOSL-$Y) D FOOT Q:LRSTOP D HDR "RTN","LRRP1",87,0) Q "RTN","LRRP1",88,0) ; "RTN","LRRP1",89,0) ; "RTN","LRRP1",90,0) CONT I $Y+5>IOSL D FOOT Q:LRSTOP D HDR W !?20,">> CONTINUATION OF ",$P(LR0,U,6)," <<",! "RTN","LRRP1",91,0) Q "RTN","LRRP1",92,0) FOOT ;from LRRP, LRRP2, LRRP3 "RTN","LRRP1",93,0) Q:LRSTOP F I=$Y:1:IOSL-4 W ! "RTN","LRRP1",94,0) I $E(IOST,1,2)'="C-" W !,PNM,?40," ",SSN," ",$$HTE^XLFDT($H,"M"),! Q "RTN","LRRP1",95,0) W !,PNM,?25," ",SSN," ",$$HTE^XLFDT($H,"MP"),?59," PRESS '^' TO STOP " "RTN","LRRP1",96,0) R X:DTIME S:X="" X=1 S:(".^"[X)!('$T) LRSTOP=1 "RTN","LRRP1",97,0) Q "RTN","LRRP1",98,0) ; "RTN","LRRP1",99,0) ; "RTN","LRRP1",100,0) HDR ; Add Printed at, page #, change age to dob 7/2002 cka "RTN","LRRP1",101,0) W:($G(LRJ02))!($G(LRJ0))!($E(IOST,1,2)="C-") @IOF "RTN","LRRP1",102,0) S LRHF=0,LRJ02=1 "RTN","LRRP1",103,0) I '$D(LRPG) S LRPG=0 "RTN","LRRP1",104,0) S LRPG=LRPG+1 "RTN","LRRP1",105,0) I $E(IOST,1)="P" D "RTN","LRRP1",106,0) .W !!!! "RTN","LRRP1",107,0) .S X="CLINICAL LABORATORY REPORT" "RTN","LRRP1",108,0) .W ?(80-$L(X)\2),X,! "RTN","LRRP1",109,0) I $D(DUZ("AG")),$L(DUZ("AG")),"ARMYAFN"[DUZ("AG") D ^LRAIPRIV W ! "RTN","LRRP1",110,0) W "Printed at: ",?65,"page ",LRPG "RTN","LRRP1",111,0) W !,$$NAME^XUAF4(DUZ(2))," (",DUZ(2),")" "RTN","LRRP1",112,0) S X=$$PADD^XUAF4(DUZ(2)) "RTN","LRRP1",113,0) W !,$P(X,U)," ",$P(X,U,2),", ",$P(X,U,3)," ",$P(X,U,4) "RTN","LRRP1",114,0) W !!,PNM,?44,"Report date: ",$$HTE^XLFDT($H,"M") "RTN","LRRP1",115,0) W !?5,"SSN: ",SSN," SEX: ",SEX," DOB: ",$$FMTE^XLFDT(DOB)," LOC: ",LROC "RTN","LRRP1",116,0) Q "RTN","LRRP1",117,0) ; "RTN","LRRP1",118,0) ORU ; Display remote ordering info if available "RTN","LRRP1",119,0) N LRX,IENS "RTN","LRRP1",120,0) S LRX=$G(^LR(LRDFN,"CH",LRIDT,"ORU")),IENS=LRIDT_","_LRDFN_"," "RTN","LRRP1",121,0) D EN^DDIOL("Accession [UID]: "_$P(LR0,"^",6)_" ["_$P(LRX,"^")_"]","","!") "RTN","LRRP1",122,0) I $P(LRX,"^",3) D "RTN","LRRP1",123,0) . D EN^DDIOL("Ordering Site: "_$$GET1^DIQ(63.04,IENS,.33,""),"","!?2") "RTN","LRRP1",124,0) . D EN^DDIOL(" Ordering Site UID: "_$P(LRX,"^",5),"","?43") "RTN","LRRP1",125,0) I $P(LRX,"^",2) D EN^DDIOL("Collecting Site: "_$$GET1^DIQ(63.04,IENS,.32,""),"","!") "RTN","LRRP1",126,0) Q "VER") 8.0^22.0 "BLD",7387,6) ^300 **END** **END**