LR7OSUM.m

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