- 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 Jan 18, 2025@03:06:24 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