LR7OSUM ;DALOI/STAFF - Silent Patient cum ;11/19/09 18:15
;;5.2;LAB SERVICE;**121,187,230,256,350**;Sep 27, 1994;Build 230
;
;
DFN S LRIN=0,LRIDT=0,LREND=0,LROUT=9999999
K ZTRTN,DIC,X2
D ^LRDPA Q:Y<0
U IO
D LRLLOC,END
Q
;
;
LRLLOC ;
N GCNT,GIOM,GIOSL,CCNT,B,C,LRSB,VA,VA200,VAERR,W
S CCNT=1,GCNT=0,GIOSL=999999,LRLLOC=$S($L(LRWRD):LRWRD,$D(^LR(LRDFN,.1)):^(.1),1:"File Room"),SSN=" "_SSN_" "
S ^TMP($J,LRDFN,0)=PNM_U_SSN_U_AGE_U_LRDPF_U_DFN
I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("MISCELLANEOUS TESTS"))) S ^TMP($J,LRDFN,"MISC")="MISCELLANEOUS TESTS^"
D LRIDT^LR7OSUM1
D ^LR7OSUM3
;
I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("MICROBIOLOGY"))) D MICRO^LR7OSUM1
I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("BLOOD BANK"))) D
. N GIOM
. S GIOM=$G(LRGIOM)
. I GIOM="" S GIOM=80
. D EN^LR7OSBR
;
; Anatomic Path
D EN^LR7OSAP
Q
;
;
END ; Cleanup variables
D END^LRACM
D CLEAN
;
Q
;
;
EN(Y,DFN,SDATE,EDATE,COUNT,LRGIOM,SUBHEAD) ; Enter here to get silent lab results
; Results in "CH" subscript are stored in the Cumulative format
; Headers for each format are found in ^TMP("LRH",$J,name)=ln count
; Index for where tests are found in ^TMP("LRT",$J,print name)=header^line # of1st occurance. Entries without a header means that the test exists in the report, but no result.
; Formatted reports are found in ^TMP("LRC",$J,ifn)
; DFN = Patient
; SDATE = Start date to search for results (optional)
; EDATE = End date to search for results (optional)
; COUNT = Count of results to send (optional)
; LRGIOM = Right margin
; SUBHEAD = Array of subheaders from file 64.5, misc, micro & AP to show results. Null param = get all results
;
Q:'$G(DFN)
S LRDFN=$$LRDFN^LR7OR1(DFN)
Q:'LRDFN
K ^TMP($J,"EVAL")
N A,AGE,CT1,DIC,DOB,F,G,H,I,IFN,INC,J,K,LR,LRA,LRAA,LRABV,LRACT,LRADM,LRADX,LRCNT,LRCTN,LRDP,LREND,LRJ02,LRMD,LRMIT,LRN,LRNAME,LRPRAC,LRQ,LRRB,LRSAV,LRSPE,LRSPEM,LRTEST,LRTOP,LRTREA,LRUNKNOW,LRUNT,LRVAL,LRW,M,N,P,P7,S1,SP,T,X,X1,XZ,Y,Y1
D PT^LRX
S LRADM=$P($G(VAIN(7)),"^",2),LRADX=$G(VAIN(9)),CT1=0
K VA,VADM,VAERR,VAIN
D DTRNG^LR7OR1
S COUNT=$S($G(COUNT):COUNT,1:9999999)
I $G(LRGIOM)>240 S LRGIOM=240
S (LRIN,LRIDT)=SDATE,LROUT=EDATE,LREND=0
D LRLLOC,END
S Y=$NA(^TMP("LRC",$J))
Q
;
;
TEST ; Test the output
N IFN
S IFN=0 F S IFN=$O(^TMP("LRC",$J,IFN)) Q:IFN<1 W !,^(IFN,0)
Q
;
;
GET64(Y) ; Get minor headers from file 64.5
N I,J
S I=0
F S I=$O(^LAB(64.5,1,1,I)) Q:I<1 S J=0 F S J=$O(^LAB(64.5,1,1,I,1,J)) Q:J<1 S X=^(J,0),Y($P(X,"^"))=""
S Y("MISCELLANEOUS TESTS")=""
S Y("MICROBIOLOGY")=""
S Y("BLOOD BANK")=""
S Y("CYTOPATHOLOGY")=""
S Y("SURGICAL PATHOLOGY")=""
S Y("EM")=""
S Y("AUTOPSY")=""
S Y=$NA(Y)
Q
;
;
PT ; Test with a loop thru multiple patients
N X,DFN,PTN,PTNX
W !!,"How many patients: " R X:DTIME Q:X["^"
I X'?1N.N W !!,"Enter a number" G PT
S DFN=0,PTNX=X
F PTN=1:1:PTNX S DFN=$O(^DPT(DFN)) Q:DFN<1 I $D(^DPT(DFN,"LR")) K ^TMP("LRC",$J),^TMP("LRH",$J),^TMP("LRT",$J) D EN(.Y,DFN) W !!!!,"////////////////////"_$P(^DPT(DFN,0),"^")_" LRDFN:"_+^DPT(DFN,"LR")_"////////////////////",!! D TEST
Q
;
;
CLEAN ; Clean up TMP globals
K ^TMP("LRT",$J),^TMP("LRPLS",$J),^TMP("LRPLS-ADDR",$J),^TMP("LRCMTINDX",$J)
Q
;
;
AP(DFN) ; Get just the AP results
Q:'$D(DFN)
N GIOM,SUBHEAD,LRAU,LRV,LRZ,%I,E
K ^TMP("LRC",$J)
S SUBHEAD("CYTOPATHOLOGY")=""
S SUBHEAD("SURGICAL PATHOLOGY")=""
S SUBHEAD("EM")=""
S SUBHEAD("AUTOPSY")=""
S GIOM=$$GET^XPAR("USR^DIV^PKG","LR AP GUI REPORT RIGHT MARGIN",1,"Q")
I GIOM="" S GIOM=80
D EN(.ZIP,DFN,,,,GIOM,.SUBHEAD)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OSUM 3660 printed Dec 13, 2024@02:05:40 Page 2
LR7OSUM ;DALOI/STAFF - Silent Patient cum ;11/19/09 18:15
+1 ;;5.2;LAB SERVICE;**121,187,230,256,350**;Sep 27, 1994;Build 230
+2 ;
+3 ;
DFN SET LRIN=0
SET LRIDT=0
SET LREND=0
SET LROUT=9999999
+1 KILL ZTRTN,DIC,X2
+2 DO ^LRDPA
if Y<0
QUIT
+3 USE IO
+4 DO LRLLOC
DO END
+5 QUIT
+6 ;
+7 ;
LRLLOC ;
+1 NEW GCNT,GIOM,GIOSL,CCNT,B,C,LRSB,VA,VA200,VAERR,W
+2 SET CCNT=1
SET GCNT=0
SET GIOSL=999999
SET LRLLOC=$SELECT($LENGTH(LRWRD):LRWRD,$DATA(^LR(LRDFN,.1)):^(.1),1:"File Room")
SET SSN=" "_SSN_" "
+3 SET ^TMP($JOB,LRDFN,0)=PNM_U_SSN_U_AGE_U_LRDPF_U_DFN
+4 IF $SELECT('$DATA(SUBHEAD):1,1:$DATA(SUBHEAD("MISCELLANEOUS TESTS")))
SET ^TMP($JOB,LRDFN,"MISC")="MISCELLANEOUS TESTS^"
+5 DO LRIDT^LR7OSUM1
+6 DO ^LR7OSUM3
+7 ;
+8 IF $SELECT('$DATA(SUBHEAD):1,1:$DATA(SUBHEAD("MICROBIOLOGY")))
DO MICRO^LR7OSUM1
+9 IF $SELECT('$DATA(SUBHEAD):1,1:$DATA(SUBHEAD("BLOOD BANK")))
Begin DoDot:1
+10 NEW GIOM
+11 SET GIOM=$GET(LRGIOM)
+12 IF GIOM=""
SET GIOM=80
+13 DO EN^LR7OSBR
End DoDot:1
+14 ;
+15 ; Anatomic Path
+16 DO EN^LR7OSAP
+17 QUIT
+18 ;
+19 ;
END ; Cleanup variables
+1 DO END^LRACM
+2 DO CLEAN
+3 ;
+4 QUIT
+5 ;
+6 ;
EN(Y,DFN,SDATE,EDATE,COUNT,LRGIOM,SUBHEAD) ; Enter here to get silent lab results
+1 ; Results in "CH" subscript are stored in the Cumulative format
+2 ; Headers for each format are found in ^TMP("LRH",$J,name)=ln count
+3 ; Index for where tests are found in ^TMP("LRT",$J,print name)=header^line # of1st occurance. Entries without a header means that the test exists in the report, but no result.
+4 ; Formatted reports are found in ^TMP("LRC",$J,ifn)
+5 ; DFN = Patient
+6 ; SDATE = Start date to search for results (optional)
+7 ; EDATE = End date to search for results (optional)
+8 ; COUNT = Count of results to send (optional)
+9 ; LRGIOM = Right margin
+10 ; SUBHEAD = Array of subheaders from file 64.5, misc, micro & AP to show results. Null param = get all results
+11 ;
+12 if '$GET(DFN)
QUIT
+13 SET LRDFN=$$LRDFN^LR7OR1(DFN)
+14 if 'LRDFN
QUIT
+15 KILL ^TMP($JOB,"EVAL")
+16 NEW A,AGE,CT1,DIC,DOB,F,G,H,I,IFN,INC,J,K,LR,LRA,LRAA,LRABV,LRACT,LRADM,LRADX,LRCNT,LRCTN,LRDP,LREND,LRJ02,LRMD,LRMIT,LRN,LRNAME,LRPRAC,LRQ,LRRB,LRSAV,LRSPE,LRSPEM,LRTEST,LRTOP,LRTREA,LRUNKNOW,LRUNT,LRVAL,LRW,M,N,P,P7,S1,SP,T,X,X1,XZ,Y,Y1
+17 DO PT^LRX
+18 SET LRADM=$PIECE($GET(VAIN(7)),"^",2)
SET LRADX=$GET(VAIN(9))
SET CT1=0
+19 KILL VA,VADM,VAERR,VAIN
+20 DO DTRNG^LR7OR1
+21 SET COUNT=$SELECT($GET(COUNT):COUNT,1:9999999)
+22 IF $GET(LRGIOM)>240
SET LRGIOM=240
+23 SET (LRIN,LRIDT)=SDATE
SET LROUT=EDATE
SET LREND=0
+24 DO LRLLOC
DO END
+25 SET Y=$NAME(^TMP("LRC",$JOB))
+26 QUIT
+27 ;
+28 ;
TEST ; Test the output
+1 NEW IFN
+2 SET IFN=0
FOR
SET IFN=$ORDER(^TMP("LRC",$JOB,IFN))
if IFN<1
QUIT
WRITE !,^(IFN,0)
+3 QUIT
+4 ;
+5 ;
GET64(Y) ; Get minor headers from file 64.5
+1 NEW I,J
+2 SET I=0
+3 FOR
SET I=$ORDER(^LAB(64.5,1,1,I))
if I<1
QUIT
SET J=0
FOR
SET J=$ORDER(^LAB(64.5,1,1,I,1,J))
if J<1
QUIT
SET X=^(J,0)
SET Y($PIECE(X,"^"))=""
+4 SET Y("MISCELLANEOUS TESTS")=""
+5 SET Y("MICROBIOLOGY")=""
+6 SET Y("BLOOD BANK")=""
+7 SET Y("CYTOPATHOLOGY")=""
+8 SET Y("SURGICAL PATHOLOGY")=""
+9 SET Y("EM")=""
+10 SET Y("AUTOPSY")=""
+11 SET Y=$NAME(Y)
+12 QUIT
+13 ;
+14 ;
PT ; Test with a loop thru multiple patients
+1 NEW X,DFN,PTN,PTNX
+2 WRITE !!,"How many patients: "
READ X:DTIME
if X["^"
QUIT
+3 IF X'?1N.N
WRITE !!,"Enter a number"
GOTO PT
+4 SET DFN=0
SET PTNX=X
+5 FOR PTN=1:1:PTNX
SET DFN=$ORDER(^DPT(DFN))
if DFN<1
QUIT
IF $DATA(^DPT(DFN,"LR"))
KILL ^TMP("LRC",$JOB),^TMP("LRH",$JOB),^TMP("LRT",$JOB)
DO EN(.Y,DFN)
WRITE !!!!,"////////////////////"_$PIECE(^DPT(DFN,0),"^")_" LRDFN:"_+^DPT(DFN,"LR")_"////////////////////",!!
DO TEST
+6 QUIT
+7 ;
+8 ;
CLEAN ; Clean up TMP globals
+1 KILL ^TMP("LRT",$JOB),^TMP("LRPLS",$JOB),^TMP("LRPLS-ADDR",$JOB),^TMP("LRCMTINDX",$JOB)
+2 QUIT
+3 ;
+4 ;
AP(DFN) ; Get just the AP results
+1 if '$DATA(DFN)
QUIT
+2 NEW GIOM,SUBHEAD,LRAU,LRV,LRZ,%I,E
+3 KILL ^TMP("LRC",$JOB)
+4 SET SUBHEAD("CYTOPATHOLOGY")=""
+5 SET SUBHEAD("SURGICAL PATHOLOGY")=""
+6 SET SUBHEAD("EM")=""
+7 SET SUBHEAD("AUTOPSY")=""
+8 SET GIOM=$$GET^XPAR("USR^DIV^PKG","LR AP GUI REPORT RIGHT MARGIN",1,"Q")
+9 IF GIOM=""
SET GIOM=80
+10 DO EN(.ZIP,DFN,,,,GIOM,.SUBHEAD)
+11 QUIT
