LRMIUT1 ;DALOI/STAFF - INPUT TRANSFORMS FOR MICRO ;02/21/13 10:28
;;5.2;LAB SERVICE;**100,121,323,350,427**;Sep 27, 1994;Build 33
;
RPT ; from input transform on RPT DATE APPROVED
N %DT,Y
I $G(DIUTIL)'="VERIFY FIELDS" D ;
. I '$D(^XUSEC("LRVERIFY",DUZ)) K X D EN^DDIOL("*** You do not have the proper access to approve these results ***","","!,$C(7)")
Q:'$D(X)
S %DT="EXR"
I $G(DIUTIL)="VERIFY FIELDS" S %DT="EXT" ;old rptdt only has date
D ^%DT S X=Y I Y<1 K X Q
I $G(DIUTIL)="VERIFY FIELDS" Q
N X,DA,DIERR,DIE,DIC,DR ;protect FM vars from subsequent calls
D VT1
Q
;
;
VT ; from LRMINEW1, LRMIVER1
D VT1
K ^TMP("LA7HDR",$J)
Q
;
;
VT1 ; from above
I $G(LRLLOC)'="",$G(PNM)'="",$G(LRDFN),$G(LRIDT) S LRVTP=$P(^LAB(64.5,1,0),U,10),LRVT=$G(LRVT) D APP
;
; Set reporting facility
I $G(LRDFN),$G(LRIDT) D SETRL^LRVERA(LRDFN,"MI",LRIDT,DUZ(2))
Q
;
;
APP ;
N Q9,X,I
S DT=$$DT^XLFDT
S ^LRO(69,"AN",$E(LRLLOC,1,20),LRDFN,LRIDT)="",^LRO(69,LRCDT\1,1,"AL",$E(LRLLOC,1,20),$E(PNM,1,30),LRDFN)=""
S ^LRO(69,DT,1,"AN",$E(LRLLOC,1,20),LRDFN,LRIDT)=""
;
I LRVT["RE"!(LRVT["VT") S:LRVT=LRVTP ^LRO(69,DT,1,"AR",$E(LRLLOC,1,20),$E(PNM,1,30),LRDFN)="",^LRO(68,"MI",LRDFN,LRIDT,LRSB)=""
;
I LRVT["VS",LRVT=LRVTP D
. S ^LRO(69,DT,1,"AR",$E(LRLLOC,1,20),$E(PNM,1,30),LRDFN)=""
. F LRSB=1,5,8,11,16 I $P($G(^LR(LRDFN,"MI",LRIDT,LRSB)),U,1) S ^LRO(68,"MI",LRDFN,LRIDT,LRSB)=""
;
S Q9=+$P(^LR(LRDFN,"MI",LRIDT,0),U,7),^LRO(69,LRCDT\1,1,"AP",$S($D(^VA(200,Q9,0)):$E($P(^VA(200,Q9,0),U),1,20),1:"UNK"),$E(PNM,1,30),LRDFN)=""
K ^LAC("LRKILL",LRDFN,"MI",LRIDT)
;
I $D(^LRO(69,LRODT,1,LRSN,3)),'$P(^(3),U,2) S $P(^LRO(69,LRODT,1,LRSN,3),U,2)=$$NOW^XLFDT
;
I $D(^LRO(69,LRODT,1,LRSN,3)) D
. N X,Y,CORRECT
. S:$G(LRCORECT) CORRECT=1
. D NEW^LR7OB1(LRODT,LRSN,"RE")
K LRVTP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIUT1 1847 printed Dec 13, 2024@02:17:42 Page 2
LRMIUT1 ;DALOI/STAFF - INPUT TRANSFORMS FOR MICRO ;02/21/13 10:28
+1 ;;5.2;LAB SERVICE;**100,121,323,350,427**;Sep 27, 1994;Build 33
+2 ;
RPT ; from input transform on RPT DATE APPROVED
+1 NEW %DT,Y
+2 ;
IF $GET(DIUTIL)'="VERIFY FIELDS"
Begin DoDot:1
+3 IF '$DATA(^XUSEC("LRVERIFY",DUZ))
KILL X
DO EN^DDIOL("*** You do not have the proper access to approve these results ***","","!,$C(7)")
End DoDot:1
+4 if '$DATA(X)
QUIT
+5 SET %DT="EXR"
+6 ;old rptdt only has date
IF $GET(DIUTIL)="VERIFY FIELDS"
SET %DT="EXT"
+7 DO ^%DT
SET X=Y
IF Y<1
KILL X
QUIT
+8 IF $GET(DIUTIL)="VERIFY FIELDS"
QUIT
+9 ;protect FM vars from subsequent calls
NEW X,DA,DIERR,DIE,DIC,DR
+10 DO VT1
+11 QUIT
+12 ;
+13 ;
VT ; from LRMINEW1, LRMIVER1
+1 DO VT1
+2 KILL ^TMP("LA7HDR",$JOB)
+3 QUIT
+4 ;
+5 ;
VT1 ; from above
+1 IF $GET(LRLLOC)'=""
IF $GET(PNM)'=""
IF $GET(LRDFN)
IF $GET(LRIDT)
SET LRVTP=$PIECE(^LAB(64.5,1,0),U,10)
SET LRVT=$GET(LRVT)
DO APP
+2 ;
+3 ; Set reporting facility
+4 IF $GET(LRDFN)
IF $GET(LRIDT)
DO SETRL^LRVERA(LRDFN,"MI",LRIDT,DUZ(2))
+5 QUIT
+6 ;
+7 ;
APP ;
+1 NEW Q9,X,I
+2 SET DT=$$DT^XLFDT
+3 SET ^LRO(69,"AN",$EXTRACT(LRLLOC,1,20),LRDFN,LRIDT)=""
SET ^LRO(69,LRCDT\1,1,"AL",$EXTRACT(LRLLOC,1,20),$EXTRACT(PNM,1,30),LRDFN)=""
+4 SET ^LRO(69,DT,1,"AN",$EXTRACT(LRLLOC,1,20),LRDFN,LRIDT)=""
+5 ;
+6 IF LRVT["RE"!(LRVT["VT")
if LRVT=LRVTP
SET ^LRO(69,DT,1,"AR",$EXTRACT(LRLLOC,1,20),$EXTRACT(PNM,1,30),LRDFN)=""
SET ^LRO(68,"MI",LRDFN,LRIDT,LRSB)=""
+7 ;
+8 IF LRVT["VS"
IF LRVT=LRVTP
Begin DoDot:1
+9 SET ^LRO(69,DT,1,"AR",$EXTRACT(LRLLOC,1,20),$EXTRACT(PNM,1,30),LRDFN)=""
+10 FOR LRSB=1,5,8,11,16
IF $PIECE($GET(^LR(LRDFN,"MI",LRIDT,LRSB)),U,1)
SET ^LRO(68,"MI",LRDFN,LRIDT,LRSB)=""
End DoDot:1
+11 ;
+12 SET Q9=+$PIECE(^LR(LRDFN,"MI",LRIDT,0),U,7)
SET ^LRO(69,LRCDT\1,1,"AP",$SELECT($DATA(^VA(200,Q9,0)):$EXTRACT($PIECE(^VA(200,Q9,0),U),1,20),1:"UNK"),$EXTRACT(PNM,1,30),LRDFN)=""
+13 KILL ^LAC("LRKILL",LRDFN,"MI",LRIDT)
+14 ;
+15 IF $DATA(^LRO(69,LRODT,1,LRSN,3))
IF '$PIECE(^(3),U,2)
SET $PIECE(^LRO(69,LRODT,1,LRSN,3),U,2)=$$NOW^XLFDT
+16 ;
+17 IF $DATA(^LRO(69,LRODT,1,LRSN,3))
Begin DoDot:1
+18 NEW X,Y,CORRECT
+19 if $GET(LRCORECT)
SET CORRECT=1
+20 DO NEW^LR7OB1(LRODT,LRSN,"RE")
End DoDot:1
+21 KILL LRVTP
+22 QUIT
