192 lines
6.6 KiB
Mathematica
192 lines
6.6 KiB
Mathematica
LRRP2 ;DALOI/RWF-INTERIM REPORT ;8/11/97
|
|
;;5.2;LAB SERVICE;**106,121,221,283,300**;Sep 27, 1994
|
|
;from option LRRP2
|
|
BEGIN D INIT K DIC S LRPRTPG=0 D ^LRDPA D:LRDFN>0 START G:LRDFN<0 END G BEGIN
|
|
END D ^LRRK
|
|
Q
|
|
CUM ;ENTRY POINT FOR CUMULATIVE OPTIONS- LRAC PT,LRAC 1 PAGE, LRAC MANUAL
|
|
S LRPRTPG=1
|
|
SUM ;ENTRY POINT FROM SUM^LRACM2- PRINT A FULL PATIENT SUMMARY
|
|
D INIT K DIC D ^LRDPA D:LRDFN>0 START G:LRDFN<0 END
|
|
Q
|
|
START I $O(^LR(LRDFN,0))="" W !,"NO LAB DATA ON THIS PATIENT!",$C(7) Q
|
|
S LRLAB=$S($D(LRLABKY):1,1:0)
|
|
I $D(LRCUM) S LRIDT=0,LREDT=9999999
|
|
E D
|
|
. S LREDT="T-7" D ^LRWU3 Q:LREND
|
|
. S LRIDT=9999999-LRSDT,LREDT=9999999-LREDT
|
|
I LREND Q
|
|
;
|
|
ASKPG I '$G(LRPRTPG) D
|
|
. S DIR(0)="Y",DIR("A")="Print address page",DIR("B")="NO",LRPRTPG=0
|
|
. D ^DIR K DIR
|
|
. I Y S LRPRTPG=1
|
|
S %ZIS="Q",ZTSAVE("DFN")="",ZTSAVE("LR*")="",ZTRTN="SDQ^LRRP2"
|
|
D IO^LRWU
|
|
Q
|
|
;
|
|
;
|
|
SDQ ; dequeued
|
|
S:$D(ZTQUEUED) ZTREQ="@" U IO D PT^LRX
|
|
F S LRCNIDT=+$O(^LR(LRDFN,"CH",LRIDT)),LRMNIDT=+$O(^LR(LRDFN,"MI",LRIDT)) Q:'LRCNIDT&'LRMNIDT D SWITCH Q:LREND!LRSTOP!(LRIDT>LREDT)
|
|
D FOOT^LRRP1
|
|
D:$G(LRPRTPG) PLSPG
|
|
Q
|
|
;
|
|
SWITCH I LRCNIDT=LRMNIDT S LRIDT=LRCNIDT Q:LRIDT>LREDT D CH,MI Q
|
|
I 'LRMNIDT S LRIDT=LRCNIDT Q:LRIDT>LREDT D CH Q
|
|
I 'LRCNIDT S LRIDT=LRMNIDT Q:LRIDT>LREDT D MI Q
|
|
I LRCNIDT<LRMNIDT S LRIDT=LRCNIDT Q:LRIDT>LREDT D CH Q
|
|
S LRIDT=LRMNIDT Q:LRIDT>LREDT D MI
|
|
Q
|
|
;
|
|
GENP W !!,"Too many tests! Will use alternate format. May show extra tests.",!
|
|
S LREDT="T-7" D ^LRWU3 Q:LREND S LRSDT=9999999-LRSDT,LREDT=9999999-LREDT
|
|
K ^TMP("LR",$J,"T"),LRORD,LRTSTS S ZTSAVE("^TMP(""LR"",$J,")="",ZTSAVE("DFN")="",ZTRTN="GDQ^LRRP2" D IO^LRWU
|
|
Q
|
|
;
|
|
GDQ ;dequeued
|
|
S:$D(ZTQUEUED) ZTREQ="@" U IO D PT^LRX
|
|
S LRSUB="" F S LRSUB=$O(^TMP("LR",$J,"TMP",LRSUB)) Q:LRSUB="" S X=+$P(LRSUB,";",2),^TMP("LR",$J,"T",X)=""
|
|
S LRIDT=LRSDT F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1!(LRIDT>LREDT) D GEN2 Q:LREND!LRSTOP
|
|
K ^TMP("LR",$J,"T"),^TMP("LR",$J,"TMP"),LRSDT,LREDT,LRTSTS,LRSUB,LRIDT
|
|
Q
|
|
;
|
|
GEN2 S LRTN=0 F S LRTN=$O(^LR(LRDFN,"CH",LRIDT,LRTN)) Q:LRTN<1 I $D(^TMP("LR",$J,"T",LRTN)) D CH Q
|
|
I '$P($G(^LR(LRDFN,"CH",LRIDT,0)),U,3),$O(^LR(LRDFN,"CH",LRIDT,1,0)) D Q:'$G(LRCAN) D CH
|
|
. S LRCAN=0 F S LRCAN=+$O(^LR(LRDFN,"CH",LRIDT,1,LRCAN)) Q:LRCAN<1 Q:$E($G(^(LRCAN,0)))="*"
|
|
Q
|
|
;
|
|
;
|
|
AIDQUE ;
|
|
D INIT
|
|
S LRLAB=$S($D(LRLABKY):1,1:0)
|
|
K ^TMP($J)
|
|
S LROCE=$S($D(LROC):LROC,1:""),LROC=$S(LROCE="":$O(^LAB(64.6,"AI","")),1:LROC)
|
|
D:LROC'="" AI2
|
|
F S LROC=$O(^LAB(64.6,"AI",LROC)) Q:LROC=""!($L(LROCE)&(LROC'=LROCE)) D AI2
|
|
S LROC="UNKNOWN" D AI2
|
|
;
|
|
PRT ; Print sorted data
|
|
U IO K VA D KVAR^VADPT S LREND=0
|
|
I $O(^TMP($J,0))="" D Q
|
|
. W !!?10,"No Interim report Patients to Print "
|
|
. W !?20,$$HTE^XLFDT($H),!!
|
|
. D QUIT
|
|
S LROC=""
|
|
F S LROC=$O(^TMP($J,LROC)) Q:LROC=""!($G(LREND)) D
|
|
. S LRPHY=""
|
|
. F S LRPHY=$O(^TMP($J,LROC,LRPHY)) Q:LRPHY=""!($G(LREND)) D
|
|
. . S LRSSN=""
|
|
. . F S LRSSN=$O(^TMP($J,LROC,LRPHY,LRSSN)) Q:LRSSN=""!($G(LREND)) D
|
|
. . . S LRDFN=0
|
|
. . . F S LRHF=1,LRDFN=$O(^TMP($J,LROC,LRPHY,LRSSN,LRDFN)) Q:LRDFN<1!($G(LREND)) D
|
|
. . . . S LRIDT=0
|
|
. . . . F S LRIDT=$O(^TMP($J,LROC,LRPHY,LRSSN,LRDFN,LRIDT)) Q:LRIDT<1!($G(LREND)) D
|
|
. . . . . S LRSS="",PNM=^(LRIDT),SSN=$P(PNM,U,2),AGE=$P(PNM,U,3),SEX=$P(PNM,U,4),PNM=$P(PNM,U),LRFOOT=0
|
|
. . . . . D:$D(^LR(LRDFN,"CH",LRIDT,0))#2 CH
|
|
. . . . . S LRFOOT=0
|
|
. . . . . I $D(^LR(LRDFN,"MI",LRIDT,0))#2 D
|
|
. . . . . . I $G(LRSS)="CH" D FOOT^LRRP1 D:$G(LRPRTPG) PLSPG
|
|
. . . . . . D MI
|
|
. . . . . I $G(LRSS)="CH" D FOOT^LRRP1 D:$G(LRPRTPG) PLSPG
|
|
D QUIT
|
|
Q
|
|
;
|
|
;
|
|
QUIT ;
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
D ^%ZISC,^LRRK
|
|
Q
|
|
;
|
|
;
|
|
AI2 ;
|
|
Q:'$L($G(LROC))
|
|
F LRDFN=0:0 S LRDFN=$O(^LRO(69,"AN",LROC,LRDFN)) Q:LRDFN<1 I $D(^LR(LRDFN,0))#2 D
|
|
. S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX Q:LREND
|
|
. I '$G(VAERR) D AI3
|
|
Q
|
|
AI3 ;
|
|
Q:$G(LREND) N LRCAN
|
|
S LRSSN=$P(PNM,",")_SSN(1)
|
|
F LRIDT=0:0 S LRIDT=$O(^LRO(69,"AN",LROC,LRDFN,LRIDT)) Q:LRIDT<1 D
|
|
. S LRND=$S($G(^LR(LRDFN,"CH",LRIDT,0)):^(0),$G(^LR(LRDFN,"MI",LRIDT,0)):^(0),1:"") D
|
|
. . I $G(^LR(LRDFN,"CH",LRIDT,0)) D
|
|
. . . I $O(^LR(LRDFN,"CH",LRIDT,1)),$P(LRND,U,3) D AI3SET Q ; Print verified results.
|
|
. . . I $O(^LR(LRDFN,"CH",LRIDT,1)) Q ; Don't print unverified results.
|
|
. . . S LRCAN=0 F S LRCAN=+$O(^LR(LRDFN,"CH",LRIDT,1,LRCAN)) Q:LRCAN<1 Q:($E(^(LRCAN,0))="*")
|
|
. . . I $G(LRCAN) D AI3SET ; Print if cancel comment and no unverified results.
|
|
. . I $P($G(^LR(LRDFN,"MI",LRIDT,0)),U,3) D
|
|
. . . S I=$O(^LR(LRDFN,"MI",LRIDT,0)) Q:I'=99 D AI3SET
|
|
Q
|
|
AI3SET S LRPHY=$P($G(^VA(200,+$P(LRND,U,10),0)),U) S:LRPHY="" LRPHY="UNKNOWN"
|
|
S ^TMP($J,LROC,LRPHY,LRSSN,LRDFN,LRIDT)=PNM_U_SSN_U_AGE_U_SEX
|
|
Q
|
|
CH ;Also used by DVBC Package
|
|
Q:'$G(^LR(LRDFN,"CH",LRIDT,0))
|
|
N LROC,LRCAN
|
|
K ^TMP("LR",$J,"TP"),LRTP S LR0=^LR(LRDFN,"CH",LRIDT,0)
|
|
Q:$O(^LR(LRDFN,"CH",LRIDT,1))&('$P(LR0,U,3))
|
|
I '$P(LR0,U,3),$O(^LR(LRDFN,"CH",LRIDT,1,0)) D Q:'$G(LRCAN)
|
|
. S LRCAN=0 F S LRCAN=+$O(^LR(LRDFN,"CH",LRIDT,1,LRCAN)) Q:LRCAN<1 Q:$E($G(^(LRCAN,0)))="*"
|
|
S LRCDT=+LR0,LRSS="CH",LROC=$P(LR0,U,11),LRAA="",LRAAO=1,LRTC=0,LRSPEC=$P(LR0,U,5)
|
|
D CH^LRRP
|
|
Q
|
|
MI ;Also used by DVBC package
|
|
S LRCDT=9999999-LRIDT,^TMP("LR",$J,"TP",1)="^MI",^(1,LRCDT)="",^(LRCDT,-1)="",LRSS="MI",LRH=1 D:LRFOOT FOOT^LRRP1 Q:LRSTOP D EN1^LRMIPC S LRHF=1,LRFOOT=0 K A,Z,LRH S:LREND LREND=0,LRSTOP=1
|
|
Q
|
|
;
|
|
INIT D EN^LRPARAM
|
|
S (LREND,LRSTOP,LRPG,LRFOOT)=0,LRCW=8,LRHF=1,(LRONESPC,LRONETST)=""
|
|
K LRPLS
|
|
Q
|
|
;
|
|
EN69 ;entry point for surgery pkg
|
|
D START,^LRRK
|
|
Q
|
|
GEN ;from LRGEN test overflow
|
|
S LRLAB=$S($D(LRLABKY):1,1:0) D INIT,GENP,^LRRK
|
|
Q
|
|
DS ;from LRRD, LRRS
|
|
D INIT S DFN=$P(^LR(LRDFN,0),U,3),LRDPF=$P(^(0),U,2) D SDQ
|
|
Q
|
|
;
|
|
;
|
|
AIDQ ;tasked from LRTASK DAILY INTERIM,LRTASK CUM
|
|
N LRLAB,LRH,LRWRDVEW,LRPRTPG
|
|
S (LRH,LRWRDVEW)="",LRPRTPG=1
|
|
D AIDQUE
|
|
K ^TMP($J)
|
|
Q
|
|
;
|
|
;
|
|
DQ ;tasked from LRVER3 thru LRTP for IMMEDIATE INTERIM REPORTING
|
|
S:$D(ZTQUEUED) ZTREQ="@" D INIT S LRLAB=0,LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX D CH D FOOT^LRRP1 D ^%ZISC
|
|
Q
|
|
;
|
|
OR ;OE/RR entry point
|
|
Q:'$D(ORVP) S KILL=1 I '$D(LRPARAM) D EN^LRPARAM S KILL=0
|
|
S (LREND,LRSTOP)=0,LRCW=8,LRHF=1,LRFOOT=0,(LRONESPC,LRONETST)=""
|
|
D DT^LRX K DIC,LRTP S LRTP=0,DFN=+ORVP,LRDPF=+$P(@("^"_$P(ORVP,";",2)_"0)"),"^",2)_"^"_$P(ORVP,";",2) D END^LRDPA Q:LRDFN<1
|
|
D START,^LRRK
|
|
I 'KILL K LRBLOOD,LRDT0,LRPARAM,LRPLASMA,LRSERUM,LRSB,LRTP,LRUNKNOW,LRURINE
|
|
K KILL
|
|
Q
|
|
;
|
|
;
|
|
PLSPG ;PRINT LAST PAGE WITH PERFORMING LAB SITE NAMES AND ADDRESSES
|
|
W @IOF
|
|
I $D(LRPG) D
|
|
.S LRPG=LRPG+1
|
|
.W !?65,"page ",LRPG
|
|
W !,PNM,?30,SSN,?50,$$FMTE^XLFDT($$NOW^XLFDT,"5FMPZ")
|
|
W !!,"PERFORMING LAB SITES"
|
|
W !!!!
|
|
S LRPLS=0
|
|
F S LRPLS=$O(LRPLS(LRPLS)) Q:LRPLS="" D
|
|
.W "[",LRPLS,"] ",$$NAME^XUAF4(LRPLS)," "
|
|
.S X=$$PADD^XUAF4(LRPLS)
|
|
.W $P(X,U)," ",$P(X,U,2),", ",$P(X,U,3)," ",$P(X,U,4)
|
|
.W !
|
|
Q
|