- LRPXSXRA ; SLC/PKR - Build indexes for Lab Anatomic Path. ;10/9/03 14:24
- ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
- Q
- ;===============================================================
- AP ; from LRPXSXRL
- ;Build the indexes for LAB DATA - ANATOMIC PATHOLOGY.
- N ANUMS,DATE,DFN,END,ENTRIES,ETIOL,GLOBAL,I,II,III,ICD,ICDX,IND,ITEM
- N LRDFN,ORGAN,NE,NERROR,NODE,SNOMED,SPEC,START,SUB,SUBS,TEMP,TENP,TEXT
- K ANUMS
- ;Dont leave any old stuff around.
- S GLOBAL=$$GET1^DID(63,"","","GLOBAL NAME")_"""AP"")"
- S ENTRIES=$P(^LR(0),U,4)
- S TENP=ENTRIES/10
- S TENP=+$P(TENP,".",1)
- I TENP<1 S TENP=1
- D BMES^XPDUTL("Building indexes for LAB DATA - ANATOMIC PATH")
- S TEXT="There are "_ENTRIES_" entries to process."
- D MES^XPDUTL(TEXT)
- S START=$H
- S (IND,NE,NERROR)=0
- D AANUMS^LRPXSXRB(.ANUMS)
- S LRDFN=.9
- F S LRDFN=$O(^LR(LRDFN)) Q:LRDFN<1 D
- . S TEMP=$G(^LR(LRDFN,0))
- . I $P(TEMP,U,2)'=2 Q
- . S DFN=+$P(TEMP,U,3)
- . I LRDFN'=$$LRDFN^LRPXAPIU(DFN) Q
- . S IND=IND+1
- . I IND#TENP=0 D
- .. S TEXT="Processing entry "_IND
- .. D MES^XPDUTL(TEXT)
- . D CYEMSP(LRDFN,DFN,.ANUMS) ; cytology, electron microscopy, sugrical path
- . S DATE=$$DOD^LRPXAPIU(DFN) I 'DATE Q ; date of death
- . I '+$G(^LR(LRDFN,"AU")) Q ; date of autopsy
- . I '($P(^LR(LRDFN,"AU"),U,3)&($P(^("AU"),U,15))) Q ; autopsy comp/released
- . S SPEC=0
- . F S SPEC=$O(^LR(LRDFN,33,SPEC)) Q:SPEC<1 D
- .. I '$L($P($G(^LR(LRDFN,33,SPEC,0)),U)) Q
- .. S ITEM="A;S;1."_$$UP($P(^LR(LRDFN,33,SPEC,0),U))
- .. S NODE=LRDFN_";33;"_SPEC_";0"
- .. D APSET(DFN,ITEM,DATE,NODE)
- . S ICD=0
- . F S ICD=$O(^LR(LRDFN,80,ICD)) Q:ICD<1 D
- .. S ICDX=+$G(^LR(LRDFN,80,ICD,0))
- .. I 'ICDX Q
- .. S ITEM="A;I;"_ICDX
- .. S NODE=LRDFN_";80;"_ICD_";0"
- .. D APSET(DFN,ITEM,DATE,NODE)
- . S I=0
- . F S I=$O(^LR(LRDFN,"AY",I)) Q:I<1 D
- .. S ORGAN=+$G(^LR(LRDFN,"AY",I,0))
- .. I 'ORGAN Q
- .. S ITEM="A;O;"_ORGAN
- .. S NODE=LRDFN_";AY;"_I_";0"
- .. D APSET(DFN,ITEM,DATE,NODE)
- .. F SUBS="1D","2M","3F","4P" D
- ... S SUB=+SUBS
- ... S II=0
- ... F S II=$O(^LR(LRDFN,"AY",I,SUB,II)) Q:II<1 D
- .... S SNOMED=+$G(^LR(LRDFN,"AY",I,SUB,II,0))
- .... I 'SNOMED Q
- .... S ITEM="A;"_$E(SUBS,2)_";"_SNOMED
- .... S NODE=LRDFN_";AY;"_I_";"_SUB_";"_II_";0"
- .... D APSET(DFN,ITEM,DATE,NODE)
- .... I SUB'=2 Q
- .... S III=0
- .... F S III=$O(^LR(LRDFN,"AY",I,SUB,II,1,III)) Q:III<1 D
- ..... S ETIOL=+$G(^LR(LRDFN,"AY",I,SUB,II,1,III,0))
- ..... I 'ETIOL Q
- ..... S ITEM="A;E;"_ETIOL
- ..... S NODE=LRDFN_";AY;"_I_";"_SUB_";"_II_";1;"_III_";0"
- ..... D APSET(DFN,ITEM,DATE,NODE)
- S TEXT=NE_" LAB DATA (AP) results indexed."
- D MES^XPDUTL(TEXT)
- S END=$H
- D DETIME^PXRMSXRM(START,END) ; dbia 4113
- ;If there were errors send a message.
- I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL) ; dbia 4113
- ;Send a MailMan message with the results.
- D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR) ; dbia 4113
- Q
- ;
- CYEMSP(LRDFN,DFN,ANUMS) ;
- N ACC,APSUB,DATE,ERR,I,ICD,ICDX,ITEM,LRIDT,NODE,ORGAN,PREP,SPEC
- N TEST,TESTS K TESTS
- F APSUB="CY","EM","SP" D
- . I '$D(^LR(LRDFN,APSUB,0)) Q
- . S LRIDT=0
- . F S LRIDT=$O(^LR(LRDFN,APSUB,LRIDT)) Q:LRIDT<1 D
- .. S DATE=+$G(^LR(LRDFN,APSUB,LRIDT,0))
- .. I 'DATE Q
- .. S DATE=9999999-LRIDT ; use for multiple entries on a date
- .. I '($P(^LR(LRDFN,APSUB,LRIDT,0),U,3)&($P(^(0),U,11))) Q
- .. S SPEC=0
- .. F S SPEC=$O(^LR(LRDFN,APSUB,LRIDT,.1,SPEC)) Q:SPEC<1 D
- ... I '$L($P($G(^LR(LRDFN,APSUB,LRIDT,.1,SPEC,0)),U)) Q
- ... S ITEM="A;S;1."_$$UP($P(^LR(LRDFN,APSUB,LRIDT,.1,SPEC,0),U))
- ... S NODE=LRDFN_";"_APSUB_";"_LRIDT_";.1;"_SPEC_";0"
- ... D APSET(DFN,ITEM,DATE,NODE)
- ... S PREP=0
- ... F S PREP=$O(^LR(LRDFN,APSUB,LRIDT,.1,SPEC,1,PREP)) Q:PREP<1 D
- .... S TEST=0
- .... F S TEST=$O(^LR(LRDFN,APSUB,LRIDT,.1,SPEC,1,PREP,1,TEST)) Q:TEST<1 D
- ..... S TEST=+$G(^LR(LRDFN,APSUB,LRIDT,.1,SPEC,1,PREP,1,TEST,0))
- ..... I 'TEST Q
- ..... S ITEM="A;T;"_TEST
- ..... S NODE=LRDFN_";"_APSUB_";"_LRIDT_";.1;"_SPEC_";1;"_PREP_";1;"_TEST_";0"
- ..... D APSET(DFN,ITEM,DATE,NODE)
- .. ; S ACC=$P(^LR(LRDFN,APSUB,LRIDT,0),U,6) ; do not use tests from acc
- .. ; I $L(ACC) D
- .. ; . S NODE=LRDFN_";"_APSUB_";"_LRIDT_";0"
- .. ; . D ACC^LRPXSXRB(.TESTS,ACC,DATE,.ANUMS,.ERR)
- .. ; . I 'ERR D
- .. ; .. S TEST=0
- .. ; .. F S TEST=$O(TESTS(TEST)) Q:TEST<1 D
- .. ; ... S ITEM="A;T;"_TEST
- .. ; ... D APSET(DFN,ITEM,DATE,NODE)
- .. S ICD=0
- .. F S ICD=$O(^LR(LRDFN,APSUB,LRIDT,3,ICD)) Q:ICD<1 D
- ... S ICDX=+$G(^LR(LRDFN,APSUB,LRIDT,3,ICD,0))
- ... I 'ICDX Q
- ... S ITEM="A;I;"_ICDX
- ... S NODE=LRDFN_";"_APSUB_";"_LRIDT_";3;"_ICD_";0"
- ... D APSET(DFN,ITEM,DATE,NODE)
- .. S I=0
- .. F S I=$O(^LR(LRDFN,APSUB,LRIDT,2,I)) Q:I<1 D
- ... S ORGAN=+$G(^LR(LRDFN,APSUB,LRIDT,2,I,0))
- ... I 'ORGAN Q
- ... S ITEM="A;O;"_ORGAN
- ... S NODE=LRDFN_";"_APSUB_";"_LRIDT_";2;"_I_";0"
- ... D APSET(DFN,ITEM,DATE,NODE)
- ... D SNOMED(LRDFN,DFN,LRIDT,DATE,APSUB,I)
- Q
- ;
- SNOMED(LRDFN,DFN,LRIDT,DATE,APSUB,I) ;
- N ETIOL,II,III,ITEM,NODE,SNOMED,SUB,SUBS
- F SUBS="1D","2M","3F","4P" D
- . S SUB=+SUBS
- . S II=0
- . F S II=$O(^LR(LRDFN,APSUB,LRIDT,2,I,SUB,II)) Q:II<1 D
- .. S SNOMED=+$G(^LR(LRDFN,APSUB,LRIDT,2,I,SUB,II,0))
- .. I 'SNOMED Q
- .. S ITEM="A;"_$E(SUBS,2)_";"_SNOMED
- .. S NODE=LRDFN_";"_APSUB_";"_LRIDT_";2;"_I_";"_SUB_";"_II_";0"
- .. D APSET(DFN,ITEM,DATE,NODE)
- .. I SUB'=2 Q
- .. S III=0
- .. F S III=$O(^LR(LRDFN,APSUB,LRIDT,2,I,SUB,II,1,III)) Q:III<1 D
- ... S ETIOL=+$G(^LR(LRDFN,APSUB,LRIDT,2,I,SUB,II,1,III,0))
- ... I 'ETIOL Q
- ... S ITEM="A;E;"_ETIOL
- ... S NODE=LRDFN_";"_APSUB_";"_LRIDT_";2;"_I_";"_SUB_";"_II_";1;"_III_";0"
- ... D APSET(DFN,ITEM,DATE,NODE)
- Q
- ;
- UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- ;
- APSET(DFN,ITEM,DATE,NODE) ;
- I '$P(ITEM,";",3) D
- . N ETEXT
- . S ETEXT=NODE_" missing test"
- . D ADDERROR^PXRMSXRM("LR(AP",ETEXT,.NERROR) ; dbia 4113
- E D
- . D SLAB^LRPX(DFN,DATE,ITEM,NODE)
- . S NE=NE+1
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRPXSXRA 5930 printed Apr 23, 2025@18:33:42 Page 2
- LRPXSXRA ; SLC/PKR - Build indexes for Lab Anatomic Path. ;10/9/03 14:24
- +1 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
- +2 QUIT
- +3 ;===============================================================
- AP ; from LRPXSXRL
- +1 ;Build the indexes for LAB DATA - ANATOMIC PATHOLOGY.
- +2 NEW ANUMS,DATE,DFN,END,ENTRIES,ETIOL,GLOBAL,I,II,III,ICD,ICDX,IND,ITEM
- +3 NEW LRDFN,ORGAN,NE,NERROR,NODE,SNOMED,SPEC,START,SUB,SUBS,TEMP,TENP,TEXT
- +4 KILL ANUMS
- +5 ;Dont leave any old stuff around.
- +6 SET GLOBAL=$$GET1^DID(63,"","","GLOBAL NAME")_"""AP"")"
- +7 SET ENTRIES=$PIECE(^LR(0),U,4)
- +8 SET TENP=ENTRIES/10
- +9 SET TENP=+$PIECE(TENP,".",1)
- +10 IF TENP<1
- SET TENP=1
- +11 DO BMES^XPDUTL("Building indexes for LAB DATA - ANATOMIC PATH")
- +12 SET TEXT="There are "_ENTRIES_" entries to process."
- +13 DO MES^XPDUTL(TEXT)
- +14 SET START=$HOROLOG
- +15 SET (IND,NE,NERROR)=0
- +16 DO AANUMS^LRPXSXRB(.ANUMS)
- +17 SET LRDFN=.9
- +18 FOR
- SET LRDFN=$ORDER(^LR(LRDFN))
- if LRDFN<1
- QUIT
- Begin DoDot:1
- +19 SET TEMP=$GET(^LR(LRDFN,0))
- +20 IF $PIECE(TEMP,U,2)'=2
- QUIT
- +21 SET DFN=+$PIECE(TEMP,U,3)
- +22 IF LRDFN'=$$LRDFN^LRPXAPIU(DFN)
- QUIT
- +23 SET IND=IND+1
- +24 IF IND#TENP=0
- Begin DoDot:2
- +25 SET TEXT="Processing entry "_IND
- +26 DO MES^XPDUTL(TEXT)
- End DoDot:2
- +27 ; cytology, electron microscopy, sugrical path
- DO CYEMSP(LRDFN,DFN,.ANUMS)
- +28 ; date of death
- SET DATE=$$DOD^LRPXAPIU(DFN)
- IF 'DATE
- QUIT
- +29 ; date of autopsy
- IF '+$GET(^LR(LRDFN,"AU"))
- QUIT
- +30 ; autopsy comp/released
- IF '($PIECE(^LR(LRDFN,"AU"),U,3)&($PIECE(^("AU"),U,15)))
- QUIT
- +31 SET SPEC=0
- +32 FOR
- SET SPEC=$ORDER(^LR(LRDFN,33,SPEC))
- if SPEC<1
- QUIT
- Begin DoDot:2
- +33 IF '$LENGTH($PIECE($GET(^LR(LRDFN,33,SPEC,0)),U))
- QUIT
- +34 SET ITEM="A;S;1."_$$UP($PIECE(^LR(LRDFN,33,SPEC,0),U))
- +35 SET NODE=LRDFN_";33;"_SPEC_";0"
- +36 DO APSET(DFN,ITEM,DATE,NODE)
- End DoDot:2
- +37 SET ICD=0
- +38 FOR
- SET ICD=$ORDER(^LR(LRDFN,80,ICD))
- if ICD<1
- QUIT
- Begin DoDot:2
- +39 SET ICDX=+$GET(^LR(LRDFN,80,ICD,0))
- +40 IF 'ICDX
- QUIT
- +41 SET ITEM="A;I;"_ICDX
- +42 SET NODE=LRDFN_";80;"_ICD_";0"
- +43 DO APSET(DFN,ITEM,DATE,NODE)
- End DoDot:2
- +44 SET I=0
- +45 FOR
- SET I=$ORDER(^LR(LRDFN,"AY",I))
- if I<1
- QUIT
- Begin DoDot:2
- +46 SET ORGAN=+$GET(^LR(LRDFN,"AY",I,0))
- +47 IF 'ORGAN
- QUIT
- +48 SET ITEM="A;O;"_ORGAN
- +49 SET NODE=LRDFN_";AY;"_I_";0"
- +50 DO APSET(DFN,ITEM,DATE,NODE)
- +51 FOR SUBS="1D","2M","3F","4P"
- Begin DoDot:3
- +52 SET SUB=+SUBS
- +53 SET II=0
- +54 FOR
- SET II=$ORDER(^LR(LRDFN,"AY",I,SUB,II))
- if II<1
- QUIT
- Begin DoDot:4
- +55 SET SNOMED=+$GET(^LR(LRDFN,"AY",I,SUB,II,0))
- +56 IF 'SNOMED
- QUIT
- +57 SET ITEM="A;"_$EXTRACT(SUBS,2)_";"_SNOMED
- +58 SET NODE=LRDFN_";AY;"_I_";"_SUB_";"_II_";0"
- +59 DO APSET(DFN,ITEM,DATE,NODE)
- +60 IF SUB'=2
- QUIT
- +61 SET III=0
- +62 FOR
- SET III=$ORDER(^LR(LRDFN,"AY",I,SUB,II,1,III))
- if III<1
- QUIT
- Begin DoDot:5
- +63 SET ETIOL=+$GET(^LR(LRDFN,"AY",I,SUB,II,1,III,0))
- +64 IF 'ETIOL
- QUIT
- +65 SET ITEM="A;E;"_ETIOL
- +66 SET NODE=LRDFN_";AY;"_I_";"_SUB_";"_II_";1;"_III_";0"
- +67 DO APSET(DFN,ITEM,DATE,NODE)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +68 SET TEXT=NE_" LAB DATA (AP) results indexed."
- +69 DO MES^XPDUTL(TEXT)
- +70 SET END=$HOROLOG
- +71 ; dbia 4113
- DO DETIME^PXRMSXRM(START,END)
- +72 ;If there were errors send a message.
- +73 ; dbia 4113
- IF NERROR>0
- DO ERRMSG^PXRMSXRM(NERROR,GLOBAL)
- +74 ;Send a MailMan message with the results.
- +75 ; dbia 4113
- DO COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
- +76 QUIT
- +77 ;
- CYEMSP(LRDFN,DFN,ANUMS) ;
- +1 NEW ACC,APSUB,DATE,ERR,I,ICD,ICDX,ITEM,LRIDT,NODE,ORGAN,PREP,SPEC
- +2 NEW TEST,TESTS
- KILL TESTS
- +3 FOR APSUB="CY","EM","SP"
- Begin DoDot:1
- +4 IF '$DATA(^LR(LRDFN,APSUB,0))
- QUIT
- +5 SET LRIDT=0
- +6 FOR
- SET LRIDT=$ORDER(^LR(LRDFN,APSUB,LRIDT))
- if LRIDT<1
- QUIT
- Begin DoDot:2
- +7 SET DATE=+$GET(^LR(LRDFN,APSUB,LRIDT,0))
- +8 IF 'DATE
- QUIT
- +9 ; use for multiple entries on a date
- SET DATE=9999999-LRIDT
- +10 IF '($PIECE(^LR(LRDFN,APSUB,LRIDT,0),U,3)&($PIECE(^(0),U,11)))
- QUIT
- +11 SET SPEC=0
- +12 FOR
- SET SPEC=$ORDER(^LR(LRDFN,APSUB,LRIDT,.1,SPEC))
- if SPEC<1
- QUIT
- Begin DoDot:3
- +13 IF '$LENGTH($PIECE($GET(^LR(LRDFN,APSUB,LRIDT,.1,SPEC,0)),U))
- QUIT
- +14 SET ITEM="A;S;1."_$$UP($PIECE(^LR(LRDFN,APSUB,LRIDT,.1,SPEC,0),U))
- +15 SET NODE=LRDFN_";"_APSUB_";"_LRIDT_";.1;"_SPEC_";0"
- +16 DO APSET(DFN,ITEM,DATE,NODE)
- +17 SET PREP=0
- +18 FOR
- SET PREP=$ORDER(^LR(LRDFN,APSUB,LRIDT,.1,SPEC,1,PREP))
- if PREP<1
- QUIT
- Begin DoDot:4
- +19 SET TEST=0
- +20 FOR
- SET TEST=$ORDER(^LR(LRDFN,APSUB,LRIDT,.1,SPEC,1,PREP,1,TEST))
- if TEST<1
- QUIT
- Begin DoDot:5
- +21 SET TEST=+$GET(^LR(LRDFN,APSUB,LRIDT,.1,SPEC,1,PREP,1,TEST,0))
- +22 IF 'TEST
- QUIT
- +23 SET ITEM="A;T;"_TEST
- +24 SET NODE=LRDFN_";"_APSUB_";"_LRIDT_";.1;"_SPEC_";1;"_PREP_";1;"_TEST_";0"
- +25 DO APSET(DFN,ITEM,DATE,NODE)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- +26 ; S ACC=$P(^LR(LRDFN,APSUB,LRIDT,0),U,6) ; do not use tests from acc
- +27 ; I $L(ACC) D
- +28 ; . S NODE=LRDFN_";"_APSUB_";"_LRIDT_";0"
- +29 ; . D ACC^LRPXSXRB(.TESTS,ACC,DATE,.ANUMS,.ERR)
- +30 ; . I 'ERR D
- +31 ; .. S TEST=0
- +32 ; .. F S TEST=$O(TESTS(TEST)) Q:TEST<1 D
- +33 ; ... S ITEM="A;T;"_TEST
- +34 ; ... D APSET(DFN,ITEM,DATE,NODE)
- +35 SET ICD=0
- +36 FOR
- SET ICD=$ORDER(^LR(LRDFN,APSUB,LRIDT,3,ICD))
- if ICD<1
- QUIT
- Begin DoDot:3
- +37 SET ICDX=+$GET(^LR(LRDFN,APSUB,LRIDT,3,ICD,0))
- +38 IF 'ICDX
- QUIT
- +39 SET ITEM="A;I;"_ICDX
- +40 SET NODE=LRDFN_";"_APSUB_";"_LRIDT_";3;"_ICD_";0"
- +41 DO APSET(DFN,ITEM,DATE,NODE)
- End DoDot:3
- +42 SET I=0
- +43 FOR
- SET I=$ORDER(^LR(LRDFN,APSUB,LRIDT,2,I))
- if I<1
- QUIT
- Begin DoDot:3
- +44 SET ORGAN=+$GET(^LR(LRDFN,APSUB,LRIDT,2,I,0))
- +45 IF 'ORGAN
- QUIT
- +46 SET ITEM="A;O;"_ORGAN
- +47 SET NODE=LRDFN_";"_APSUB_";"_LRIDT_";2;"_I_";0"
- +48 DO APSET(DFN,ITEM,DATE,NODE)
- +49 DO SNOMED(LRDFN,DFN,LRIDT,DATE,APSUB,I)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +50 QUIT
- +51 ;
- SNOMED(LRDFN,DFN,LRIDT,DATE,APSUB,I) ;
- +1 NEW ETIOL,II,III,ITEM,NODE,SNOMED,SUB,SUBS
- +2 FOR SUBS="1D","2M","3F","4P"
- Begin DoDot:1
- +3 SET SUB=+SUBS
- +4 SET II=0
- +5 FOR
- SET II=$ORDER(^LR(LRDFN,APSUB,LRIDT,2,I,SUB,II))
- if II<1
- QUIT
- Begin DoDot:2
- +6 SET SNOMED=+$GET(^LR(LRDFN,APSUB,LRIDT,2,I,SUB,II,0))
- +7 IF 'SNOMED
- QUIT
- +8 SET ITEM="A;"_$EXTRACT(SUBS,2)_";"_SNOMED
- +9 SET NODE=LRDFN_";"_APSUB_";"_LRIDT_";2;"_I_";"_SUB_";"_II_";0"
- +10 DO APSET(DFN,ITEM,DATE,NODE)
- +11 IF SUB'=2
- QUIT
- +12 SET III=0
- +13 FOR
- SET III=$ORDER(^LR(LRDFN,APSUB,LRIDT,2,I,SUB,II,1,III))
- if III<1
- QUIT
- Begin DoDot:3
- +14 SET ETIOL=+$GET(^LR(LRDFN,APSUB,LRIDT,2,I,SUB,II,1,III,0))
- +15 IF 'ETIOL
- QUIT
- +16 SET ITEM="A;E;"_ETIOL
- +17 SET NODE=LRDFN_";"_APSUB_";"_LRIDT_";2;"_I_";"_SUB_";"_II_";1;"_III_";0"
- +18 DO APSET(DFN,ITEM,DATE,NODE)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +19 QUIT
- +20 ;
- UP(X) QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- +1 ;
- APSET(DFN,ITEM,DATE,NODE) ;
- +1 IF '$PIECE(ITEM,";",3)
- Begin DoDot:1
- +2 NEW ETEXT
- +3 SET ETEXT=NODE_" missing test"
- +4 ; dbia 4113
- DO ADDERROR^PXRMSXRM("LR(AP",ETEXT,.NERROR)
- End DoDot:1
- +5 IF '$TEST
- Begin DoDot:1
- +6 DO SLAB^LRPX(DFN,DATE,ITEM,NODE)
- +7 SET NE=NE+1
- End DoDot:1
- +8 QUIT
- +9 ;
