LRVRMI1 ;DALOI/STAFF - LAB MICRO HL7 INTERFACE ;Oct 29, 2008
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
; Extraction routine for the HL7 to Micro interface. It processes incoming HL7I data by extracting the results
; data from the ^LAH global and storing that data into a "workbench" (^TMP("LRMI"). The workbench has the same structure
; as the Lab Data micro file (#63.05). The first step in the process copies the instance of the Lab Data file in question
; into the Workbench.
;
Q
;
EN ;
; First work through the LAH global to find entries to extract
N PARA,PFLG,IEN,LROLD,LRNEW,LRSTATUS,LRSTORE,LWL,LRX
; Check to see if a lab area exists
K ^TMP("LRMI",$J),^TMP("LRPL",$J)
;
I '$G(LRLL) D Q
. W !,"No Load/Work List has been identified"
. S LREND=1
;
S LWL=LRLL
;
D SRCHEN
S IEN=$O(^LAH(LWL,1,ISQN,"MI",99,""),-1)
I IEN S ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,99)=^LAH(LWL,1,ISQN,"MI",99,IEN,0)
D SETSTATS(.LRSTATUS)
Q
;
;
SRCHEN ; This begins the search of LAH for new data
N EOL,FID,ICN,LRIEN,LRNOW,LRTDFN,LRUID,ORCDT,ORDNLT,ORDP,PEB,PVB,SID
;
S ISQN=LRISQN,LRLEDI=1,LRNOW=$$NOW^XLFDT
I $P(^LRO(68,$P(^LAH(LWL,1,ISQN,0),U,3),0),U,2)'="MI" Q
D HEAD^LRVRMI2
D ACCN
K LRSTATUS
S ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,0)=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
;
; gram stain
I $D(^LAH(LWL,1,ISQN,"MI",2)) D
. N IEN
. S IEN=0
. F S IEN=$O(^LAH(LWL,1,ISQN,"MI",2,IEN)) Q:IEN<1 D
. . S LRX=$G(^LAH(LWL,1,ISQN,"MI",2,IEN,0,0))
. . I $P(LRX,"^",5)'="" D BLDSTAT(11.5,$P(LRX,"^",5))
. D USERDT^LRVRMI1A(1,$G(LRSTATUS(63.05,11.5)))
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2)=^LAH(LWL,1,ISQN,"MI",2)
;
; bacteria
I $D(^LAH(LWL,1,ISQN,"MI",3)) D
. N IEN
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3)=^LAH(LWL,1,ISQN,"MI",3)
. S IEN=0
. F S IEN=$O(^LAH(LWL,1,ISQN,"MI",3,IEN)) Q:IEN<1 D
. . S LRX=$G(^LAH(LWL,1,ISQN,"MI",3,IEN,0,.01,0))
. . I $P(LRX,"^")'="" D BLDSTAT(11.5,$P(LRX,"^"))
. D USERDT^LRVRMI1A(1,$G(LRSTATUS(63.05,11.5)))
;
; bacteria remark
I $D(^LAH(LWL,1,ISQN,"MI",4)) D
. S LRX=$G(^LAH(LWL,1,ISQN,"MI",4,0))
. I $P(LRX,"^",4)'="" D BLDSTAT(11.5,$P(LRX,"^",4))
. D USERDT^LRVRMI1A(1,$G(LRSTATUS(63.05,11.5)))
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4)=^LAH(LWL,1,ISQN,"MI",4)
;
; parasite
I $D(^LAH(LWL,1,ISQN,"MI",6)) D
. N IEN
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6)=^LAH(LWL,1,ISQN,"MI",6)
. S IEN=0
. F S IEN=$O(^LAH(LWL,1,ISQN,"MI",6,IEN)) Q:IEN<1 D
. . S LRX=$G(^LAH(LWL,1,ISQN,"MI",6,IEN,0,.01,0))
. . I $P(LRX,"^")'="" D BLDSTAT(15,$P(LRX,"^"))
. D USERDT^LRVRMI1A(5,$G(LRSTATUS(63.05,15)))
;
; parasite remark
I $D(^LAH(LWL,1,ISQN,"MI",7)) D
. S LRX=$G(^LAH(LWL,1,ISQN,"MI",7,0))
. I $P(LRX,"^",4)'="" D BLDSTAT(15,$P(LRX,"^",4))
. D USERDT^LRVRMI1A(5,$G(LRSTATUS(63.05,15)))
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7)=^LAH(LWL,1,ISQN,"MI",7)
;
; mycology date approved
I $D(^LAH(LWL,1,ISQN,"MI",8)) M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,8)=^LAH(LWL,1,ISQN,"MI",8)
;
; fungus/yeast
I $D(^LAH(LWL,1,ISQN,"MI",9)) D
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9)=^LAH(LWL,1,ISQN,"MI",9)
. S IEN=0
. F S IEN=$O(^LAH(LWL,1,ISQN,"MI",9,IEN)) Q:'IEN D
. . S LRX=$G(^LAH(LWL,1,ISQN,"MI",9,IEN,0,.01,0))
. . I $P(LRX,"^")'="" D BLDSTAT(19,$P(LRX,"^"))
. D USERDT^LRVRMI1A(8,$G(LRSTATUS(63.05,19)))
;
; mycology remarks
I $D(^LAH(LWL,1,ISQN,"MI",10)) D
. S LRX=$G(^LAH(LWL,1,ISQN,"MI",10,0))
. I $P(LRX,"^",4)'="" D BLDSTAT(19,$P(LRX,"^",4))
. D USERDT^LRVRMI1A(8,$G(LRSTATUS(63.05,19)))
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,10)=^LAH(LWL,1,ISQN,"MI",10)
;
; TB Date approved, etc.
I $D(^LAH(LWL,1,ISQN,"MI",11)) D
. N AFS,AFQ
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11)=^LAH(LWL,1,ISQN,"MI",11)
. S LRX=$G(^LAH(LWL,1,ISQN,"MI",11,0)),AFS=$P(LRX,"^",3),AFQ=$P(LRX,"^",4)
. S $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11),U,3)=AFS
. S $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11),U,4)=AFQ
. I AFS'="" D
. . S LRX=$G(^LAH(LWL,1,ISQN,"MI",11,0,.01,0))
. . I $P(LRX,"^")'="" D BLDSTAT(23,$P(LRX,"^"))
. I AFQ'="" D
. . S LRX=$G(^LAH(LWL,1,ISQN,"MI",11,0,.02,0))
. . I $P(LRX,"^")'="" D BLDSTAT(23,$P(LRX,"^"))
. D USERDT^LRVRMI1A(11,$G(LRSTATUS(63.05,23)))
;
; mycobacteria organism
I $D(^LAH(LWL,1,ISQN,"MI",12)) D
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12)=^LAH(LWL,1,ISQN,"MI",12)
. S LRIEN=0
. F S LRIEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,LRIEN)) Q:'LRIEN D
. . S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,LRIEN,0,.01,0))
. . I $P(LRX,"^")'="" D BLDSTAT(23,$P(LRX,"^"))
. D USERDT^LRVRMI1A(11,$G(LRSTATUS(63.05,23)))
;
; TB remark
I $D(^LAH(LWL,1,ISQN,"MI",13)) D
. M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,13)=^LAH(LWL,1,ISQN,"MI",13)
. S LRX=$G(^LAH(LWL,1,ISQN,"MI",13,0))
. I $P(LRX,"^",4)'="" D BLDSTAT(23,$P(LRX,"^",4))
. D USERDT^LRVRMI1A(11,$G(LRSTATUS(63.05,23)))
;
D SRCHEN2^LRVRMI1A
Q
;
;
ACCN ; Get the LRIDT
S LRIDT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,5)
Q
;
;
MAKEISO(LR4,ISOID) ;
; Creates the "unique id" portion for an isolate id
; Inputs
; LR4 : File #4 IEN
; ISOID : Isolate ID
; Output
; "99VA4:"_#4 info_":"_ISOID
;
N LRNVAF,LRY
Q:$TR(ISOID," ","")="" ISOID
I ISOID?1"99VA4:"0.E1":"0.E Q ISOID
S LRNVAF=$$NVAF^LA7VHLU2(LR4)
S LRY=$$ID^XUAF4($S(LRNVAF=1:"DMIS",LRNVAF=2:"ASUFAC",1:"VASTANUM"),LR4)
I LRY="" D
. S LRY=$$KSP^XUPARAM("INST") ;default institution IEN
. S LRY=$$NS^XUAF4(LRY)
. S LRY=$P(LRY,"^",2)
. S LRY=LRY_"#"_LR4
Q "99VA4:"_LRY_":"_ISOID
;
;
BLDSTAT(FLD,VAL) ;
; Convenience method
D BLDSTAT^LRVRMI4A(63.05,FLD,VAL,.LRSTATUS)
Q
;
;
SETSTATS(DATA) ;
; Goes thru DATA array and sets the status(es)
; Inputs
; DATA <byref> : DATA(file#,field#)=status ie DATA(63.05,19)="P"
;
N NODE,FN,FLD,STAT,DATA2TMP,X,SUB,POS
S DATA2TMP(63.05,11.5)="1^2" ;SUB^POS
S DATA2TMP(63.05,15)="5^2"
S DATA2TMP(63.05,19)="8^2"
S DATA2TMP(63.05,23)="11^2"
S DATA2TMP(63.05,34)="16^2"
S NODE="DATA(0)"
F S NODE=$Q(@NODE) Q:NODE="" D ;
. S FN=$QS(NODE,1)
. S FLD=$QS(NODE,2)
. S STAT=DATA(FN,FLD)
. I STAT="C" S STAT="F"
. S X=$G(DATA2TMP(63.05,FLD))
. Q:X=""
. S SUB=$P(X,"^",1),POS=$P(X,"^",2)
. I SUB,POS S $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,SUB),"^",POS)=STAT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRVRMI1 6314 printed Apr 09, 2024@21:08:37 Page 2
LRVRMI1 ;DALOI/STAFF - LAB MICRO HL7 INTERFACE ;Oct 29, 2008
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
+3 ; Extraction routine for the HL7 to Micro interface. It processes incoming HL7I data by extracting the results
+4 ; data from the ^LAH global and storing that data into a "workbench" (^TMP("LRMI"). The workbench has the same structure
+5 ; as the Lab Data micro file (#63.05). The first step in the process copies the instance of the Lab Data file in question
+6 ; into the Workbench.
+7 ;
+8 QUIT
+9 ;
EN ;
+1 ; First work through the LAH global to find entries to extract
+2 NEW PARA,PFLG,IEN,LROLD,LRNEW,LRSTATUS,LRSTORE,LWL,LRX
+3 ; Check to see if a lab area exists
+4 KILL ^TMP("LRMI",$JOB),^TMP("LRPL",$JOB)
+5 ;
+6 IF '$GET(LRLL)
Begin DoDot:1
+7 WRITE !,"No Load/Work List has been identified"
+8 SET LREND=1
End DoDot:1
QUIT
+9 ;
+10 SET LWL=LRLL
+11 ;
+12 DO SRCHEN
+13 SET IEN=$ORDER(^LAH(LWL,1,ISQN,"MI",99,""),-1)
+14 IF IEN
SET ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,99)=^LAH(LWL,1,ISQN,"MI",99,IEN,0)
+15 DO SETSTATS(.LRSTATUS)
+16 QUIT
+17 ;
+18 ;
SRCHEN ; This begins the search of LAH for new data
+1 NEW EOL,FID,ICN,LRIEN,LRNOW,LRTDFN,LRUID,ORCDT,ORDNLT,ORDP,PEB,PVB,SID
+2 ;
+3 SET ISQN=LRISQN
SET LRLEDI=1
SET LRNOW=$$NOW^XLFDT
+4 IF $PIECE(^LRO(68,$PIECE(^LAH(LWL,1,ISQN,0),U,3),0),U,2)'="MI"
QUIT
+5 DO HEAD^LRVRMI2
+6 DO ACCN
+7 KILL LRSTATUS
+8 SET ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,0)=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
+9 ;
+10 ; gram stain
+11 IF $DATA(^LAH(LWL,1,ISQN,"MI",2))
Begin DoDot:1
+12 NEW IEN
+13 SET IEN=0
+14 FOR
SET IEN=$ORDER(^LAH(LWL,1,ISQN,"MI",2,IEN))
if IEN<1
QUIT
Begin DoDot:2
+15 SET LRX=$GET(^LAH(LWL,1,ISQN,"MI",2,IEN,0,0))
+16 IF $PIECE(LRX,"^",5)'=""
DO BLDSTAT(11.5,$PIECE(LRX,"^",5))
End DoDot:2
+17 DO USERDT^LRVRMI1A(1,$GET(LRSTATUS(63.05,11.5)))
+18 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,2)=^LAH(LWL,1,ISQN,"MI",2)
End DoDot:1
+19 ;
+20 ; bacteria
+21 IF $DATA(^LAH(LWL,1,ISQN,"MI",3))
Begin DoDot:1
+22 NEW IEN
+23 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3)=^LAH(LWL,1,ISQN,"MI",3)
+24 SET IEN=0
+25 FOR
SET IEN=$ORDER(^LAH(LWL,1,ISQN,"MI",3,IEN))
if IEN<1
QUIT
Begin DoDot:2
+26 SET LRX=$GET(^LAH(LWL,1,ISQN,"MI",3,IEN,0,.01,0))
+27 IF $PIECE(LRX,"^")'=""
DO BLDSTAT(11.5,$PIECE(LRX,"^"))
End DoDot:2
+28 DO USERDT^LRVRMI1A(1,$GET(LRSTATUS(63.05,11.5)))
End DoDot:1
+29 ;
+30 ; bacteria remark
+31 IF $DATA(^LAH(LWL,1,ISQN,"MI",4))
Begin DoDot:1
+32 SET LRX=$GET(^LAH(LWL,1,ISQN,"MI",4,0))
+33 IF $PIECE(LRX,"^",4)'=""
DO BLDSTAT(11.5,$PIECE(LRX,"^",4))
+34 DO USERDT^LRVRMI1A(1,$GET(LRSTATUS(63.05,11.5)))
+35 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,4)=^LAH(LWL,1,ISQN,"MI",4)
End DoDot:1
+36 ;
+37 ; parasite
+38 IF $DATA(^LAH(LWL,1,ISQN,"MI",6))
Begin DoDot:1
+39 NEW IEN
+40 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,6)=^LAH(LWL,1,ISQN,"MI",6)
+41 SET IEN=0
+42 FOR
SET IEN=$ORDER(^LAH(LWL,1,ISQN,"MI",6,IEN))
if IEN<1
QUIT
Begin DoDot:2
+43 SET LRX=$GET(^LAH(LWL,1,ISQN,"MI",6,IEN,0,.01,0))
+44 IF $PIECE(LRX,"^")'=""
DO BLDSTAT(15,$PIECE(LRX,"^"))
End DoDot:2
+45 DO USERDT^LRVRMI1A(5,$GET(LRSTATUS(63.05,15)))
End DoDot:1
+46 ;
+47 ; parasite remark
+48 IF $DATA(^LAH(LWL,1,ISQN,"MI",7))
Begin DoDot:1
+49 SET LRX=$GET(^LAH(LWL,1,ISQN,"MI",7,0))
+50 IF $PIECE(LRX,"^",4)'=""
DO BLDSTAT(15,$PIECE(LRX,"^",4))
+51 DO USERDT^LRVRMI1A(5,$GET(LRSTATUS(63.05,15)))
+52 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,7)=^LAH(LWL,1,ISQN,"MI",7)
End DoDot:1
+53 ;
+54 ; mycology date approved
+55 IF $DATA(^LAH(LWL,1,ISQN,"MI",8))
MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,8)=^LAH(LWL,1,ISQN,"MI",8)
+56 ;
+57 ; fungus/yeast
+58 IF $DATA(^LAH(LWL,1,ISQN,"MI",9))
Begin DoDot:1
+59 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,9)=^LAH(LWL,1,ISQN,"MI",9)
+60 SET IEN=0
+61 FOR
SET IEN=$ORDER(^LAH(LWL,1,ISQN,"MI",9,IEN))
if 'IEN
QUIT
Begin DoDot:2
+62 SET LRX=$GET(^LAH(LWL,1,ISQN,"MI",9,IEN,0,.01,0))
+63 IF $PIECE(LRX,"^")'=""
DO BLDSTAT(19,$PIECE(LRX,"^"))
End DoDot:2
+64 DO USERDT^LRVRMI1A(8,$GET(LRSTATUS(63.05,19)))
End DoDot:1
+65 ;
+66 ; mycology remarks
+67 IF $DATA(^LAH(LWL,1,ISQN,"MI",10))
Begin DoDot:1
+68 SET LRX=$GET(^LAH(LWL,1,ISQN,"MI",10,0))
+69 IF $PIECE(LRX,"^",4)'=""
DO BLDSTAT(19,$PIECE(LRX,"^",4))
+70 DO USERDT^LRVRMI1A(8,$GET(LRSTATUS(63.05,19)))
+71 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,10)=^LAH(LWL,1,ISQN,"MI",10)
End DoDot:1
+72 ;
+73 ; TB Date approved, etc.
+74 IF $DATA(^LAH(LWL,1,ISQN,"MI",11))
Begin DoDot:1
+75 NEW AFS,AFQ
+76 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,11)=^LAH(LWL,1,ISQN,"MI",11)
+77 SET LRX=$GET(^LAH(LWL,1,ISQN,"MI",11,0))
SET AFS=$PIECE(LRX,"^",3)
SET AFQ=$PIECE(LRX,"^",4)
+78 SET $PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,11),U,3)=AFS
+79 SET $PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,11),U,4)=AFQ
+80 IF AFS'=""
Begin DoDot:2
+81 SET LRX=$GET(^LAH(LWL,1,ISQN,"MI",11,0,.01,0))
+82 IF $PIECE(LRX,"^")'=""
DO BLDSTAT(23,$PIECE(LRX,"^"))
End DoDot:2
+83 IF AFQ'=""
Begin DoDot:2
+84 SET LRX=$GET(^LAH(LWL,1,ISQN,"MI",11,0,.02,0))
+85 IF $PIECE(LRX,"^")'=""
DO BLDSTAT(23,$PIECE(LRX,"^"))
End DoDot:2
+86 DO USERDT^LRVRMI1A(11,$GET(LRSTATUS(63.05,23)))
End DoDot:1
+87 ;
+88 ; mycobacteria organism
+89 IF $DATA(^LAH(LWL,1,ISQN,"MI",12))
Begin DoDot:1
+90 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12)=^LAH(LWL,1,ISQN,"MI",12)
+91 SET LRIEN=0
+92 FOR
SET LRIEN=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,LRIEN))
if 'LRIEN
QUIT
Begin DoDot:2
+93 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,LRIEN,0,.01,0))
+94 IF $PIECE(LRX,"^")'=""
DO BLDSTAT(23,$PIECE(LRX,"^"))
End DoDot:2
+95 DO USERDT^LRVRMI1A(11,$GET(LRSTATUS(63.05,23)))
End DoDot:1
+96 ;
+97 ; TB remark
+98 IF $DATA(^LAH(LWL,1,ISQN,"MI",13))
Begin DoDot:1
+99 MERGE ^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,13)=^LAH(LWL,1,ISQN,"MI",13)
+100 SET LRX=$GET(^LAH(LWL,1,ISQN,"MI",13,0))
+101 IF $PIECE(LRX,"^",4)'=""
DO BLDSTAT(23,$PIECE(LRX,"^",4))
+102 DO USERDT^LRVRMI1A(11,$GET(LRSTATUS(63.05,23)))
End DoDot:1
+103 ;
+104 DO SRCHEN2^LRVRMI1A
+105 QUIT
+106 ;
+107 ;
ACCN ; Get the LRIDT
+1 SET LRIDT=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,5)
+2 QUIT
+3 ;
+4 ;
MAKEISO(LR4,ISOID) ;
+1 ; Creates the "unique id" portion for an isolate id
+2 ; Inputs
+3 ; LR4 : File #4 IEN
+4 ; ISOID : Isolate ID
+5 ; Output
+6 ; "99VA4:"_#4 info_":"_ISOID
+7 ;
+8 NEW LRNVAF,LRY
+9 if $TRANSLATE(ISOID," ","")=""
QUIT ISOID
+10 IF ISOID?1"99VA4:"0.E1":"0.E
QUIT ISOID
+11 SET LRNVAF=$$NVAF^LA7VHLU2(LR4)
+12 SET LRY=$$ID^XUAF4($SELECT(LRNVAF=1:"DMIS",LRNVAF=2:"ASUFAC",1:"VASTANUM"),LR4)
+13 IF LRY=""
Begin DoDot:1
+14 ;default institution IEN
SET LRY=$$KSP^XUPARAM("INST")
+15 SET LRY=$$NS^XUAF4(LRY)
+16 SET LRY=$PIECE(LRY,"^",2)
+17 SET LRY=LRY_"#"_LR4
End DoDot:1
+18 QUIT "99VA4:"_LRY_":"_ISOID
+19 ;
+20 ;
BLDSTAT(FLD,VAL) ;
+1 ; Convenience method
+2 DO BLDSTAT^LRVRMI4A(63.05,FLD,VAL,.LRSTATUS)
+3 QUIT
+4 ;
+5 ;
SETSTATS(DATA) ;
+1 ; Goes thru DATA array and sets the status(es)
+2 ; Inputs
+3 ; DATA <byref> : DATA(file#,field#)=status ie DATA(63.05,19)="P"
+4 ;
+5 NEW NODE,FN,FLD,STAT,DATA2TMP,X,SUB,POS
+6 ;SUB^POS
SET DATA2TMP(63.05,11.5)="1^2"
+7 SET DATA2TMP(63.05,15)="5^2"
+8 SET DATA2TMP(63.05,19)="8^2"
+9 SET DATA2TMP(63.05,23)="11^2"
+10 SET DATA2TMP(63.05,34)="16^2"
+11 SET NODE="DATA(0)"
+12 ;
FOR
SET NODE=$QUERY(@NODE)
if NODE=""
QUIT
Begin DoDot:1
+13 SET FN=$QSUBSCRIPT(NODE,1)
+14 SET FLD=$QSUBSCRIPT(NODE,2)
+15 SET STAT=DATA(FN,FLD)
+16 IF STAT="C"
SET STAT="F"
+17 SET X=$GET(DATA2TMP(63.05,FLD))
+18 if X=""
QUIT
+19 SET SUB=$PIECE(X,"^",1)
SET POS=$PIECE(X,"^",2)
+20 IF SUB
IF POS
SET $PIECE(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,SUB),"^",POS)=STAT
End DoDot:1
+21 QUIT
