LR7OSUM ;slc/dcm - Silent Patient cum ;8/11/97
;;5.2T9;LR;**1018**;Nov 17, 2004
;;5.2;LAB SERVICE;**121,187,230,256**;Sep 27, 1994
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,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 EN^LR7OSBR
D EN^LR7OSAP ;Anatomic Path
Q
END D END^LRACM
Q
EN(Y,DFN,SDATE,EDATE,COUNT,GIOM,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)
;GIOM=Right margin - default 80 (optional)
;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),GIOM=$S($G(GIOM):GIOM,1:80)
I GIOM>240 S GIOM=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("LRC",$J),^TMP("LRT",$J),^TMP("LRH",$J)
Q
AP(DFN) ;Get just the AP results
Q:'$D(DFN)
N SUBHEAD,LRAU,LRV,LRZ,%I,E
K ^TMP("LRC",$J)
S SUBHEAD("CYTOPATHOLOGY")=""
S SUBHEAD("SURGICAL PATHOLOGY")=""
S SUBHEAD("EM")=""
S SUBHEAD("AUTOPSY")=""
D EN(.ZIP,DFN,,,,80,.SUBHEAD)
Q
LR7OSUM ;slc/dcm - Silent Patient cum ;8/11/97
+1 ;;5.2T9;LR;**1018**;Nov 17, 2004
+2 ;;5.2;LAB SERVICE;**121,187,230,256**;Sep 27, 1994
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
LRLLOC ;
+1 NEW GCNT,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 IF $SELECT('$DATA(SUBHEAD):1,1:$DATA(SUBHEAD("MICROBIOLOGY")))
DO MICRO^LR7OSUM1
+8 IF $SELECT('$DATA(SUBHEAD):1,1:$DATA(SUBHEAD("BLOOD BANK")))
DO EN^LR7OSBR
+9 ;Anatomic Path
DO EN^LR7OSAP
+10 QUIT
END DO END^LRACM
+1 QUIT
EN(Y,DFN,SDATE,EDATE,COUNT,GIOM,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 ;GIOM=Right margin - default 80 (optional)
+10 ;SUBHEAD=Array of subheaders from file 64.5, misc, micro & AP to show results. Null param = get all results
+11 IF '$GET(DFN)
QUIT
+12 SET LRDFN=$$LRDFN^LR7OR1(DFN)
+13 IF 'LRDFN
QUIT
+14 KILL ^TMP($JOB,"EVAL")
+15 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
+16 DO PT^LRX
+17 SET LRADM=$PIECE($GET(VAIN(7)),"^",2)
SET LRADX=$GET(VAIN(9))
SET CT1=0
+18 KILL VA,VADM,VAERR,VAIN
+19 DO DTRNG^LR7OR1
+20 SET COUNT=$SELECT($GET(COUNT):COUNT,1:9999999)
SET GIOM=$SELECT($GET(GIOM):GIOM,1:80)
+21 IF GIOM>240
SET GIOM=240
+22 SET (LRIN,LRIDT)=SDATE
SET LROUT=EDATE
SET LREND=0
+23 DO LRLLOC
DO END
+24 SET Y=$NAME(^TMP("LRC",$JOB))
+25 QUIT
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
GET64(Y) ;Get minor headers from file 64.5
+1 NEW I,J
+2 SET I=0
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,"^"))=""
+3 SET Y("MISCELLANEOUS TESTS")=""
+4 SET Y("MICROBIOLOGY")=""
+5 SET Y("BLOOD BANK")=""
+6 SET Y("CYTOPATHOLOGY")=""
+7 SET Y("SURGICAL PATHOLOGY")=""
+8 SET Y("EM")=""
+9 SET Y("AUTOPSY")=""
+10 SET Y=$NAME(Y)
+11 QUIT
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
CLEAN ;Clean up TMP globals
+1 KILL ^TMP("LRC",$JOB),^TMP("LRT",$JOB),^TMP("LRH",$JOB)
+2 QUIT
AP(DFN) ;Get just the AP results
+1 IF '$DATA(DFN)
QUIT
+2 NEW 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 DO EN(.ZIP,DFN,,,,80,.SUBHEAD)
+9 QUIT
