LRWLST1A ;DALOI/JDB - ACCESSION SETUP CONT ;03/07/12 16:44
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
Q
;
;
; Originally in SLRSS^LRWLST11.
; Note: This subroutine gets called after AP Log-in (LRAP)
; as well as from other processes such as LEDI.
;
; Expects: LRAA,LRAD,LRAN,LRCDT,LRDFN,LREAL,LRIDT,LRLLOC,LRNT
; LRORU3,LRPRAC,LRSAMP,LRSPEC,LRSS,LRORDRR,LRRSITE,LROLLOC
;
N FLD,FLDS,LRFILE,LRFLDS,LRDATA,DATA,X,I
N LRFDA,LRIEN,LRMSG,DIERR
S LRFILE=$S(LRSS="CH":63.04,LRSS="MI":63.05,LRSS="SP":63.08,LRSS="CY":63.09,LRSS="EM":63.02,LRSS="BB":63.01,1:0)
Q:'LRFILE
;
; Fields to use for each subfile
S LRFLDS=""
I LRSS="CH" D ;
. S LRFLDS=".01;.02;.05;.06;.09;.1;.11;.111;.112;.31;.32;.33;.34;.342"
I LRSS="MI" D ;
. S LRFLDS=".01;.02;.05;.06;.07;.08;.09;.1;.055;.111;.112;.31;.32;.33;.34;.342"
I LRSS="SP" D ;
. S LRFLDS=".01;.02;.06;.07;.08;.09;.1;.31;.32;.33;.34;.342"
I LRSS="CY" D ;
. S LRFLDS=".01;.02;.06;.07;.08;.09;.1;.31;.32;.33;.34;.342"
I LRSS="EM" D ;
. S LRFLDS=".01;.02;.06;.07;.08;.09;.1;.31;.32;.33;.34;.342"
I LRSS="BB" D ;
. S LRFLDS=".01;.02;.05;.06;.07;.08;.09;.1;.055"
Q:LRFLDS=""
;
; Get current values from database
S LRIEN=LRIDT_","_LRDFN_","
D GETS^DIQ(LRFILE,LRIEN,LRFLDS,"IN","LRDATA","LRMSG")
M DATA=LRDATA(LRFILE,LRIEN)
; DATA(field#,"I")=value
K LRDATA
;
S FLD=""
F I=1:1:$L(LRFLDS,";") S FLD=$P(LRFLDS,";",I) Q:'FLD D ;
. ; skip if database already has a value
. Q:$G(DATA(FLD,"I"))'=""
. ;
. ; dont process .01 field
. I FLD=.01 Q
. ;
. I FLD=.02 I "CHMI"[LRSS D Q ;
. . D MAKEFDA(.02,LREAL)
. ;
. ; Is there a pathologist variable available here?
. ;I FLD=.02 I "^63.08^63.09^63.02^"[("^"_LRFILE_"^") D Q ;
. ;I FLD=.02 I "SPCYEM"[LRSS D Q ;
. ;. D MAKEFDA(.02,LREAL)
. ;
. I FLD=.05 I "CHMIBB"[LRSS D Q ;
. . I LRSS="CH" D MAKEFDA(.05,LRSPEC)
. . I LRSS'="CH" D ;
. . . S X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0))
. . . S X=$P(X,U,1)
. . . D MAKEFDA(.05,X)
. . ;
. ;
. I FLD=.055 I "MIBB"[LRSS D Q ;
. . S X=$P(LRSAMP,";",1)
. . D MAKEFDA(.055,X)
. ;
. I FLD=.06 D MAKEFDA(.06,LRACC) Q ;
. ;
. ;FLD .07 handled below
. ;FLD .08 handled below
. ;
. ;I FLD=.09 I "SPCYEMBB"[LRSS D Q ;
. ;. ;D MAKEFDA(.09,"????") ; ???what goes here???
. ;I FLD=.09 I LRSS="CH" D Q ;
. ;. ;D MAKEFDA(.09,"????") ;;???SUM REPROT NUM???
. ;I FLD=.09 I LRSS="MI" D Q ;
. ;. ;D MAKEFDA(.09,"????") ;;???AMENDED REPORT???
. ;
. ; FLD .1 handled below
. ; FLD .11 handled below
. ;
. I FLD=.111 I "CHMI"[LRSS D Q ;
. . S X=""
. . I $G(LRORDRR)="R" I +$G(LRRSITE("RSITE")) D ;
. . . S X=+LRRSITE("RSITE")_";DIC(4,"
. . I $G(LRORDRR)'="R" I $G(LROLLOC) D ;
. . . S X=LROLLOC_";SC("
. . Q:X=""
. . D MAKEFDA(.111,X)
. ;
. I FLD=.112 I "CHMI"[LRSS D Q ;
. . S X=$G(LRDUZ(2))
. . I X="" S X=$G(DUZ(2))
. . D MAKEFDA(.112,X)
. ;
. ;
. I LRSS="CH" D Q ;
. . I FLD=.07 Q
. . I FLD=.1 D MAKEFDA(.1,LRPRAC)
. . I FLD=.11 D MAKEFDA(.11,LRLLOC)
. ;
. I "MICYSPEMBB"[LRSS D Q ;
. . I FLD=.07 D MAKEFDA(.07,LRPRAC)
. . I FLD=.08 D MAKEFDA(.08,LRLLOC)
. . I FLD=.1 D MAKEFDA(.1,LRNT)
. ;
;
I $G(LRORU3)'="" I "CHMISPCYEM"[LRSS D ;
. D MAKEFDA(.31,$P(LRORU3,U))
. D MAKEFDA(.32,$P(LRORU3,U,2))
. D MAKEFDA(.33,$P(LRORU3,U,3))
. D MAKEFDA(.34,$P(LRORU3,U,4))
. D MAKEFDA(.342,$P(LRORU3,U,5))
;
I $D(LRFDA(63)) D FILE^DIE("","LRFDA(63)","LRMSG")
;
Q
;
MAKEFDA(FLD,VAL) ;
; Adds entries to the LRFDA array.
; Helper method for SLRSS method.
; (Private method)
; Requires LRFILE,LRIEN,DATA variables in symbol table
; Inputs
; FLD : Field #
; VAL : Value
;
Q:$G(DATA(FLD,"I"))'=""
Q:VAL=""
S LRFDA(63,LRFILE,LRIEN,FLD)=VAL
Q
;
Q
; For legacy documentation only
; This is the code that was in SLRSS^LRWLST11
;S FDAIEN(1)=LRIDT
;S FDA(63,LRX,LRIDT_","_LRDFN_",",.01)=LRCDT
;S:"CYSPEM"'[LRSS FDA(63,LRX,LRIDT_","_LRDFN_",",.02)=LREAL
;S FDA(63,LRX,LRIDT_","_LRDFN_",",.05)=$P(H8,U)
;S FDA(63,LRX,LRIDT_","_LRDFN_",",.06)=$P(H8,U,2)
;I "MICYSPEMBB"[LRSS S FDA(63,LRX,LRIDT_","_LRDFN_",",.07)=LRPRAC
;I LRSS="CH" S FDA(63,LRX,LRIDT_","_LRDFN_",",.07)=$P(H8,U,3)
;S FDA(63,LRX,LRIDT_","_LRDFN_",",.08)=$P(H8,U,4)
;S FDA(63,LRX,LRIDT_","_LRDFN_",",.09)=$P(H8,U,5)
;I LRSS="CH" S FDA(63,LRX,LRIDT_","_LRDFN_",",.1)=LRPRAC
;I "MICYSPEMBB"[LRSS S FDA(63,LRX,LRIDT_","_LRDFN_",",.1)=LRNT
;S FDA(63,LRX,LRIDT_","_LRDFN_",",.055)=$P(H8,U,7)
;S FDA(63,LRX,LRIDT_","_LRDFN_",",.2)=$P(H8,U,8)
;S FDA(63,LRX,LRIDT_","_LRDFN_",",.111)=$P(H8,U,9)
;S FDA(63,LRX,LRIDT_","_LRDFN_",",.112)=$P(H8,U,10)
;I $G(LRORU3)'="" D
;.S FDA(63,LRX,LRIDT_","_LRDFN_",",.31)=$P(LRORU3,U)
;.S FDA(63,LRX,LRIDT_","_LRDFN_",",.32)=$P(LRORU3,U,2)
;.S FDA(63,LRX,LRIDT_","_LRDFN_",",.33)=$P(LRORU3,U,3)
;.S FDA(63,LRX,LRIDT_","_LRDFN_",",.34)=$P(LRORU3,U,4)
;.S FDA(63,LRX,LRIDT_","_LRDFN_",",.342)=$P(LRORU3,U,5)
;I LRX D FILE^DIE("","FDA(63)","LRDIE(63)")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRWLST1A 5104 printed Apr 09, 2024@21:21:37 Page 2
LRWLST1A ;DALOI/JDB - ACCESSION SETUP CONT ;03/07/12 16:44
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
+3 QUIT
+4 ;
+1 ;
+2 ; Originally in SLRSS^LRWLST11.
+3 ; Note: This subroutine gets called after AP Log-in (LRAP)
+4 ; as well as from other processes such as LEDI.
+5 ;
+6 ; Expects: LRAA,LRAD,LRAN,LRCDT,LRDFN,LREAL,LRIDT,LRLLOC,LRNT
+7 ; LRORU3,LRPRAC,LRSAMP,LRSPEC,LRSS,LRORDRR,LRRSITE,LROLLOC
+8 ;
+9 NEW FLD,FLDS,LRFILE,LRFLDS,LRDATA,DATA,X,I
+10 NEW LRFDA,LRIEN,LRMSG,DIERR
+11 SET LRFILE=$SELECT(LRSS="CH":63.04,LRSS="MI":63.05,LRSS="SP":63.08,LRSS="CY":63.09,LRSS="EM":63.02,LRSS="BB":63.01,1:0)
+12 if 'LRFILE
QUIT
+13 ;
+14 ; Fields to use for each subfile
+15 SET LRFLDS=""
+16 ;
IF LRSS="CH"
Begin DoDot:1
+17 SET LRFLDS=".01;.02;.05;.06;.09;.1;.11;.111;.112;.31;.32;.33;.34;.342"
End DoDot:1
+18 ;
IF LRSS="MI"
Begin DoDot:1
+19 SET LRFLDS=".01;.02;.05;.06;.07;.08;.09;.1;.055;.111;.112;.31;.32;.33;.34;.342"
End DoDot:1
+20 ;
IF LRSS="SP"
Begin DoDot:1
+21 SET LRFLDS=".01;.02;.06;.07;.08;.09;.1;.31;.32;.33;.34;.342"
End DoDot:1
+22 ;
IF LRSS="CY"
Begin DoDot:1
+23 SET LRFLDS=".01;.02;.06;.07;.08;.09;.1;.31;.32;.33;.34;.342"
End DoDot:1
+24 ;
IF LRSS="EM"
Begin DoDot:1
+25 SET LRFLDS=".01;.02;.06;.07;.08;.09;.1;.31;.32;.33;.34;.342"
End DoDot:1
+26 ;
IF LRSS="BB"
Begin DoDot:1
+27 SET LRFLDS=".01;.02;.05;.06;.07;.08;.09;.1;.055"
End DoDot:1
+28 if LRFLDS=""
QUIT
+29 ;
+30 ; Get current values from database
+31 SET LRIEN=LRIDT_","_LRDFN_","
+32 DO GETS^DIQ(LRFILE,LRIEN,LRFLDS,"IN","LRDATA","LRMSG")
+33 MERGE DATA=LRDATA(LRFILE,LRIEN)
+34 ; DATA(field#,"I")=value
+35 KILL LRDATA
+36 ;
+37 SET FLD=""
+38 ;
FOR I=1:1:$LENGTH(LRFLDS,";")
SET FLD=$PIECE(LRFLDS,";",I)
if 'FLD
QUIT
Begin DoDot:1
+39 ; skip if database already has a value
+40 if $GET(DATA(FLD,"I"))'=""
QUIT
+41 ;
+42 ; dont process .01 field
+43 IF FLD=.01
QUIT
+44 ;
+45 ;
IF FLD=.02
IF "CHMI"[LRSS
Begin DoDot:2
+46 DO MAKEFDA(.02,LREAL)
End DoDot:2
QUIT
+47 ;
+48 ; Is there a pathologist variable available here?
+49 ;I FLD=.02 I "^63.08^63.09^63.02^"[("^"_LRFILE_"^") D Q ;
+50 ;I FLD=.02 I "SPCYEM"[LRSS D Q ;
+51 ;. D MAKEFDA(.02,LREAL)
+52 ;
+53 ;
IF FLD=.05
IF "CHMIBB"[LRSS
Begin DoDot:2
+54 IF LRSS="CH"
DO MAKEFDA(.05,LRSPEC)
+55 ;
IF LRSS'="CH"
Begin DoDot:3
+56 SET X=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0))
+57 SET X=$PIECE(X,U,1)
+58 DO MAKEFDA(.05,X)
End DoDot:3
+59 ;
End DoDot:2
QUIT
+60 ;
+61 ;
IF FLD=.055
IF "MIBB"[LRSS
Begin DoDot:2
+62 SET X=$PIECE(LRSAMP,";",1)
+63 DO MAKEFDA(.055,X)
End DoDot:2
QUIT
+64 ;
+65 ;
IF FLD=.06
DO MAKEFDA(.06,LRACC)
QUIT
+66 ;
+67 ;FLD .07 handled below
+68 ;FLD .08 handled below
+69 ;
+70 ;I FLD=.09 I "SPCYEMBB"[LRSS D Q ;
+71 ;. ;D MAKEFDA(.09,"????") ; ???what goes here???
+72 ;I FLD=.09 I LRSS="CH" D Q ;
+73 ;. ;D MAKEFDA(.09,"????") ;;???SUM REPROT NUM???
+74 ;I FLD=.09 I LRSS="MI" D Q ;
+75 ;. ;D MAKEFDA(.09,"????") ;;???AMENDED REPORT???
+76 ;
+77 ; FLD .1 handled below
+78 ; FLD .11 handled below
+79 ;
+80 ;
IF FLD=.111
IF "CHMI"[LRSS
Begin DoDot:2
+81 SET X=""
+82 ;
IF $GET(LRORDRR)="R"
IF +$GET(LRRSITE("RSITE"))
Begin DoDot:3
+83 SET X=+LRRSITE("RSITE")_";DIC(4,"
End DoDot:3
+84 ;
IF $GET(LRORDRR)'="R"
IF $GET(LROLLOC)
Begin DoDot:3
+85 SET X=LROLLOC_";SC("
End DoDot:3
+86 if X=""
QUIT
+87 DO MAKEFDA(.111,X)
End DoDot:2
QUIT
+88 ;
+89 ;
IF FLD=.112
IF "CHMI"[LRSS
Begin DoDot:2
+90 SET X=$GET(LRDUZ(2))
+91 IF X=""
SET X=$GET(DUZ(2))
+92 DO MAKEFDA(.112,X)
End DoDot:2
QUIT
+93 ;
+94 ;
+95 ;
IF LRSS="CH"
Begin DoDot:2
+96 IF FLD=.07
QUIT
+97 IF FLD=.1
DO MAKEFDA(.1,LRPRAC)
+98 IF FLD=.11
DO MAKEFDA(.11,LRLLOC)
End DoDot:2
QUIT
+99 ;
+100 ;
IF "MICYSPEMBB"[LRSS
Begin DoDot:2
+101 IF FLD=.07
DO MAKEFDA(.07,LRPRAC)
+102 IF FLD=.08
DO MAKEFDA(.08,LRLLOC)
+103 IF FLD=.1
DO MAKEFDA(.1,LRNT)
End DoDot:2
QUIT
+104 ;
End DoDot:1
+105 ;
+106 ;
IF $GET(LRORU3)'=""
IF "CHMISPCYEM"[LRSS
Begin DoDot:1
+107 DO MAKEFDA(.31,$PIECE(LRORU3,U))
+108 DO MAKEFDA(.32,$PIECE(LRORU3,U,2))
+109 DO MAKEFDA(.33,$PIECE(LRORU3,U,3))
+110 DO MAKEFDA(.34,$PIECE(LRORU3,U,4))
+111 DO MAKEFDA(.342,$PIECE(LRORU3,U,5))
End DoDot:1
+112 ;
+113 IF $DATA(LRFDA(63))
DO FILE^DIE("","LRFDA(63)","LRMSG")
+114 ;
+115 QUIT
+116 ;
MAKEFDA(FLD,VAL) ;
+1 ; Adds entries to the LRFDA array.
+2 ; Helper method for SLRSS method.
+3 ; (Private method)
+4 ; Requires LRFILE,LRIEN,DATA variables in symbol table
+5 ; Inputs
+6 ; FLD : Field #
+7 ; VAL : Value
+8 ;
+9 if $GET(DATA(FLD,"I"))'=""
QUIT
+10 if VAL=""
QUIT
+11 SET LRFDA(63,LRFILE,LRIEN,FLD)=VAL
+12 QUIT
+13 ;
+1 QUIT
+2 ; For legacy documentation only
+3 ; This is the code that was in SLRSS^LRWLST11
+4 ;S FDAIEN(1)=LRIDT
+5 ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.01)=LRCDT
+6 ;S:"CYSPEM"'[LRSS FDA(63,LRX,LRIDT_","_LRDFN_",",.02)=LREAL
+7 ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.05)=$P(H8,U)
+8 ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.06)=$P(H8,U,2)
+9 ;I "MICYSPEMBB"[LRSS S FDA(63,LRX,LRIDT_","_LRDFN_",",.07)=LRPRAC
+10 ;I LRSS="CH" S FDA(63,LRX,LRIDT_","_LRDFN_",",.07)=$P(H8,U,3)
+11 ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.08)=$P(H8,U,4)
+12 ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.09)=$P(H8,U,5)
+13 ;I LRSS="CH" S FDA(63,LRX,LRIDT_","_LRDFN_",",.1)=LRPRAC
+14 ;I "MICYSPEMBB"[LRSS S FDA(63,LRX,LRIDT_","_LRDFN_",",.1)=LRNT
+15 ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.055)=$P(H8,U,7)
+16 ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.2)=$P(H8,U,8)
+17 ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.111)=$P(H8,U,9)
+18 ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.112)=$P(H8,U,10)
+19 ;I $G(LRORU3)'="" D
+20 ;.S FDA(63,LRX,LRIDT_","_LRDFN_",",.31)=$P(LRORU3,U)
+21 ;.S FDA(63,LRX,LRIDT_","_LRDFN_",",.32)=$P(LRORU3,U,2)
+22 ;.S FDA(63,LRX,LRIDT_","_LRDFN_",",.33)=$P(LRORU3,U,3)
+23 ;.S FDA(63,LRX,LRIDT_","_LRDFN_",",.34)=$P(LRORU3,U,4)
+24 ;.S FDA(63,LRX,LRIDT_","_LRDFN_",",.342)=$P(LRORU3,U,5)
+25 ;I LRX D FILE^DIE("","FDA(63)","LRDIE(63)")
+26 QUIT
