LA7SRPT3 ;DALOI/JDB - CODE USAGE REPORT (cont) ;03/07/12 09:21
;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
;
Q
;
F61(CODE,SYS,FOUND) ;
; (private method for LA7SRPT2)
N NODE,NODE1,POS,R61,STATUS
S CODE=$G(CODE)
S SYS=$G(SYS)
K FOUND
Q:CODE="" 0
Q:SYS="" 0
S STATUS=0
S (NODE,NODE1)=""
I SYS="SCT" D ;
. S (NODE,NODE1)="^LAB(61,""F"","_CODE_")"
. S POS("R61")=4
;
I NODE="" Q 0
S NODE1=$$TRIM^XLFSTR(NODE1,"R",")")
S NODE1=$TR(NODE1,"""","")
F S NODE=$Q(@NODE) Q:$E($TR(NODE,"""",""),1,$L(NODE1))'=NODE1 D ;
. S R61=$QS(NODE,POS("R61"))
. S FOUND(1,R61)=""
. S STATUS=1
Q STATUS
;
F612(CODE,SYS,FOUND) ;
; (private method for LA7SRPT2)
N NODE,NODE1,POS,R612,STATUS
S CODE=$G(CODE)
S SYS=$G(SYS)
K FOUND
Q:CODE="" 0
Q:SYS="" 0
S STATUS=0
S (NODE,NODE1)=""
I SYS="SCT" D ;
. S (NODE,NODE1)="^LAB(61.2,""F"","_CODE_")"
. S POS("R612")=4
;
I NODE="" Q 0
S NODE1=$$TRIM^XLFSTR(NODE1,"R",")")
S NODE1=$TR(NODE1,"""","")
F S NODE=$Q(@NODE) Q:$E($TR(NODE,"""",""),1,$L(NODE1))'=NODE1 D ;
. S R612=$QS(NODE,POS("R612"))
. S FOUND(1,R612)=""
. S STATUS=1
Q STATUS
;
F62(CODE,SYS,FOUND) ;
; (private method for LA7SRPT2)
N NODE,NODE1,POS,R62,STATUS
S CODE=$G(CODE)
S SYS=$G(SYS)
K FOUND
Q:CODE="" 0
Q:SYS="" 0
S STATUS=0
S (NODE,NODE1)=""
I SYS="SCT" D ;
. S (NODE,NODE1)="^LAB(62,""F"","_CODE_")"
. S POS("R62")=4
;
I NODE="" Q 0
S NODE1=$$TRIM^XLFSTR(NODE1,"R",")")
S NODE1=$TR(NODE1,"""","")
F S NODE=$Q(@NODE) Q:$E($TR(NODE,"""",""),1,$L(NODE1))'=NODE1 D ;
. S R62=$QS(NODE,POS("R62"))
. S FOUND(1,R62)=""
. S STATUS=1
Q STATUS
;
F6206(CODE,SYS,FOUND) ;
; (private method for LA7SRPT2)
N NODE,NODE1,POS,R64,R953,R6206,STATUS,DATA,X
S CODE=$G(CODE)
S SYS=$G(SYS)
K FOUND
Q:CODE="" 0
Q:SYS="" 0
S STATUS=0
Q:SYS'="LN" 0
S (NODE,NODE1)=""
S R64=0
F S R64=$O(^LAM("AH",$P(CODE,"-",1),R64)) Q:'R64 D ;
. S DATA=$G(^LAM(R64,9))
. S X=$P(DATA,U,1)
. Q:X=""
. S R953=X
. S R6206=0
. F S R6206=$O(^LAB(62.06,R6206)) Q:'R6206 D ;
. . S DATA=$G(^LAB(62.06,R6206,64))
. . S X=$P(DATA,U,1) ;NATL VA CODE
. . Q:X'=R64
. . S STATUS=1
. . S FOUND(1,R6206)=""
. ;
Q STATUS
;
F6247(CODE,SYS,FOUND,MSGCFG) ;
; (private method for LA7SRPT2)
N NODE,NODE1,POS,R6247,R624701,R6248,STATUS,DATA
S CODE=$G(CODE)
S SYS=$G(SYS)
S MSGCFG=+$G(MSGCFG)
K FOUND
Q:CODE="" 0
Q:SYS="" 0
S STATUS=0
S (NODE,NODE1)=""
S (NODE,NODE1)="^LAB(62.47,""AF"","""_SYS_""","""_CODE_""")"
S POS("R6247")=5
S POS("R624701")=6
;
I NODE="" Q 0
S NODE1=$$TRIM^XLFSTR(NODE1,"R",")")
S NODE1=$TR(NODE1,"""","")
F S NODE=$Q(@NODE) Q:$E($TR(NODE,"""",""),1,$L(NODE1))'=NODE1 D ;
. S R6247=$QS(NODE,POS("R6247"))
. S R624701=$QS(NODE,POS("R624701"))
. S DATA=$G(^LAB(62.47,R6247,1,R624701,2,0))
. S R6248=$P(DATA,U,2)
. I MSGCFG I R6248'=MSGCFG Q ;
. S FOUND(1,R6247,R624701)=""
. S STATUS=1
Q STATUS
;
F6248(CODE,SYS,FOUND,MSGCFG) ;
; Loop through all
; ^LAHM(62.48,DA(1),"SCT","AD",CODE,VARPTR,DA)
; #62.48 only supports SCT code sets
; (private method for LA7SRPT2)
N NODE,NODE1,POS,R6248,R624802,STATUS,D61,D62,X,DATA,REC,FILE
S CODE=$G(CODE)
S SYS=$G(SYS)
S MSGCFG=+$G(MSGCFG)
K FOUND
Q:CODE="" 0
Q:SYS="" 0
Q:SYS'="SCT" 0
S STATUS=0
S (NODE,NODE1)=""
S POS("R6248")=2
S POS("X")=6
S POS("R624802")=7
;
; Is SCT code in #61 or #62
S X=$$F61(CODE,"SCT",.D61)
S X=$$F62(CODE,"SCT",.D62)
;
; #62.482 fld #.01 (VA FILE ENTRY) point to entry with the SCT?
S R6248=0
I MSGCFG S R6248=MSGCFG-1
F S R6248=$O(^LAHM(62.48,R6248)) Q:'R6248 Q:MSGCFG&(R6248'=MSGCFG) D ;
. S R624802=0
. F S R624802=$O(^LAHM(62.48,R6248,"SCT",R624802)) Q:'R624802 D ;
. . S DATA=$G(^LAHM(62.48,R6248,"SCT",R624802,0))
. . S X=$P(DATA,U,1)
. . S REC=$P(X,";",1)
. . S FILE=$P(X,";",2)
. . S FILE=$P(FILE,"(",2) S FILE=$P(FILE,",",1)
. . I FILE=61 D ;
. . . Q:'$D(D61(1,REC))
. . . S STATUS=1
. . . S FOUND(1,R6248,R624802)=$P(DATA,U,1)
. . . S FOUND(2,R6248,R624802)=$P(DATA,U,1)
. . . S FOUND(61,R6248,R624802)=$P(DATA,U,1)
. . . S X=$$VARPTR01^LA7XREF($P(DATA,U,1))
. . ;
. . I FILE=62 D ;
. . . Q:'$D(D62(1,REC))
. . . S STATUS=1
. . . S FOUND(1,R6248,R624802)=$P(DATA,U,1)
. . . S FOUND(2,R6248,R624802)=$P(DATA,U,1)
. . . S FOUND(62,R6248,R624802)=$P(DATA,U,1)
. . . S X=$$VARPTR01^LA7XREF($P(DATA,U,1))
. . ;
. ;
;
; Does #62.4802 fld #.02 contain this SCT?
S R6248=0
I MSGCFG S R6248=MSGCFG-1
F S R6248=$O(^LAHM(62.48,R6248)) Q:'R6248 Q:MSGCFG&(R6248'=MSGCFG) D ;
. S (NODE,NODE1)="^LAHM(62.48,"_R6248_",""SCT"",""AD"","""_CODE_""")"
. S NODE1=$$TRIM^XLFSTR(NODE1,"R",")")
. S NODE1=$TR(NODE1,"""","")
. F S NODE=$Q(@NODE) Q:$E($TR(NODE,"""",""),1,$L(NODE1))'=NODE1 D ;
. . S R624802=$QS(NODE,POS("R624802"))
. . S FOUND(1,R6248,R624802)=$QS(NODE,POS("X"))
. . S FOUND(3,R6248,R624802)=$QS(NODE,POS("X"))
. . S STATUS=1
. ;
Q STATUS
;
F629(CODE,SYS,FOUND,SHPCFG) ;
; #62.9
; check .03 data
; check .09 data
; check 5.1
; check 5.3
; check 5.7
; (private method for LA7SRPT2)
N R629,R629001,STATUS,DIERR,DATA,X,LAMSG
N F03,F09,F51,F53,F55,F56,F57,F59
S CODE=$G(CODE)
S SYS=$G(SYS)
S SHPCFG=+$G(SHPCFG)
K FOUND
Q:CODE="" 0
Q:SYS="" 0
S STATUS=0
S R629=0
I SHPCFG S R629=SHPCFG-1
F S R629=$O(^LAHM(62.9,R629)) Q:'R629 Q:SHPCFG&(R629'=SHPCFG) D ;
. S R629001=0
. F S R629001=$O(^LAHM(62.9,R629,60,R629001)) Q:'R629001 D ;
. . S DATA=$G(^LAHM(62.9,R629,60,R629001,0))
. . S F03=$P(DATA,U,3) ;#61
. . S F09=$P(DATA,U,9) ;#62
. . S DATA=$G(^LAHM(62.9,R629,60,R629001,5))
. . S F51=$P(DATA,U,1)
. . S F53=$P(DATA,U,3)
. . S F55=$P(DATA,U,5)
. . S F56=$P(DATA,U,6)
. . S F57=$P(DATA,U,7)
. . S F59=$P(DATA,U,9)
. . S X=$$GET1^DIQ(61,F03_",",20,"I","","LAMSG")
. . I SYS="SCT" I X=CODE D ;
. . . S STATUS=1
. . . S FOUND(1,R629,R629001)=""
. . . S FOUND(2,R629,R629001)=""
. . ;
. . S X=$$GET1^DIQ(62,F09_",",20,"I","","LAMSG")
. . I SYS="SCT" I X=CODE D ;
. . . S STATUS=1
. . . S FOUND(1,R629,R629001)=""
. . . S FOUND(3,R629,R629001)=""
. . ;
. . I F56=SYS I F53=CODE D ;
. . . S STATUS=1
. . . S FOUND(1,R629,R629001)=""
. . . S FOUND(4,R629,R629001)=""
. . ;
. . I F59=SYS I F57=CODE D ;
. . . S STATUS=1
. . . S FOUND(1,R629,R629001)=""
. . . S FOUND(5,R629,R629001)=""
. . ;
. . I F55=SYS I F51=CODE D ;
. . . S STATUS=1
. . . S FOUND(1,R629,R629001)=""
. . . S FOUND(6,R629,R629001)=""
. ;
;
Q STATUS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7SRPT3 6696 printed Dec 13, 2024@01:39:41 Page 2
LA7SRPT3 ;DALOI/JDB - CODE USAGE REPORT (cont) ;03/07/12 09:21
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
+2 ;
+3 QUIT
+4 ;
F61(CODE,SYS,FOUND) ;
+1 ; (private method for LA7SRPT2)
+2 NEW NODE,NODE1,POS,R61,STATUS
+3 SET CODE=$GET(CODE)
+4 SET SYS=$GET(SYS)
+5 KILL FOUND
+6 if CODE=""
QUIT 0
+7 if SYS=""
QUIT 0
+8 SET STATUS=0
+9 SET (NODE,NODE1)=""
+10 ;
IF SYS="SCT"
Begin DoDot:1
+11 SET (NODE,NODE1)="^LAB(61,""F"","_CODE_")"
+12 SET POS("R61")=4
End DoDot:1
+13 ;
+14 IF NODE=""
QUIT 0
+15 SET NODE1=$$TRIM^XLFSTR(NODE1,"R",")")
+16 SET NODE1=$TRANSLATE(NODE1,"""","")
+17 ;
FOR
SET NODE=$QUERY(@NODE)
if $EXTRACT($TRANSLATE(NODE,"""",""),1,$LENGTH(NODE1))'=NODE1
QUIT
Begin DoDot:1
+18 SET R61=$QSUBSCRIPT(NODE,POS("R61"))
+19 SET FOUND(1,R61)=""
+20 SET STATUS=1
End DoDot:1
+21 QUIT STATUS
+22 ;
F612(CODE,SYS,FOUND) ;
+1 ; (private method for LA7SRPT2)
+2 NEW NODE,NODE1,POS,R612,STATUS
+3 SET CODE=$GET(CODE)
+4 SET SYS=$GET(SYS)
+5 KILL FOUND
+6 if CODE=""
QUIT 0
+7 if SYS=""
QUIT 0
+8 SET STATUS=0
+9 SET (NODE,NODE1)=""
+10 ;
IF SYS="SCT"
Begin DoDot:1
+11 SET (NODE,NODE1)="^LAB(61.2,""F"","_CODE_")"
+12 SET POS("R612")=4
End DoDot:1
+13 ;
+14 IF NODE=""
QUIT 0
+15 SET NODE1=$$TRIM^XLFSTR(NODE1,"R",")")
+16 SET NODE1=$TRANSLATE(NODE1,"""","")
+17 ;
FOR
SET NODE=$QUERY(@NODE)
if $EXTRACT($TRANSLATE(NODE,"""",""),1,$LENGTH(NODE1))'=NODE1
QUIT
Begin DoDot:1
+18 SET R612=$QSUBSCRIPT(NODE,POS("R612"))
+19 SET FOUND(1,R612)=""
+20 SET STATUS=1
End DoDot:1
+21 QUIT STATUS
+22 ;
F62(CODE,SYS,FOUND) ;
+1 ; (private method for LA7SRPT2)
+2 NEW NODE,NODE1,POS,R62,STATUS
+3 SET CODE=$GET(CODE)
+4 SET SYS=$GET(SYS)
+5 KILL FOUND
+6 if CODE=""
QUIT 0
+7 if SYS=""
QUIT 0
+8 SET STATUS=0
+9 SET (NODE,NODE1)=""
+10 ;
IF SYS="SCT"
Begin DoDot:1
+11 SET (NODE,NODE1)="^LAB(62,""F"","_CODE_")"
+12 SET POS("R62")=4
End DoDot:1
+13 ;
+14 IF NODE=""
QUIT 0
+15 SET NODE1=$$TRIM^XLFSTR(NODE1,"R",")")
+16 SET NODE1=$TRANSLATE(NODE1,"""","")
+17 ;
FOR
SET NODE=$QUERY(@NODE)
if $EXTRACT($TRANSLATE(NODE,"""",""),1,$LENGTH(NODE1))'=NODE1
QUIT
Begin DoDot:1
+18 SET R62=$QSUBSCRIPT(NODE,POS("R62"))
+19 SET FOUND(1,R62)=""
+20 SET STATUS=1
End DoDot:1
+21 QUIT STATUS
+22 ;
F6206(CODE,SYS,FOUND) ;
+1 ; (private method for LA7SRPT2)
+2 NEW NODE,NODE1,POS,R64,R953,R6206,STATUS,DATA,X
+3 SET CODE=$GET(CODE)
+4 SET SYS=$GET(SYS)
+5 KILL FOUND
+6 if CODE=""
QUIT 0
+7 if SYS=""
QUIT 0
+8 SET STATUS=0
+9 if SYS'="LN"
QUIT 0
+10 SET (NODE,NODE1)=""
+11 SET R64=0
+12 ;
FOR
SET R64=$ORDER(^LAM("AH",$PIECE(CODE,"-",1),R64))
if 'R64
QUIT
Begin DoDot:1
+13 SET DATA=$GET(^LAM(R64,9))
+14 SET X=$PIECE(DATA,U,1)
+15 if X=""
QUIT
+16 SET R953=X
+17 SET R6206=0
+18 ;
FOR
SET R6206=$ORDER(^LAB(62.06,R6206))
if 'R6206
QUIT
Begin DoDot:2
+19 SET DATA=$GET(^LAB(62.06,R6206,64))
+20 ;NATL VA CODE
SET X=$PIECE(DATA,U,1)
+21 if X'=R64
QUIT
+22 SET STATUS=1
+23 SET FOUND(1,R6206)=""
End DoDot:2
+24 ;
End DoDot:1
+25 QUIT STATUS
+26 ;
F6247(CODE,SYS,FOUND,MSGCFG) ;
+1 ; (private method for LA7SRPT2)
+2 NEW NODE,NODE1,POS,R6247,R624701,R6248,STATUS,DATA
+3 SET CODE=$GET(CODE)
+4 SET SYS=$GET(SYS)
+5 SET MSGCFG=+$GET(MSGCFG)
+6 KILL FOUND
+7 if CODE=""
QUIT 0
+8 if SYS=""
QUIT 0
+9 SET STATUS=0
+10 SET (NODE,NODE1)=""
+11 SET (NODE,NODE1)="^LAB(62.47,""AF"","""_SYS_""","""_CODE_""")"
+12 SET POS("R6247")=5
+13 SET POS("R624701")=6
+14 ;
+15 IF NODE=""
QUIT 0
+16 SET NODE1=$$TRIM^XLFSTR(NODE1,"R",")")
+17 SET NODE1=$TRANSLATE(NODE1,"""","")
+18 ;
FOR
SET NODE=$QUERY(@NODE)
if $EXTRACT($TRANSLATE(NODE,"""",""),1,$LENGTH(NODE1))'=NODE1
QUIT
Begin DoDot:1
+19 SET R6247=$QSUBSCRIPT(NODE,POS("R6247"))
+20 SET R624701=$QSUBSCRIPT(NODE,POS("R624701"))
+21 SET DATA=$GET(^LAB(62.47,R6247,1,R624701,2,0))
+22 SET R6248=$PIECE(DATA,U,2)
+23 ;
IF MSGCFG
IF R6248'=MSGCFG
QUIT
+24 SET FOUND(1,R6247,R624701)=""
+25 SET STATUS=1
End DoDot:1
+26 QUIT STATUS
+27 ;
F6248(CODE,SYS,FOUND,MSGCFG) ;
+1 ; Loop through all
+2 ; ^LAHM(62.48,DA(1),"SCT","AD",CODE,VARPTR,DA)
+3 ; #62.48 only supports SCT code sets
+4 ; (private method for LA7SRPT2)
+5 NEW NODE,NODE1,POS,R6248,R624802,STATUS,D61,D62,X,DATA,REC,FILE
+6 SET CODE=$GET(CODE)
+7 SET SYS=$GET(SYS)
+8 SET MSGCFG=+$GET(MSGCFG)
+9 KILL FOUND
+10 if CODE=""
QUIT 0
+11 if SYS=""
QUIT 0
+12 if SYS'="SCT"
QUIT 0
+13 SET STATUS=0
+14 SET (NODE,NODE1)=""
+15 SET POS("R6248")=2
+16 SET POS("X")=6
+17 SET POS("R624802")=7
+18 ;
+19 ; Is SCT code in #61 or #62
+20 SET X=$$F61(CODE,"SCT",.D61)
+21 SET X=$$F62(CODE,"SCT",.D62)
+22 ;
+23 ; #62.482 fld #.01 (VA FILE ENTRY) point to entry with the SCT?
+24 SET R6248=0
+25 IF MSGCFG
SET R6248=MSGCFG-1
+26 ;
FOR
SET R6248=$ORDER(^LAHM(62.48,R6248))
if 'R6248
QUIT
if MSGCFG&(R6248'=MSGCFG)
QUIT
Begin DoDot:1
+27 SET R624802=0
+28 ;
FOR
SET R624802=$ORDER(^LAHM(62.48,R6248,"SCT",R624802))
if 'R624802
QUIT
Begin DoDot:2
+29 SET DATA=$GET(^LAHM(62.48,R6248,"SCT",R624802,0))
+30 SET X=$PIECE(DATA,U,1)
+31 SET REC=$PIECE(X,";",1)
+32 SET FILE=$PIECE(X,";",2)
+33 SET FILE=$PIECE(FILE,"(",2)
SET FILE=$PIECE(FILE,",",1)
+34 ;
IF FILE=61
Begin DoDot:3
+35 if '$DATA(D61(1,REC))
QUIT
+36 SET STATUS=1
+37 SET FOUND(1,R6248,R624802)=$PIECE(DATA,U,1)
+38 SET FOUND(2,R6248,R624802)=$PIECE(DATA,U,1)
+39 SET FOUND(61,R6248,R624802)=$PIECE(DATA,U,1)
+40 SET X=$$VARPTR01^LA7XREF($PIECE(DATA,U,1))
End DoDot:3
+41 ;
+42 ;
IF FILE=62
Begin DoDot:3
+43 if '$DATA(D62(1,REC))
QUIT
+44 SET STATUS=1
+45 SET FOUND(1,R6248,R624802)=$PIECE(DATA,U,1)
+46 SET FOUND(2,R6248,R624802)=$PIECE(DATA,U,1)
+47 SET FOUND(62,R6248,R624802)=$PIECE(DATA,U,1)
+48 SET X=$$VARPTR01^LA7XREF($PIECE(DATA,U,1))
End DoDot:3
+49 ;
End DoDot:2
+50 ;
End DoDot:1
+51 ;
+52 ; Does #62.4802 fld #.02 contain this SCT?
+53 SET R6248=0
+54 IF MSGCFG
SET R6248=MSGCFG-1
+55 ;
FOR
SET R6248=$ORDER(^LAHM(62.48,R6248))
if 'R6248
QUIT
if MSGCFG&(R6248'=MSGCFG)
QUIT
Begin DoDot:1
+56 SET (NODE,NODE1)="^LAHM(62.48,"_R6248_",""SCT"",""AD"","""_CODE_""")"
+57 SET NODE1=$$TRIM^XLFSTR(NODE1,"R",")")
+58 SET NODE1=$TRANSLATE(NODE1,"""","")
+59 ;
FOR
SET NODE=$QUERY(@NODE)
if $EXTRACT($TRANSLATE(NODE,"""",""),1,$LENGTH(NODE1))'=NODE1
QUIT
Begin DoDot:2
+60 SET R624802=$QSUBSCRIPT(NODE,POS("R624802"))
+61 SET FOUND(1,R6248,R624802)=$QSUBSCRIPT(NODE,POS("X"))
+62 SET FOUND(3,R6248,R624802)=$QSUBSCRIPT(NODE,POS("X"))
+63 SET STATUS=1
End DoDot:2
+64 ;
End DoDot:1
+65 QUIT STATUS
+66 ;
F629(CODE,SYS,FOUND,SHPCFG) ;
+1 ; #62.9
+2 ; check .03 data
+3 ; check .09 data
+4 ; check 5.1
+5 ; check 5.3
+6 ; check 5.7
+7 ; (private method for LA7SRPT2)
+8 NEW R629,R629001,STATUS,DIERR,DATA,X,LAMSG
+9 NEW F03,F09,F51,F53,F55,F56,F57,F59
+10 SET CODE=$GET(CODE)
+11 SET SYS=$GET(SYS)
+12 SET SHPCFG=+$GET(SHPCFG)
+13 KILL FOUND
+14 if CODE=""
QUIT 0
+15 if SYS=""
QUIT 0
+16 SET STATUS=0
+17 SET R629=0
+18 IF SHPCFG
SET R629=SHPCFG-1
+19 ;
FOR
SET R629=$ORDER(^LAHM(62.9,R629))
if 'R629
QUIT
if SHPCFG&(R629'=SHPCFG)
QUIT
Begin DoDot:1
+20 SET R629001=0
+21 ;
FOR
SET R629001=$ORDER(^LAHM(62.9,R629,60,R629001))
if 'R629001
QUIT
Begin DoDot:2
+22 SET DATA=$GET(^LAHM(62.9,R629,60,R629001,0))
+23 ;#61
SET F03=$PIECE(DATA,U,3)
+24 ;#62
SET F09=$PIECE(DATA,U,9)
+25 SET DATA=$GET(^LAHM(62.9,R629,60,R629001,5))
+26 SET F51=$PIECE(DATA,U,1)
+27 SET F53=$PIECE(DATA,U,3)
+28 SET F55=$PIECE(DATA,U,5)
+29 SET F56=$PIECE(DATA,U,6)
+30 SET F57=$PIECE(DATA,U,7)
+31 SET F59=$PIECE(DATA,U,9)
+32 SET X=$$GET1^DIQ(61,F03_",",20,"I","","LAMSG")
+33 ;
IF SYS="SCT"
IF X=CODE
Begin DoDot:3
+34 SET STATUS=1
+35 SET FOUND(1,R629,R629001)=""
+36 SET FOUND(2,R629,R629001)=""
End DoDot:3
+37 ;
+38 SET X=$$GET1^DIQ(62,F09_",",20,"I","","LAMSG")
+39 ;
IF SYS="SCT"
IF X=CODE
Begin DoDot:3
+40 SET STATUS=1
+41 SET FOUND(1,R629,R629001)=""
+42 SET FOUND(3,R629,R629001)=""
End DoDot:3
+43 ;
+44 ;
IF F56=SYS
IF F53=CODE
Begin DoDot:3
+45 SET STATUS=1
+46 SET FOUND(1,R629,R629001)=""
+47 SET FOUND(4,R629,R629001)=""
End DoDot:3
+48 ;
+49 ;
IF F59=SYS
IF F57=CODE
Begin DoDot:3
+50 SET STATUS=1
+51 SET FOUND(1,R629,R629001)=""
+52 SET FOUND(5,R629,R629001)=""
End DoDot:3
+53 ;
+54 ;
IF F55=SYS
IF F51=CODE
Begin DoDot:3
+55 SET STATUS=1
+56 SET FOUND(1,R629,R629001)=""
+57 SET FOUND(6,R629,R629001)=""
End DoDot:3
End DoDot:2
+58 ;
End DoDot:1
+59 ;
+60 QUIT STATUS
