LRVRMI1A ;DALOI/STAFF - LAB MICRO HL7 INTERFACE ;08/16/13 17:53
;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
;
Q
;
SRCHEN2 ;
; Continued from SRCHEN^LRVRMI1
N IEN,IEN2,LRND,LRNDINFO
;
; virus
I $D(^LAH(LWL,1,ISQN,"MI",16)) D
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,16)=^LAH(LWL,1,ISQN,"MI",16)
;
I $D(^LAH(LWL,1,ISQN,"MI",17)) D
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17)=^LAH(LWL,1,ISQN,"MI",17)
. S IEN=0
. F S IEN=$O(^LAH(LWL,1,ISQN,"MI",17,IEN)) Q:'IEN D
. . S LRX=$G(^LAH(LWL,1,ISQN,"MI",17,IEN,0,.01,0))
. . I $P(LRX,"^")'="" D BLDSTAT(34,$P(LRX,"^"))
. D USERDT(16,$G(LRSTATUS(63.05,34)))
;
; virus remark
I $D(^LAH(LWL,1,ISQN,"MI",18)) D
. N STAT
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18)=^LAH(LWL,1,ISQN,"MI",18)
. S STAT=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,0),U,4)
. D BLDSTAT(34,STAT),USERDT(16,$G(LRSTATUS(63.05,34)))
;
;
; Process similar multiples - nodes 15,19-31
;
; LRNDINFO(NODE)= Status Node ^ Status field
S LRNDINFO(15)="8^19" ; mycology prep/smear
S LRNDINFO(19)="1^11.5" ; preliminary bacteria comment
S LRNDINFO(20)="16^34" ; preliminary virus comment
S LRNDINFO(21)="5^15" ; preliminary parasite comment
S LRNDINFO(22)="8^19" ; preliminary mycology comment
S LRNDINFO(23)="11^23" ; preliminary TB comment
S LRNDINFO(24)="5^15" ; parasite prep/smear
S LRNDINFO(25)="1^11.5" ; bacteriology prep/smear
S LRNDINFO(26)="1^11.5" ; bacteria tests
S LRNDINFO(27)="5^15" ; parasitology tests
S LRNDINFO(28)="8^19" ; mycology tests
S LRNDINFO(29)="11^23" ; TB tests
S LRNDINFO(30)="16^34" ; virology tests
S LRNDINFO(31)="1^11.5" ; sterility tests
;
F LRND=15,19:1:31 D
. I $D(^LAH(LWL,1,ISQN,"MI",LRND)) D
. . N LRIEN,LRSTAT,LRSTATND,LRSTATFLD
. . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRND)=^LAH(LWL,1,ISQN,"MI",LRND)
. . S LRSTAT=$P($G(^LAH(LWL,1,ISQN,"MI",LRND,0)),U,4)
. . S LRSTATND=$P($G(LRNDINFO(LRND)),U,1)
. . S LRSTATFLD=$P($G(LRNDINFO(LRND)),U,2)
. . D BLDSTAT(LRSTATFLD,LRSTAT),USERDT(LRSTATND,$G(LRSTATUS(63.05,LRSTATFLD)))
. . ;
. . S LRIEN=0
. . F S LRIEN=$O(^LAH(LWL,1,ISQN,"MI",LRND,LRIEN)) Q:LRIEN<1 D
. . . I $D(^LAH(LWL,1,ISQN,"MI",LRND,LRIEN,0,0)) D
. . . . S LRSTAT=$P($G(^LAH(LWL,1,ISQN,"MI",LRND,LRIEN,0,0)),U,4)
. . . . S LRSTATND=$P($G(LRNDINFO(LRND)),U,1)
. . . . S LRSTATFLD=$P($G(LRNDINFO(LRND)),U,2)
. . . . D BLDSTAT(LRSTATFLD,LRSTAT),USERDT(LRSTATND,$G(LRSTATUS(63.05,LRSTATFLD)))
;
;
Q
;
;
BLDSTAT(FLD,VAL) ;
; Convenience method
D BLDSTAT^LRVRMI4A(63.05,FLD,VAL,.LRSTATUS)
Q
;
;
USERDT(LRNODE,LRSTAT) ; Set user and date/time in respective MI section
; Call with LRNODE = MI node to set
; LRSTAT = status to set (optional)
;
I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE)) S $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE),U)=LRNOW
;
; Update status, don't change an existing "P" to a "F"
I $G(LRSTAT)'="" D
. I LRSTAT="F",$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE),"^",2)="P" Q
. S $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE),"^",2)=LRSTAT
;
; AFB (node=11) stores user in 5th piece instead of usual 3rd piece for other nodes.
I LRNODE'=11 S $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE),U,3)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
E S $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE),U,5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRVRMI1A 3338 printed Oct 16, 2024@18:23:33 Page 2
LRVRMI1A ;DALOI/STAFF - LAB MICRO HL7 INTERFACE ;08/16/13 17:53
+1 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
+2 ;
+3 QUIT
+4 ;
SRCHEN2 ;
+1 ; Continued from SRCHEN^LRVRMI1
+2 NEW IEN,IEN2,LRND,LRNDINFO
+3 ;
+4 ; virus
+5 IF $DATA(^LAH(LWL,1,ISQN,"MI",16))
Begin DoDot:1
+6 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,16)=^LAH(LWL,1,ISQN,"MI",16)
End DoDot:1
+7 ;
+8 IF $DATA(^LAH(LWL,1,ISQN,"MI",17))
Begin DoDot:1
+9 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,17)=^LAH(LWL,1,ISQN,"MI",17)
+10 SET IEN=0
+11 FOR
SET IEN=$ORDER(^LAH(LWL,1,ISQN,"MI",17,IEN))
if 'IEN
QUIT
Begin DoDot:2
+12 SET LRX=$GET(^LAH(LWL,1,ISQN,"MI",17,IEN,0,.01,0))
+13 IF $PIECE(LRX,"^")'=""
DO BLDSTAT(34,$PIECE(LRX,"^"))
End DoDot:2
+14 DO USERDT(16,$GET(LRSTATUS(63.05,34)))
End DoDot:1
+15 ;
+16 ; virus remark
+17 IF $DATA(^LAH(LWL,1,ISQN,"MI",18))
Begin DoDot:1
+18 NEW STAT
+19 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,18)=^LAH(LWL,1,ISQN,"MI",18)
+20 SET STAT=$PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,18,0),U,4)
+21 DO BLDSTAT(34,STAT)
DO USERDT(16,$GET(LRSTATUS(63.05,34)))
End DoDot:1
+22 ;
+23 ;
+24 ; Process similar multiples - nodes 15,19-31
+25 ;
+26 ; LRNDINFO(NODE)= Status Node ^ Status field
+27 ; mycology prep/smear
SET LRNDINFO(15)="8^19"
+28 ; preliminary bacteria comment
SET LRNDINFO(19)="1^11.5"
+29 ; preliminary virus comment
SET LRNDINFO(20)="16^34"
+30 ; preliminary parasite comment
SET LRNDINFO(21)="5^15"
+31 ; preliminary mycology comment
SET LRNDINFO(22)="8^19"
+32 ; preliminary TB comment
SET LRNDINFO(23)="11^23"
+33 ; parasite prep/smear
SET LRNDINFO(24)="5^15"
+34 ; bacteriology prep/smear
SET LRNDINFO(25)="1^11.5"
+35 ; bacteria tests
SET LRNDINFO(26)="1^11.5"
+36 ; parasitology tests
SET LRNDINFO(27)="5^15"
+37 ; mycology tests
SET LRNDINFO(28)="8^19"
+38 ; TB tests
SET LRNDINFO(29)="11^23"
+39 ; virology tests
SET LRNDINFO(30)="16^34"
+40 ; sterility tests
SET LRNDINFO(31)="1^11.5"
+41 ;
+42 FOR LRND=15,19:1:31
Begin DoDot:1
+43 IF $DATA(^LAH(LWL,1,ISQN,"MI",LRND))
Begin DoDot:2
+44 NEW LRIEN,LRSTAT,LRSTATND,LRSTATFLD
+45 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,LRND)=^LAH(LWL,1,ISQN,"MI",LRND)
+46 SET LRSTAT=$PIECE($GET(^LAH(LWL,1,ISQN,"MI",LRND,0)),U,4)
+47 SET LRSTATND=$PIECE($GET(LRNDINFO(LRND)),U,1)
+48 SET LRSTATFLD=$PIECE($GET(LRNDINFO(LRND)),U,2)
+49 DO BLDSTAT(LRSTATFLD,LRSTAT)
DO USERDT(LRSTATND,$GET(LRSTATUS(63.05,LRSTATFLD)))
+50 ;
+51 SET LRIEN=0
+52 FOR
SET LRIEN=$ORDER(^LAH(LWL,1,ISQN,"MI",LRND,LRIEN))
if LRIEN<1
QUIT
Begin DoDot:3
+53 IF $DATA(^LAH(LWL,1,ISQN,"MI",LRND,LRIEN,0,0))
Begin DoDot:4
+54 SET LRSTAT=$PIECE($GET(^LAH(LWL,1,ISQN,"MI",LRND,LRIEN,0,0)),U,4)
+55 SET LRSTATND=$PIECE($GET(LRNDINFO(LRND)),U,1)
+56 SET LRSTATFLD=$PIECE($GET(LRNDINFO(LRND)),U,2)
+57 DO BLDSTAT(LRSTATFLD,LRSTAT)
DO USERDT(LRSTATND,$GET(LRSTATUS(63.05,LRSTATFLD)))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+58 ;
+59 ;
+60 QUIT
+61 ;
+62 ;
BLDSTAT(FLD,VAL) ;
+1 ; Convenience method
+2 DO BLDSTAT^LRVRMI4A(63.05,FLD,VAL,.LRSTATUS)
+3 QUIT
+4 ;
+5 ;
USERDT(LRNODE,LRSTAT) ; Set user and date/time in respective MI section
+1 ; Call with LRNODE = MI node to set
+2 ; LRSTAT = status to set (optional)
+3 ;
+4 IF '$DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,LRNODE))
SET $PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,LRNODE),U)=LRNOW
+5 ;
+6 ; Update status, don't change an existing "P" to a "F"
+7 IF $GET(LRSTAT)'=""
Begin DoDot:1
+8 IF LRSTAT="F"
IF $PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,LRNODE),"^",2)="P"
QUIT
+9 SET $PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,LRNODE),"^",2)=LRSTAT
End DoDot:1
+10 ;
+11 ; AFB (node=11) stores user in 5th piece instead of usual 3rd piece for other nodes.
+12 IF LRNODE'=11
SET $PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,LRNODE),U,3)=$SELECT($GET(LRDUZ):LRDUZ,1:$GET(DUZ))
+13 IF '$TEST
SET $PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,LRNODE),U,5)=$SELECT($GET(LRDUZ):LRDUZ,1:$GET(DUZ))
+14 ;
+15 QUIT
