INPUT TRANSFORM: Q:X="XX "!(X="XY ") S X=$S(X&$L(X)=1:0_X,1:X) K:$L(X)>3!($L(X)<2)!('$D(^DIC(42.4,+X,0))#2) X
OUTPUT TRANSFORM: S Y=$S($D(^DIC(42.4,+Y,0)):$P(^(0),U),Y="XY ":"BLOOD BANK",1:"AMBULATORY CARE")
LAST EDITED: AUG 25, 1993
HELP-PROMPT: Answer must be 2 characters in length. Or 'XX' for AMBULATORY CARE Treating Speciality.
DESCRIPTION:
Code for treating specialty.
NOTES: XXXX--CAN'T BE ALTERED EXCEPT BY PROGRAMMER
CROSS-REFERENCE: 67.91148^B
1)= S ^LRO(67.9,DA(4),1,DA(3),1,DA(2),1,DA(1),1,"B",$E(X,1,30),DA)=""
2)= K ^LRO(67.9,DA(4),1,DA(3),1,DA(2),1,DA(1),1,"B",$E(X,1,30),DA)
CROSS-REFERENCE: ^^TRIGGER^67.91148^.03
1)= X ^DD(67.91148,.01,1,2,1.3) S Y(1)=$S($D(^LRO(67.9,D0,1,D1,1,D2,1,D3,1,D4,0)):^(0),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X=DIV D TRIGTS^LRXREF X ^DD(67.91148,.01,1,2,1.4)
1.3)= K DIV S DIV=X,D0=DA(4),DIV(0)=D0,D1=DA(3),DIV(1)=D1,D2=DA(2),DIV(2)=D2,D3=DA(1),DIV(3)=D3,D4=DA,DIV(4)=D4
1.4)= S DIH=$S($D(^LRO(67.9,DIV(0),1,DIV(1),1,DIV(2),1,DIV(3),1,DIV(4),0)):^(0),1:""),DIV=X S $P(^(0),U,3)=DIV,DIH=67.91148,DIG=.03 D ^DICR:$O(^DD(DIH,DIG,1,0))>0
2)= K DIV S DIV=X,D0=DA(4),DIV(0)=D0,D1=DA(3),DIV(1)=D1,D2=DA(2),DIV(2)=D2,D3=DA(1),DIV(3)=D3,D4=DA,DIV(4)=D4 S Y(1)=$S($D(^LRO(67.9,D0,1,D1,1,D2,1,D3,1,D4,0)):^(0),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(67.91
148,.01,1,2,2.4)
2.4)= S DIH=$S($D(^LRO(67.9,DIV(0),1,DIV(1),1,DIV(2),1,DIV(3),1,DIV(4),0)):^(0),1:""),DIV=X S $P(^(0),U,3)=DIV,DIH=67.91148,DIG=.03 D ^DICR:$O(^DD(DIH,DIG,1,0))>0
CREATE VALUE)= D TRIGTS^LRXREF
DELETE VALUE)= @
FIELD)= TREATING SPECIALITY NAME
This trigger stuffs the treating speciality name automatically.
HELP-PROMPT: Answer must be 3-30 characters in length.
DESCRIPTION:
Name of the treating specialty.
WRITE AUTHORITY:^
NOTES: TRIGGERED by the TREATING SPECIALITY CODE field of the TREATING SPECIALITY sub-field of the WKLD CODE sub-field of the MONTH sub-field of the DIVISION sub-field of the LAB MONTHLY WORKLOADS File