LRRP1VA ;DALOI/RWF/BA - PRINT THE DATA FOR INTERIM REPORTS, VA code ; 13-Oct-2017 14:04 ; MKK
;;5.2;LAB SERVICE;**1041**;NOV 01, 1997;Build 23
;
; Code moved from LRRP1 to hear due to LRRP1 becoming too large
;
TEST ; EP -- Original VA Code -- IHS/OIT/MKK LR*5.2*1027
S LRIDT=+^TMP("LR",$J,"TP",LRAAO,LRCDT,-2)
S LRSS=$P(^TMP("LR",$J,"TP",LRAAO),U,2)
S LR0=$S($D(^(LRAAO,LRCDT))#2:^(LRCDT),1:""),LRTC=$P(LR0,U,12)
I LRSS="MI" D Q
. S LRH=1 D:LRFOOT FOOT Q:LRSTOP
. D EN1^LRMIPC
. S LRHF=1,LRFOOT=0
. K A,Z,LRH
. S:LREND LREND=0,LRSTOP=1
;
Q:'$G(LRCAN)&('$P(LR0,U,3)) D @$S(LRHF:"HDR",1:"CHECK") Q:LRSTOP
S LRSPEC=+$P(LR0,U,5),X=$P(LR0,U,10) D DOC^LRX
;
W !!,?7,"Provider: ",LRDOC
W !,?7,"Specimen: ",$P(^LAB(61,LRSPEC,0),U)
D ORU^LRRP1
W !!,?30,"Specimen Collection Date: ",$$FMTE^XLFDT(LRCDT,"M")
W !?5,"Test name",?30,"Result units",?51,"Ref. range",?66,"Site Code"
S LRPO=0
F S LRPO=$O(^TMP("LR",$J,"TP",LRAAO,LRCDT,LRPO)) Q:LRPO'>0 S LRDATA=^(LRPO) D DATA Q:LRSTOP
Q:LRSTOP
;
I $D(^TMP("LR",$J,"TP",LRAAO,LRCDT,"C")) D
. W !,"Comment: " S LRCMNT=0
. F S LRCMNT=+$O(^TMP("LR",$J,"TP",LRAAO,LRCDT,"C",LRCMNT)) Q:LRCMNT<1 D Q:LRSTOP
. . W ^TMP("LR",$J,"TP",LRAAO,LRCDT,"C",LRCMNT)
. . D CONT Q:LRSTOP
. . W:$O(^TMP("LR",$J,"TP",LRAAO,LRCDT,"C",LRCMNT)) !?9
Q:LRSTOP D EQUALS^LRX
W !?7,"KEY: ""L""=Abnormal low, ""H""=Abnormal high, ""*""=Critical value"
S LRFOOT=1
Q
;
DATA ; EP-- Original VA Code -- IHS/OIT/MKK LR*5.2*1027
N LR63DATA
;
S LRTSTS=+LRDATA,LRPC=$P(LRDATA,U,5),LRSUB=$P(LRDATA,U,6)
S X=$P(LRDATA,U,7) Q:X=""
S LR63DATA=$$TSTRES^LRRPU(LRDFN,LRSS,LRIDT,$P(LRDATA,U,10),LRTSTS)
S LRLO=$P(LR63DATA,"^",3),LRHI=$P(LR63DATA,"^",4),LRREFS=$$EN^LRLRRVF(LRLO,LRHI),LRPLS=$P(LR63DATA,"^",6),LRTHER=$P(LR63DATA,"^",7)
I LRPLS S LRPLS(LRPLS)=LRPLS
;
W !?5,$S($L($P(LRDATA,U,2))>20:$P(LRDATA,U,3),1:$P(LRDATA,U,2))
S X=$P(LR63DATA,"^")
W ?27,@$S(LRPC="":"$J(X,LRCW)",1:LRPC)," ",$P(LR63DATA,"^",2)
I $X>39 W !
W ?40,$P(LR63DATA,U,5)
I $X>50 W !
W ?51,LRREFS K LRREFS
;
I LRPLS'="" D
. I $X>67 W !
. W ?68,"[",LRPLS,"]"
D CONT Q:LRSTOP
;
I $O(^TMP("LR",$J,"TP",LRAAO,LRCDT,LRPO,0))>0 D Q:LRSTOP
. S LRINTP=0
. F S LRINTP=+$O(^TMP("LR",$J,"TP",LRAAO,LRCDT,LRPO,LRINTP)) Q:LRINTP<1 W !?7,"Eval: ",^(LRINTP) D CONT Q:LRSTOP
;
Q
;
CONT ; EP -- Original VA Code -- IHS/OIT/MKK LR*5.2*1027
I $Y+5>IOSL D FOOT Q:LRSTOP D HDR W !?20,">> CONTINUATION OF ",$P(LR0,U,6)," <<",!
Q ; End CONT Original Code
;
Q:LRSTOP F I=$Y:1:IOSL-4 W !
I $E(IOST,1,2)'="C-" W !,PNM,?40," ",SSN," ",$$HTE^XLFDT($H,"M"),! Q
W !,PNM,?25," ",SSN," ",$$HTE^XLFDT($H,"MP"),?59," PRESS '^' TO STOP "
R X:DTIME S:X="" X=1 S:(".^"[X)!('$T) LRSTOP=1
Q
HDR ; Add Printed at, page #, change age to dob 7/2002 cka -- Original VA Code -- IHS/OIT/MKK LR*5.2*1027
W:($G(LRJ02))!($G(LRJ0))!($E(IOST,1,2)="C-") @IOF
S LRHF=0,LRJ02=1
I '$D(LRPG) S LRPG=0
S LRPG=LRPG+1
I $E(IOST,1)="P" D
.W !!!!
.S X="CLINICAL LABORATORY REPORT"
.W ?(80-$L(X)\2),X,!
I $D(DUZ("AG")),$L(DUZ("AG")),"ARMYAFN"[DUZ("AG") D ^LRAIPRIV W !
W "Printed at: ",?65,"page ",LRPG
W !,$$NAME^XUAF4(DUZ(2))," (",DUZ(2),")"
S X=$$PADD^XUAF4(DUZ(2))
W !,$P(X,U)," ",$P(X,U,2),", ",$P(X,U,3)," ",$P(X,U,4)
W !!,PNM,?44,"Report date: ",$$HTE^XLFDT($H,"M")
W !?5,"SSN: ",SSN," SEX: ",SEX," DOB: ",$$FMTE^XLFDT(DOB)," LOC: ",LROC
Q
LRRP1VA ;DALOI/RWF/BA - PRINT THE DATA FOR INTERIM REPORTS, VA code ; 13-Oct-2017 14:04 ; MKK
+1 ;;5.2;LAB SERVICE;**1041**;NOV 01, 1997;Build 23
+2 ;
+3 ; Code moved from LRRP1 to hear due to LRRP1 becoming too large
+4 ;
TEST ; EP -- Original VA Code -- IHS/OIT/MKK LR*5.2*1027
+1 SET LRIDT=+^TMP("LR",$JOB,"TP",LRAAO,LRCDT,-2)
+2 SET LRSS=$PIECE(^TMP("LR",$JOB,"TP",LRAAO),U,2)
+3 SET LR0=$SELECT($DATA(^(LRAAO,LRCDT))#2:^(LRCDT),1:"")
SET LRTC=$PIECE(LR0,U,12)
+4 IF LRSS="MI"
Begin DoDot:1
+5 SET LRH=1
IF LRFOOT
DO FOOT
IF LRSTOP
QUIT
+6 DO EN1^LRMIPC
+7 SET LRHF=1
SET LRFOOT=0
+8 KILL A,Z,LRH
+9 IF LREND
SET LREND=0
SET LRSTOP=1
End DoDot:1
QUIT
+10 ;
+11 IF '$GET(LRCAN)&('$PIECE(LR0,U,3))
QUIT
DO @$SELECT(LRHF:"HDR",1:"CHECK")
IF LRSTOP
QUIT
+12 SET LRSPEC=+$PIECE(LR0,U,5)
SET X=$PIECE(LR0,U,10)
DO DOC^LRX
+13 ;
+14 WRITE !!,?7,"Provider: ",LRDOC
+15 WRITE !,?7,"Specimen: ",$PIECE(^LAB(61,LRSPEC,0),U)
+16 DO ORU^LRRP1
+17 WRITE !!,?30,"Specimen Collection Date: ",$$FMTE^XLFDT(LRCDT,"M")
+18 WRITE !?5,"Test name",?30,"Result units",?51,"Ref. range",?66,"Site Code"
+19 SET LRPO=0
+20 FOR
SET LRPO=$ORDER(^TMP("LR",$JOB,"TP",LRAAO,LRCDT,LRPO))
IF LRPO'>0
QUIT
SET LRDATA=^(LRPO)
DO DATA
IF LRSTOP
QUIT
+21 IF LRSTOP
QUIT
+22 ;
+23 IF $DATA(^TMP("LR",$JOB,"TP",LRAAO,LRCDT,"C"))
Begin DoDot:1
+24 WRITE !,"Comment: "
SET LRCMNT=0
+25 FOR
SET LRCMNT=+$ORDER(^TMP("LR",$JOB,"TP",LRAAO,LRCDT,"C",LRCMNT))
IF LRCMNT<1
QUIT
Begin DoDot:2
+26 WRITE ^TMP("LR",$JOB,"TP",LRAAO,LRCDT,"C",LRCMNT)
+27 DO CONT
IF LRSTOP
QUIT
+28 IF $ORDER(^TMP("LR",$JOB,"TP",LRAAO,LRCDT,"C",LRCMNT))
WRITE !?9
End DoDot:2
IF LRSTOP
QUIT
End DoDot:1
+29 IF LRSTOP
QUIT
DO EQUALS^LRX
+30 WRITE !?7,"KEY: ""L""=Abnormal low, ""H""=Abnormal high, ""*""=Critical value"
+31 SET LRFOOT=1
+32 QUIT
+33 ;
DATA ; EP-- Original VA Code -- IHS/OIT/MKK LR*5.2*1027
+1 NEW LR63DATA
+2 ;
+3 SET LRTSTS=+LRDATA
SET LRPC=$PIECE(LRDATA,U,5)
SET LRSUB=$PIECE(LRDATA,U,6)
+4 SET X=$PIECE(LRDATA,U,7)
IF X=""
QUIT
+5 SET LR63DATA=$$TSTRES^LRRPU(LRDFN,LRSS,LRIDT,$PIECE(LRDATA,U,10),LRTSTS)
+6 SET LRLO=$PIECE(LR63DATA,"^",3)
SET LRHI=$PIECE(LR63DATA,"^",4)
SET LRREFS=$$EN^LRLRRVF(LRLO,LRHI)
SET LRPLS=$PIECE(LR63DATA,"^",6)
SET LRTHER=$PIECE(LR63DATA,"^",7)
+7 IF LRPLS
SET LRPLS(LRPLS)=LRPLS
+8 ;
+9 WRITE !?5,$SELECT($LENGTH($PIECE(LRDATA,U,2))>20:$PIECE(LRDATA,U,3),1:$PIECE(LRDATA,U,2))
+10 SET X=$PIECE(LR63DATA,"^")
+11 WRITE ?27,@$SELECT(LRPC="":"$J(X,LRCW)",1:LRPC)," ",$PIECE(LR63DATA,"^",2)
+12 IF $X>39
WRITE !
+13 WRITE ?40,$PIECE(LR63DATA,U,5)
+14 IF $X>50
WRITE !
+15 WRITE ?51,LRREFS
KILL LRREFS
+16 ;
+17 IF LRPLS'=""
Begin DoDot:1
+18 IF $X>67
WRITE !
+19 WRITE ?68,"[",LRPLS,"]"
End DoDot:1
+20 DO CONT
IF LRSTOP
QUIT
+21 ;
+22 IF $ORDER(^TMP("LR",$JOB,"TP",LRAAO,LRCDT,LRPO,0))>0
Begin DoDot:1
+23 SET LRINTP=0
+24 FOR
SET LRINTP=+$ORDER(^TMP("LR",$JOB,"TP",LRAAO,LRCDT,LRPO,LRINTP))
IF LRINTP<1
QUIT
WRITE !?7,"Eval: ",^(LRINTP)
DO CONT
IF LRSTOP
QUIT
End DoDot:1
IF LRSTOP
QUIT
+25 ;
+26 QUIT
+27 ;
CONT ; EP -- Original VA Code -- IHS/OIT/MKK LR*5.2*1027
+1 IF $Y+5>IOSL
DO FOOT
IF LRSTOP
QUIT
DO HDR
WRITE !?20,">> CONTINUATION OF ",$PIECE(LR0,U,6)," <<",!
+2 ; End CONT Original Code
QUIT
+3 ;
+1 IF LRSTOP
QUIT
FOR I=$Y:1:IOSL-4
WRITE !
+2 IF $EXTRACT(IOST,1,2)'="C-"
WRITE !,PNM,?40," ",SSN," ",$$HTE^XLFDT($HOROLOG,"M"),!
QUIT
+3 WRITE !,PNM,?25," ",SSN," ",$$HTE^XLFDT($HOROLOG,"MP"),?59," PRESS '^' TO STOP "
+4 READ X:DTIME
IF X=""
SET X=1
IF (".^"[X)!('$TEST)
SET LRSTOP=1
+5 QUIT
HDR ; Add Printed at, page #, change age to dob 7/2002 cka -- Original VA Code -- IHS/OIT/MKK LR*5.2*1027
+1 IF ($GET(LRJ02))!($GET(LRJ0))!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
+2 SET LRHF=0
SET LRJ02=1
+3 IF '$DATA(LRPG)
SET LRPG=0
+4 SET LRPG=LRPG+1
+5 IF $EXTRACT(IOST,1)="P"
Begin DoDot:1
+6 WRITE !!!!
+7 SET X="CLINICAL LABORATORY REPORT"
+8 WRITE ?(80-$LENGTH(X)\2),X,!
End DoDot:1
+9 IF $DATA(DUZ("AG"))
IF $LENGTH(DUZ("AG"))
IF "ARMYAFN"[DUZ("AG")
DO ^LRAIPRIV
WRITE !
+10 WRITE "Printed at: ",?65,"page ",LRPG
+11 WRITE !,$$NAME^XUAF4(DUZ(2))," (",DUZ(2),")"
+12 SET X=$$PADD^XUAF4(DUZ(2))
+13 WRITE !,$PIECE(X,U)," ",$PIECE(X,U,2),", ",$PIECE(X,U,3)," ",$PIECE(X,U,4)
+14 WRITE !!,PNM,?44,"Report date: ",$$HTE^XLFDT($HOROLOG,"M")
+15 WRITE !?5,"SSN: ",SSN," SEX: ",SEX," DOB: ",$$FMTE^XLFDT(DOB)," LOC: ",LROC
+16 QUIT
