- BLRLRRP2 ; IHS/DIR/AAB - INTERIM REPORT 10/24/91 09:58 ; [ 07/01/1998 9:18 AM ]
- ;;5.2;BLR;**1001,1003**;JUN 01, 1998
- ;;5.2;LAB SERVICE;**106**;Sep 27, 1994
- ;from option LRRP2
- BEGIN D INIT K DIC D ^LRDPA D:LRDFN>0 START G:LRDFN<0 END G BEGIN
- END D ^LRRK
- 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),LREDT="T-7" D ^LRWU3 Q:LREND S LRIDT=9999999-LRSDT,LREDT=9999999-LREDT
- S %ZIS="Q" S ZTSAVE("DFN")="",ZTRTN="SDQ^BLRLRRP2" 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 Q
- SWITCH ;I LRCNIDT=LRMNIDT S LRIDT=LRCNIDT Q:LRIDT>LREDT D CH,MI Q
- S LRMD=$G(LRMD) ;IHS/OIRM TUC/AAB
- 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^BLRLRRP2" 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) I $P(^LR(LRDFN,"CH",LRIDT,0),U,3) 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
- 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^BLRDPT S LREND=0
- I $O(^TMP($J,0))="" W !!?10,"No Interim report Patients to Print ",!?20,$$DTF^LRAFUNC1($$NOW^LRAFUNC1),!! G QUIT
- S LROC="" F S LROC=$O(^TMP($J,LROC)) Q:LROC=""!($G(LREND)) 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 D:$G(LRSS)="CH" FOOT^LRRP1
- . . . 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
- . . . . S LRSS="",PNM=^(LRIDT),HRCN=$P(PNM,U,2),AGE=$P(PNM,U,3),SEX=$P(PNM,U,4),PNM=$P(PNM,U),LRFOOT=0 ;IHS/ANMC/CLS 08/18/96
- . . . . D:$D(^LR(LRDFN,"CH",LRIDT,0))#2 CH
- . . . . S LRFOOT=0 I $D(^LR(LRDFN,"MI",LRIDT,0))#2 D:$G(LRSS)="CH" FOOT^LRRP1 D MI
- QUIT S:$D(ZTQUEUED) ZTREQ="@" W !! W:$E(IOST,1,2)="P-" @IOF 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)
- ;S LRSSN=$P(PNM,",")_SSN(1)
- S LRSSN=$P(PNM,",")_HRCN ;IHS/ANMC/CLS 08/18/96
- 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:"") I $P(LRND,U,3) D
- . . 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_HRCN_U_AGE_U_SEX ;IHS/ANMC/CLS 08/18/96
- Q
- CH ;Also used by DVBC Package
- N LROC
- ;K ^TMP("LR",$J,"TP"),LRTP S LR0=^LR(LRDFN,"CH",LRIDT,0) Q:'$P(LR0,U,3) S LRCDT=+LR0,LRSS="CH",LROC=$P(LR0,U,11),LRAA="",LRAAO=1,LRTC=0,LRSPEC=$P(LR0,U,5)
- K ^TMP("LR",$J,"TP"),LRTP S LR0=^LR(LRDFN,"CH",LRIDT,0) Q:'$P(LR0,U,3) ;IHS/OIRM TUC/AAB 1/21/98
- I LRSINGLE,LRMD="S" Q:LRPHY'=$E($P($G(^VA(200,+$P(LR0,U,10),0)),U),1,20) ;IHS/OIRM TUC/AAB 7/1/98
- S LRCDT=+LR0,LRSS="CH",LROC=$P(LR0,U,11),LRAA="",LRAAO=1,LRTC=0,LRSPEC=$P(LR0,U,5) ;IHS/OIRM TUC/AAB 1/21/98
- D CH^LRRP
- Q
- MI ;Also used by DVBC package
- ;S BLRPHYS=$P($G(^VA(200,+$P(^LR(LRDFN,"MI",LRIDT,0),U,7),0)),U) Q:'$D(LRPHY(BLRPHYS)) ;IHS/OIRM TUC/AAB 1/21/98 FIX FOR A MORE THAN ONE SELECTED PROVIDER
- I LRSINGLE,LRMD="S" Q:LRPHY'=$E($P($G(^VA(200,+$P(^LR(LRDFN,"MI",LRIDT,0),U,7),0)),U),1,20) ;IHS/DIR TUC/AAB 7/1/98
- 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 D:'$D(LRDT0) DT^LRX S (LREND,LRSTOP)=0,LRCW=8,LRHF=1,LRFOOT=0,(LRONESPC,LRONETST)="" ;IHS/ANMC/CLS 08/18/96 LRDT0 <undef>
- 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
- S LRLAB=0,LRH="",LRWRDVEW="" D INIT,AIDQUE K LRH S:$D(ZTQUEUED) ZTREQ="@" 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 W @IOF 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,LRORN,LRPARAM,LRPLASMA,LRSERUM,LRSB,LRTP,LRUNKNOW,LRURINE
- K KILL Q
- BLRLRRP2 ; IHS/DIR/AAB - INTERIM REPORT 10/24/91 09:58 ; [ 07/01/1998 9:18 AM ]
- +1 ;;5.2;BLR;**1001,1003**;JUN 01, 1998
- +2 ;;5.2;LAB SERVICE;**106**;Sep 27, 1994
- +3 ;from option LRRP2
- BEGIN DO INIT
- KILL DIC
- DO ^LRDPA
- IF LRDFN>0
- DO START
- IF LRDFN<0
- GOTO END
- GOTO BEGIN
- END DO ^LRRK
- +1 QUIT
- START IF $ORDER(^LR(LRDFN,0))=""
- WRITE !,"NO LAB DATA ON THIS PATIENT!",$CHAR(7)
- QUIT
- +1 SET LRLAB=$SELECT($DATA(LRLABKY):1,1:0)
- SET LREDT="T-7"
- DO ^LRWU3
- IF LREND
- QUIT
- SET LRIDT=9999999-LRSDT
- SET LREDT=9999999-LREDT
- +2 SET %ZIS="Q"
- SET ZTSAVE("DFN")=""
- SET ZTRTN="SDQ^BLRLRRP2"
- DO IO^LRWU
- +3 QUIT
- SDQ ;dequeued
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- USE IO
- DO PT^LRX
- +2 FOR
- SET LRCNIDT=+$ORDER(^LR(LRDFN,"CH",LRIDT))
- SET LRMNIDT=+$ORDER(^LR(LRDFN,"MI",LRIDT))
- IF 'LRCNIDT&'LRMNIDT
- QUIT
- DO SWITCH
- IF LREND!LRSTOP!(LRIDT>LREDT)
- QUIT
- +3 DO FOOT^LRRP1
- QUIT
- SWITCH ;I LRCNIDT=LRMNIDT S LRIDT=LRCNIDT Q:LRIDT>LREDT D CH,MI Q
- +1 ;IHS/OIRM TUC/AAB
- SET LRMD=$GET(LRMD)
- +2 IF LRCNIDT=LRMNIDT
- SET LRIDT=LRCNIDT
- IF LRIDT>LREDT
- QUIT
- DO CH
- DO MI
- QUIT
- +3 IF 'LRMNIDT
- SET LRIDT=LRCNIDT
- IF LRIDT>LREDT
- QUIT
- DO CH
- QUIT
- +4 IF 'LRCNIDT
- SET LRIDT=LRMNIDT
- IF LRIDT>LREDT
- QUIT
- DO MI
- QUIT
- +5 IF LRCNIDT<LRMNIDT
- SET LRIDT=LRCNIDT
- IF LRIDT>LREDT
- QUIT
- DO CH
- QUIT
- +6 SET LRIDT=LRMNIDT
- IF LRIDT>LREDT
- QUIT
- DO MI
- +7 QUIT
- GENP WRITE !!,"Too many tests! Will use alternate format. May show extra tests.",!
- +1 SET LREDT="T-7"
- DO ^LRWU3
- IF LREND
- QUIT
- SET LRSDT=9999999-LRSDT
- SET LREDT=9999999-LREDT
- +2 KILL ^TMP("LR",$JOB,"T"),LRORD,LRTSTS
- SET ZTSAVE("^TMP(""LR"",$J,")=""
- SET ZTSAVE("DFN")=""
- SET ZTRTN="GDQ^BLRLRRP2"
- DO IO^LRWU
- +3 QUIT
- GDQ ;dequeued
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- USE IO
- DO PT^LRX
- +2 SET LRSUB=""
- FOR
- SET LRSUB=$ORDER(^TMP("LR",$JOB,"TMP",LRSUB))
- IF LRSUB=""
- QUIT
- SET X=+$PIECE(LRSUB,";",2)
- SET ^TMP("LR",$JOB,"T",X)=""
- +3 SET LRIDT=LRSDT
- FOR
- SET LRIDT=$ORDER(^LR(LRDFN,"CH",LRIDT))
- IF LRIDT<1!(LRIDT>LREDT)
- QUIT
- IF $PIECE(^LR(LRDFN,"CH",LRIDT,0),U,3)
- DO GEN2
- IF LREND!LRSTOP
- QUIT
- +4 KILL ^TMP("LR",$JOB,"T"),^TMP("LR",$JOB,"TMP"),LRSDT,LREDT,LRTSTS,LRSUB,LRIDT
- +5 QUIT
- GEN2 SET LRTN=0
- FOR
- SET LRTN=$ORDER(^LR(LRDFN,"CH",LRIDT,LRTN))
- IF LRTN<1
- QUIT
- IF $DATA(^TMP("LR",$JOB,"T",LRTN))
- DO CH
- QUIT
- +1 QUIT
- AIDQUE DO INIT
- SET LRLAB=$SELECT($DATA(LRLABKY):1,1:0)
- +1 KILL ^TMP($JOB)
- +2 SET LROCE=$SELECT($DATA(LROC):LROC,1:"")
- SET LROC=$SELECT(LROCE="":$ORDER(^LAB(64.6,"AI","")),1:LROC)
- IF LROC'=""
- DO AI2
- FOR
- SET LROC=$ORDER(^LAB(64.6,"AI",LROC))
- IF LROC=""!($LENGTH(LROCE)&(LROC'=LROCE))
- QUIT
- DO AI2
- +3 SET LROC="UNKNOWN"
- DO AI2
- PRT ;Print sorted data
- +1 USE IO
- KILL VA
- DO KVAR^BLRDPT
- SET LREND=0
- +2 IF $ORDER(^TMP($JOB,0))=""
- WRITE !!?10,"No Interim report Patients to Print ",!?20,$$DTF^LRAFUNC1($$NOW^LRAFUNC1),!!
- GOTO QUIT
- +3 SET LROC=""
- FOR
- SET LROC=$ORDER(^TMP($JOB,LROC))
- IF LROC=""!($GET(LREND))
- QUIT
- SET LRPHY=""
- FOR
- SET LRPHY=$ORDER(^TMP($JOB,LROC,LRPHY))
- IF LRPHY=""!($GET(LREND))
- QUIT
- Begin DoDot:1
- +4 SET LRSSN=""
- FOR
- SET LRSSN=$ORDER(^TMP($JOB,LROC,LRPHY,LRSSN))
- IF LRSSN=""!($GET(LREND))
- QUIT
- Begin DoDot:2
- +5 SET LRDFN=0
- FOR
- SET LRHF=1
- SET LRDFN=$ORDER(^TMP($JOB,LROC,LRPHY,LRSSN,LRDFN))
- IF LRDFN<1!($GET(LREND))
- QUIT
- Begin DoDot:3
- +6 SET LRIDT=0
- FOR
- SET LRIDT=$ORDER(^TMP($JOB,LROC,LRPHY,LRSSN,LRDFN,LRIDT))
- IF LRIDT<1!($GET(LREND))
- QUIT
- Begin DoDot:4
- +7 ;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
- +8 ;IHS/ANMC/CLS 08/18/96
- SET LRSS=""
- SET PNM=^(LRIDT)
- SET HRCN=$PIECE(PNM,U,2)
- SET AGE=$PIECE(PNM,U,3)
- SET SEX=$PIECE(PNM,U,4)
- SET PNM=$PIECE(PNM,U)
- SET LRFOOT=0
- +9 IF $DATA(^LR(LRDFN,"CH",LRIDT,0))#2
- DO CH
- +10 SET LRFOOT=0
- IF $DATA(^LR(LRDFN,"MI",LRIDT,0))#2
- IF $GET(LRSS)="CH"
- DO FOOT^LRRP1
- DO MI
- End DoDot:4
- End DoDot:3
- IF $GET(LRSS)="CH"
- DO FOOT^LRRP1
- End DoDot:2
- End DoDot:1
- QUIT IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- WRITE !!
- IF $EXTRACT(IOST,1,2)="P-"
- WRITE @IOF
- DO ^%ZISC
- DO ^LRRK
- +1 QUIT
- AI2 ;
- +1 IF '$LENGTH($GET(LROC))
- QUIT
- +2 FOR LRDFN=0:0
- SET LRDFN=$ORDER(^LRO(69,"AN",LROC,LRDFN))
- IF LRDFN<1
- QUIT
- IF $DATA(^LR(LRDFN,0))#2
- Begin DoDot:1
- +3 SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
- SET DFN=$PIECE(^(0),U,3)
- DO PT^LRX
- IF LREND
- QUIT
- +4 IF '$GET(VAERR)
- DO AI3
- End DoDot:1
- +5 QUIT
- AI3 ;
- +1 IF $GET(LREND)
- QUIT
- +2 ;S LRSSN=$P(PNM,",")_SSN(1)
- +3 ;IHS/ANMC/CLS 08/18/96
- SET LRSSN=$PIECE(PNM,",")_HRCN
- +4 FOR LRIDT=0:0
- SET LRIDT=$ORDER(^LRO(69,"AN",LROC,LRDFN,LRIDT))
- IF LRIDT<1
- QUIT
- Begin DoDot:1
- +5 SET LRND=$SELECT($GET(^LR(LRDFN,"CH",LRIDT,0)):^(0),$GET(^LR(LRDFN,"MI",LRIDT,0)):^(0),1:"")
- IF $PIECE(LRND,U,3)
- Begin DoDot:2
- +6 SET LRPHY=$PIECE($GET(^VA(200,+$PIECE(LRND,U,10),0)),U)
- IF LRPHY=""
- SET LRPHY="UNKNOWN"
- +7 ;IHS/ANMC/CLS 08/18/96
- SET ^TMP($JOB,LROC,LRPHY,LRSSN,LRDFN,LRIDT)=PNM_U_HRCN_U_AGE_U_SEX
- End DoDot:2
- End DoDot:1
- +8 QUIT
- CH ;Also used by DVBC Package
- +1 NEW LROC
- +2 ;K ^TMP("LR",$J,"TP"),LRTP S LR0=^LR(LRDFN,"CH",LRIDT,0) Q:'$P(LR0,U,3) S LRCDT=+LR0,LRSS="CH",LROC=$P(LR0,U,11),LRAA="",LRAAO=1,LRTC=0,LRSPEC=$P(LR0,U,5)
- +3 ;IHS/OIRM TUC/AAB 1/21/98
- KILL ^TMP("LR",$JOB,"TP"),LRTP
- SET LR0=^LR(LRDFN,"CH",LRIDT,0)
- IF '$PIECE(LR0,U,3)
- QUIT
- +4 ;IHS/OIRM TUC/AAB 7/1/98
- IF LRSINGLE
- IF LRMD="S"
- IF LRPHY'=$EXTRACT($PIECE($GET(^VA(200,+$PIECE(LR0,U,10),0)),U),1,20)
- QUIT
- +5 ;IHS/OIRM TUC/AAB 1/21/98
- SET LRCDT=+LR0
- SET LRSS="CH"
- SET LROC=$PIECE(LR0,U,11)
- SET LRAA=""
- SET LRAAO=1
- SET LRTC=0
- SET LRSPEC=$PIECE(LR0,U,5)
- +6 DO CH^LRRP
- +7 QUIT
- MI ;Also used by DVBC package
- +1 ;S BLRPHYS=$P($G(^VA(200,+$P(^LR(LRDFN,"MI",LRIDT,0),U,7),0)),U) Q:'$D(LRPHY(BLRPHYS)) ;IHS/OIRM TUC/AAB 1/21/98 FIX FOR A MORE THAN ONE SELECTED PROVIDER
- +2 ;IHS/DIR TUC/AAB 7/1/98
- IF LRSINGLE
- IF LRMD="S"
- IF LRPHY'=$EXTRACT($PIECE($GET(^VA(200,+$PIECE(^LR(LRDFN,"MI",LRIDT,0),U,7),0)),U),1,20)
- QUIT
- +3 SET LRCDT=9999999-LRIDT
- SET ^TMP("LR",$JOB,"TP",1)="^MI"
- SET ^(1,LRCDT)=""
- SET ^(LRCDT,-1)=""
- SET LRSS="MI"
- SET LRH=1
- IF LRFOOT
- DO FOOT^LRRP1
- IF LRSTOP
- QUIT
- DO EN1^LRMIPC
- SET LRHF=1
- SET LRFOOT=0
- KILL A,Z,LRH
- IF LREND
- SET LREND=0
- SET LRSTOP=1
- +4 QUIT
- INIT ;IHS/ANMC/CLS 08/18/96 LRDT0 <undef>
- DO EN^LRPARAM
- IF '$DATA(LRDT0)
- DO DT^LRX
- SET (LREND,LRSTOP)=0
- SET LRCW=8
- SET LRHF=1
- SET LRFOOT=0
- SET (LRONESPC,LRONETST)=""
- +1 QUIT
- EN69 ;entry point for surgery pkg
- +1 DO START
- DO ^LRRK
- +2 QUIT
- GEN ;from LRGEN test overflow
- +1 SET LRLAB=$SELECT($DATA(LRLABKY):1,1:0)
- DO INIT
- DO GENP
- DO ^LRRK
- +2 QUIT
- DS ;from LRRD, LRRS
- +1 DO INIT
- SET DFN=$PIECE(^LR(LRDFN,0),U,3)
- SET LRDPF=$PIECE(^(0),U,2)
- DO SDQ
- +2 QUIT
- AIDQ ;tasked from LRTASK DAILY INTERIM
- +1 SET LRLAB=0
- SET LRH=""
- SET LRWRDVEW=""
- DO INIT
- DO AIDQUE
- KILL LRH
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- KILL ^TMP($JOB)
- +2 QUIT
- DQ ;tasked from LRVER3 thru LRTP for IMMEDIATE INTERIM REPORTING
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- DO INIT
- SET LRLAB=0
- SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
- SET DFN=$PIECE(^(0),U,3)
- DO PT^LRX
- DO CH
- DO FOOT^LRRP1
- WRITE @IOF
- DO ^%ZISC
- +2 QUIT
- OR ;OE/RR entry point
- +1 IF '$DATA(ORVP)
- QUIT
- SET KILL=1
- IF '$DATA(LRPARAM)
- DO EN^LRPARAM
- SET KILL=0
- +2 SET (LREND,LRSTOP)=0
- SET LRCW=8
- SET LRHF=1
- SET LRFOOT=0
- SET (LRONESPC,LRONETST)=""
- +3 DO DT^LRX
- KILL DIC,LRTP
- SET LRTP=0
- SET DFN=+ORVP
- SET LRDPF=+$PIECE(@("^"_$PIECE(ORVP,";",2)_"0)"),"^",2)_"^"_$PIECE(ORVP,";",2)
- DO END^LRDPA
- IF LRDFN<1
- QUIT
- +4 DO START
- DO ^LRRK
- +5 IF 'KILL
- KILL LRBLOOD,LRDT0,LRORN,LRPARAM,LRPLASMA,LRSERUM,LRSB,LRTP,LRUNKNOW,LRURINE
- +6 KILL KILL
- QUIT
