Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRCAPR2

LRCAPR2.m

Go to the documentation of this file.
  1. LRCAPR2 ;DALOI/PAC/FHS/JBM - WKLD REP GENERATOR-BUILD ;10/11/92 01:55
  1. ;;5.2;LAB SERVICE;**88,105,263,264,396**;Sep 27, 1994;Build 3
  1. ; Reference to ^DIC(4 Supported by Reference #10090
  1. ; Reference to ^SC( Supported by Reference #10040
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. K ^TMP("LR",$J) D DATE,^LRCAPR3
  1. K LRLDIV,LRDIV
  1. Q
  1. DATE ;
  1. N LRNOP,ACCTRNS,LRNTDAT
  1. I LRTO<LRFR S X=LRFR,LRFR=LRTO,LRTO=X
  1. S LRTO=LRTO_".99999"
  1. S ACCTRNS=$P(^LRO(68,LRAA,0),U,3)
  1. I ACCTRNS="D" S LRST=LRFR-.000001
  1. I ACCTRNS="Y" S LRST=$E(LRFR,1,3)_"0000"-.001
  1. I ACCTRNS="M"!(ACCTRNS="Q") S LRST=$E(LRFR,1,5)_"00"-.001
  1. F S LRST=$O(^LRO(68,LRAA,1,LRST)) Q:'LRST!(LRST>LRTO) D
  1. . S LRNT=0
  1. . F S LRNT=$O(^LRO(68,LRAA,1,LRST,1,LRNT)) Q:'LRNT D
  1. . . Q:'$D(^LRO(68,LRAA,1,LRST,1,LRNT,0))#2 S LRNTDAT=+$P($G(^(3)),U,3)
  1. . . I LRNTDAT,LRNTDAT'>LRTO,LRNTDAT'<LRFR D ACC
  1. Q
  1. ACC ;
  1. S LRACCREC=$G(^LRO(68,LRAA,1,LRST,1,LRNT,0)) Q:LRACCREC="" D
  1. . S LRDIV=+$P($G(^(.3)),U,2)
  1. S LRFIL=+$P(LRACCREC,U,2) Q:'LRFIL Q:(LRFIL>67.3)&(LRFIL<67.9999)
  1. S LRLTYP=$P(LRACCREC,U,11)
  1. S LRPATOK=$$CHKPAT(LRIOPAT,LRLTYP,LRFIL) Q:'+LRPATOK
  1. S LRPTYP=$E(LRPATOK,2)
  1. S LRLC=+$P(LRACCREC,U,13)
  1. ACC1 D Q:$G(LRNOP)
  1. . S LRNOP=1
  1. . I '$G(LRLOC),'$G(LRLDIV) S LRNOP=0 Q
  1. . I $G(LRDIV),'$G(LRLDIV) S LRNOP=0 Q
  1. . I $G(LRDIV),$G(LRLDIV),$D(LRLDIV(LRDIV)) S LRNOP=0 Q
  1. . I '$G(LRLC),'$G(LRLOC),$G(LRFIL)=62.3 S LRNOP=0 Q
  1. . I $G(LRLC),'$G(LRLOC) S LRNOP=0 Q
  1. . I $G(LRLC),$G(LRLOC),$D(LRLOC(LRLC)) S LRNOP=0
  1. . I $G(LRCNTL) S LRNOP=0
  1. D
  1. . I 'LRLC S LRLC="*MISSING LOC* ["_LRFIL_"]" Q
  1. . I +LRLC S LRLC=$P($G(^SC(+LRLC,0)),U) I $L(LRLC) S LRLC=LRLC_" ["_LRFIL_"]"
  1. . I LRLDIV,LRDIV,$D(^DIC(4,LRDIV,0))#2 S LRLC=$P(^(0),U)_" ["_LRFIL_"]" Q
  1. S LRAANO=$S($D(^LRO(68,LRAA,1,LRST,1,LRNT,.2)):^(.2),1:"NO ACCN")
  1. S LRSTCS=$G(^LRO(68,LRAA,1,LRST,1,LRNT,5,1,0)) Q:'LRSTCS
  1. I LRSP Q:'$P(LRSTCS,U) Q:'$D(LRSP($P(LRSTCS,U)))
  1. I LRCOL Q:'$P(LRSTCS,U,2) Q:'$D(LRCOL($P(LRSTCS,U,2)))
  1. S LRTST=0
  1. F S LRTST=$O(^LRO(68,LRAA,1,LRST,1,LRNT,4,LRTST)) Q:'LRTST D TEST
  1. Q
  1. TEST ;
  1. I LRTSTS,'$D(LRTSTS(LRTST)) Q
  1. Q:'$D(^LRO(68,LRAA,1,LRST,1,LRNT,4,LRTST,0))#2 S LRNX=^(0) Q:'$P(LRNX,U,5)
  1. S LRNX5=$P(LRNX,U,5),LRNX5D=$P(LRNX5,"."),LRURG=$P(LRNX,U,2)
  1. I $G(LRSTAT) Q:LRURG="" Q:'$D(LRSTAT(LRURG))#2
  1. S LRURGNAM=$S(LRURG="":"",$D(LRSTAT(LRURG))#2:LRSTAT(LRURG),1:"")
  1. S LRTEST=$$TST(LRTST)
  1. S LRNX5=$S($L(LRTOV,".")=1:$P(LRNX5,"."),1:LRNX5)
  1. S LRCPN=0 D LRCC
  1. Q
  1. LRCC ;
  1. S LRCPN=$O(^LRO(68,LRAA,1,LRST,1,LRNT,4,LRTST,1,LRCPN)) Q:'LRCPN S LRNODE=$G(^(LRCPN,0)) G:'LRNODE LRCC
  1. I LRSITSEL,'$D(LRSITSEL(+$P(LRNODE,U,8))) G LRCC
  1. I LRCAPS,'$D(LRCAPS(+LRNODE)) G LRCC
  1. S LRCAPNAM=$$WKLDNAME^LRCAPU(+LRNODE)
  1. I (LRRTYP=2)&('LRCAPFLG) G LRCC
  1. I (LRRTYP=3)&(LRCAPFLG) G LRCC
  1. S:(LRCAPFLG)&($E(LRTEST)'="+") LRTEST="+"_LRTEST
  1. S LRCP=LRCAPNUM G:'LRCP LRCC
  1. S LRDOT="."_$P(LRCP,".",2)
  1. S LRTESTCP=$E(LRTEST_" ",1,8)_" ["_LRCP_"]"
  1. I LRCPSX,'$D(LRCPSX(LRDOT)) G LRCC
  1. S LRMACN=+$O(^LAB(64.2,"F",LRDOT,0))
  1. S LRMAC=$S($L($G(^LAB(64.2,LRMACN,0))):$P(^(0),U),1:"ERROR"_LRMACN)
  1. S:'$D(^TMP("LR",$J,"TST/TOT")) ^("TST/TOT")=0 S ^("TST/TOT")=^("TST/TOT")+1
  1. S:'$D(^TMP("LR",$J,"TST",LRTEST)) ^(LRTEST)=0 S ^(LRTEST)=^(LRTEST)+1
  1. S:'$D(^TMP("LR",$J,"TST",LRTEST,LRLC)) ^(LRLC)=0 S ^(LRLC)=^(LRLC)+1
  1. S:'$D(^TMP("LR",$J,"TST",LRTEST,LRLC,LRCP)) ^(LRCP)=0 S ^(LRCP)=^(LRCP)+1,J=^(LRCP)
  1. S ^TMP("LR",$J,"TST",LRTEST,LRLC,LRCP,LRAANO,(J+1))=LRNX5_U_LRMAC_U_LRURGNAM
  1. S:'$D(^TMP("LR",$J,"TST/LOC",LRLC)) ^(LRLC)=0 S ^(LRLC)=^(LRLC)+1
  1. S:'$D(^TMP("LR",$J,"TST/LRM",LRMAC)) ^(LRMAC)=0 S ^(LRMAC)=^(LRMAC)+1
  1. S:'$D(^TMP("LR",$J,"TST/LRM",LRMAC,LRTESTCP)) ^(LRTESTCP)=0 S ^(LRTESTCP)=^(LRTESTCP)+1
  1. I $G(LRCTL),$G(LRCNTL) D
  1. . S:'$D(^TMP("LR",$J,"TST/CTL",LRMAC)) ^(LRMAC)=0 S ^(LRMAC)=^(LRMAC)+1
  1. . S:'$D(^TMP("LR",$J,"TST/CTL",LRMAC,LRTESTCP)) ^(LRTESTCP)=0 S ^(LRTESTCP)=^(LRTESTCP)+1
  1. I LRURGNAM'="" D
  1. . S:'$D(^TMP("LR",$J,"TST/URG",LRPTYP,LRURGNAM)) ^(LRURGNAM)=0 S ^(LRURGNAM)=^(LRURGNAM)+1
  1. . S:'$D(^TMP("LR",$J,"TST/URG",LRPTYP,LRURGNAM,LRTEST)) ^(LRTEST)=0 S ^(LRTEST)=^(LRTEST)+1
  1. . S:'$D(^TMP("LR",$J,"TST/URG","A",LRURGNAM)) ^(LRURGNAM)=0 S ^(LRURGNAM)=^(LRURGNAM)+1
  1. . S:'$D(^TMP("LR",$J,"TST/URG","A",LRURGNAM,LRTEST)) ^(LRTEST)=0 S ^(LRTEST)=^(LRTEST)+1
  1. S:'$D(^TMP("LR",$J,"DATE",LRNX5D)) ^(LRNX5D)=0 S ^(LRNX5D)=^(LRNX5D)+1
  1. S:'$D(^TMP("LR",$J,"DATE",LRNX5D,LRTESTCP)) ^(LRTESTCP)=0 S ^(LRTESTCP)=^(LRTESTCP)+1
  1. S:'$D(^TMP("LR",$J,"DAY",LRNX5D)) ^(LRNX5D)=0 S ^(LRNX5D)=^(LRNX5D)+1
  1. S:'$D(^TMP("LR",$J,"DAY",LRNX5D,LRMAC)) ^(LRMAC)=0 S ^(LRMAC)=^(LRMAC)+1
  1. S:'$D(^TMP("LR",$J,"DAY",LRNX5D,LRMAC,LRTESTCP)) ^(LRTESTCP)=0 S ^(LRTESTCP)=^(LRTESTCP)+1,J=^(LRTESTCP)
  1. G LRCC
  1. Q
  1. TST(X) ; this returns the print test name otherwise the test name.
  1. N LRDA
  1. ;tests are truncated if greater than 7 chars long
  1. S LRDA=$G(X) Q:'LRDA "Unknown"
  1. Q:'$D(^LAB(60,LRDA,0))#2 "Unknown"
  1. Q:$P($G(^LAB(60,LRDA,.1)),U)'="" $P($G(^(.1)),U)
  1. Q $S($L($P(^LAB(60,LRDA,0),U))>7:$E($P(^LAB(60,LRDA,0),U),1,6)_"*",1:$P(^LAB(60,LRDA,0),U))
  1. CHKPAT(LRIOPAT,LRLTYP,LRFIL) ; return flag indicating if this record is for
  1. ; a patient type selected for this report and if so, what type.
  1. S LRCNTL=$S(LRFIL=62.3:1,1:0)
  1. ; I LRIOPAT["A" Q "1A" ;All Patients
  1. I ("ORW"[LRLTYP)&((LRFIL=2))&((LRIOPAT["I")) Q "1I" ; Inpatient
  1. I ("ORW"'[LRLTYP)&((LRFIL=2))&((LRIOPAT["O")) Q "1O" ; Outpatient
  1. I LRFIL'=2,LRIOPAT["R" Q "1R" ; Other
  1. Q 0