LRAPD1 ;AVAMC/REG/WTY/KLL - AP DATA ENTRY ;9/25/00
;;5.2;LAB SERVICE;**41,91,248,259,317,350,422**;Sep 27, 1994;Build 29
;
;WTY;17-AUG-01;Unwrapped text and add kills for DR string
;
SP ;Gross Desc/Clinical Hx, Surg Path
S LRSOP="G"
K DR S DR=".09///^S X=LRWHO;.012;.013;.014;.015;.016;"
S DR=DR_".021//^S X=LR(""TR"");1;S:'LR(""FS"") Y=0;1.3"
S LR(6)=1,DR(2,63.812)=".01;.06R;.07R"
Q
MSP ;Micro Description/Gross Review, Surg Path
S LRSOP="M"
K DR S DR=".09///^S X=LRWHO;S:'LR(""FS"") Y=1;1.3;1;1.1;"
S DR=DR_"S:'LR(""DX"") Y=.02;1.4;.02;.03;S:'LRV Y=0;.14"
S (LR(7),LR(6))=1
Q
BSP ;Micro Description/Snomed Coding
S LRSOP="B",(LR(2),LR(7),LR(6))=1
K DR S DR=".09///^S X=LRWHO;S:'LR(""FS"") Y=1;1.3;1;1.1;"
S DR=DR_"S:'LR(""DX"") Y=.02;1.4;.02;.03;S:'LRV Y=10;.14;10"
S DR(2,63.12)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;I '$D(LR(1)) S Y=0;"
S DR(2,63.12)=DR(2,63.12)_"1;1.5;3"
S DR(3,63.16)=".01;I '$D(LR(1)) S Y=0;1"
S DR(3,63.82)=".01;D R^LRAPD;.02"
Q
ASP ;Micro Description/ICDCM Coding
S LRSOP="A",(LR(7),LR(6))=1
K DR S DR=".09///^S X=LRWHO;S:'LR(""FS"") Y=1;1.3;1;1.1;"
S DR=DR_"S:'LR(""DX"") Y=.02;1.4;.02;.03;D F80^LRAPD1;.14;@1;"_$S($G(LRCDSYS)=30:"D EN^LRAPICD(LRDXV)",1:80)
Q
F80 ;
I 'LRV S Y="@1"
Q
SSP ;Supplementary Report, Surg Path
S (LRSOP,LRSFLG)="S",(LR(2),LR(7),LR(6))=1
K DR
;Entry of Supp rept must be allowed on released reports
;S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
;S DR=DR_"I LRREL(1) D VMSG^LRAPD1 S LRSFLG="""",Y=0;"
;S DR=DR_".09///^S X=LRWHO;.03;10"
S DR=".09///^S X=LRWHO;.03;10"
S DR(2,63.12)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;I '$D(LR(1)) "
S DR(2,63.12)=DR(2,63.12)_"S Y=0;1;1.5;3"
S DR(3,63.16)=".01;I '$D(LR(1)) S Y=0;1"
S DR(3,63.82)=".01;D R^LRAPD;.02"
Q
PSP ;Special Studies, Surg Path
S LRSOP="P"
K DR
S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
S DR=DR_"I LRREL(1) D VMSG^LRAPD1 S Y=0;.03;10"
S DR(2,63.12)="5;1.5"
S DR(3,63.82)=".01;D R^LRAPD;.02",LR(7)=1
Q
CY ;Gross Desc/Clinic Hx, Cytopath
S LRSOP="G"
K DR S DR=".09///^S X=LRWHO;.012;.013;.014;.015;.016;"
S DR=DR_".021//^S X=LR(""TR"");1"
S LR(6)=1,DR(2,63.902)=".01;.02;.06R;.07R"
Q
MCY ;Micro Desc/Gross Review, Cytopath
S LRSOP="M"
K DR S DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
S DR=DR_".021//^S X=LR(""TR"");.02;.03;.101;S:'LRV Y=0;.14"
S (LR(7),LR(6))=1
Q
BCY ;Micro Desc/SNOMED Coding, Cytopath
S LRSOP="B",DIC(0)="M"
S (LR(2),LR(7),LR(6))=1
K DR S DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
S DR=DR_".021//^S X=LR(""TR"");.02;.03;.101;S:'LRV Y=10;.14;10"
S DR(2,63.912)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;"
S DR(2,63.912)=DR(2,63.912)_"I '$D(LR(1)) S Y=0;1;1.5;3"
S DR(3,63.916)=".01;I '$D(LR(1)) S Y=0;1"
S DR(3,63.982)=".01;D R^LRAPD;.02"
Q
ACY ;Micro Desc/ICDCM Coding
S LRSOP="A"
S (LR(7),LR(6))=1
K DR S DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
S DR=DR_".021//^S X=LR(""TR"");.02;.03;.101;D F80^LRAPD1;.14;@1;"_$S($G(LRCDSYS)=30:"D EN^LRAPICD(LRDXV)",1:80)
Q
SCY ;Supplementary Report, Cyto
S LRSFLG="S"
S (LR(2),LR(7),LR(6))=1
K DR
;Entry of Supp rept must be allowed on released reports
;S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
;S DR=DR_"I LRREL(1) D VMSG^LRAPD1 S LRSFLG="""",Y=0;"
;S DR=DR_".09///^S X=LRWHO;.03;10"
S DR=".09///^S X=LRWHO;.03;10"
S DR(2,63.912)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;I '$D(LR(1)) "
S DR(2,63.912)=DR(2,63.912)_"S Y=0;1;1.5;3"
S DR(3,63.916)=".01;I '$D(LR(1)) S Y=0;1"
S DR(3,63.982)=".01;D R^LRAPD;.02"
Q
PCY ;Special Studies, Cyto
K DR
S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
S DR=DR_"I LRREL(1) D VMSG^LRAPD1 S Y=0;.03;10"
S DR(2,63.912)="5;1.5"
S DR(3,63.982)=".01;D R^LRAPD;.02"
S LR(7)=1
Q
EM ;Gross Desc/Clinical Hx, Em
S LRSOP="G",LR(6)=1
K DR S DR=".09///^S X=LRWHO;.012;.013;.014;.015;.016;"
S DR=DR_".021//^S X=LR(""TR"");1"
S DR(2,63.202)=".01;.06R;.07R"
Q
MEM ;Micro Desc/Gross Review, EM
S LRSOP="M"
K DR S DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
S DR=DR_".021//^S X=LR(""TR"");.02;.03;S:'LRV Y=0;.14"
S (LR(7),LR(6))=1
Q
BEM ;Micro Desc/SNOMED Coding
S LRSOP="B",(LR(2),LR(7),LR(6))=1
K DR S DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
S DR=DR_".021//^S X=LR(""TR"");.02;.03;S:'LRV Y=10;.14;10"
S DR(2,63.212)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;"
S DR(2,63.212)=DR(2,63.212)_"I '$D(LR(1)) S Y=0;1;1.5;3"
S DR(3,63.216)=".01;I '$D(LR(1)) S Y=0;1"
S DR(3,63.282)=".01;D R^LRAPD;.02"
Q
AEM ;Micro Desc/ICDCM Coding
S LRSOP="A"
S (LR(7),LR(6))=1
K DR S DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
S DR=DR_".021//^S X=LR(""TR"");.02;.03;D F80^LRAPD1;.14;@1;"_$S($G(LRCDSYS)=30:"D EN^LRAPICD(LRDXV)",1:80)
Q
SEM ;Supplementary Report, EM
S LRSFLG="S"
S (LR(2),LR(7),LR(6))=1
K DR
;Entry of Supp rept must be allowed on released reports
;S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
;S DR=DR_"I LRREL(1) D VMSG^LRAPD1 S LRSFLG="""",Y=0;"
;S DR=DR_".09///^S X=LRWHO;.03;10"
S DR=".09///^S X=LRWHO;.03;10"
S DR(2,63.212)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;I '$D(LR(1)) "
S DR(2,63.212)=DR(2,63.212)_"S Y=0;1;1.5;3"
S DR(3,63.216)=".01;I '$D(LR(1)) S Y=0;1"
S DR(3,63.282)=".01;D R^LRAPD;.02"
Q
PEM ;Special Studies, EM
K DR
S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
S DR=DR_"I LRREL(1) D VMSG^LRAPD1 S Y=0;.03;10"
S DR(2,63.212)=5,LR(7)=1
Q
VMSG ;Verified message
N LRMSG
S LRMSG=$C(7)_"Report verified. Cannot edit with this option."
D EN^DDIOL(LRMSG,"","!!")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPD1 5653 printed Nov 22, 2024@17:17:18 Page 2
LRAPD1 ;AVAMC/REG/WTY/KLL - AP DATA ENTRY ;9/25/00
+1 ;;5.2;LAB SERVICE;**41,91,248,259,317,350,422**;Sep 27, 1994;Build 29
+2 ;
+3 ;WTY;17-AUG-01;Unwrapped text and add kills for DR string
+4 ;
SP ;Gross Desc/Clinical Hx, Surg Path
+1 SET LRSOP="G"
+2 KILL DR
SET DR=".09///^S X=LRWHO;.012;.013;.014;.015;.016;"
+3 SET DR=DR_".021//^S X=LR(""TR"");1;S:'LR(""FS"") Y=0;1.3"
+4 SET LR(6)=1
SET DR(2,63.812)=".01;.06R;.07R"
+5 QUIT
MSP ;Micro Description/Gross Review, Surg Path
+1 SET LRSOP="M"
+2 KILL DR
SET DR=".09///^S X=LRWHO;S:'LR(""FS"") Y=1;1.3;1;1.1;"
+3 SET DR=DR_"S:'LR(""DX"") Y=.02;1.4;.02;.03;S:'LRV Y=0;.14"
+4 SET (LR(7),LR(6))=1
+5 QUIT
BSP ;Micro Description/Snomed Coding
+1 SET LRSOP="B"
SET (LR(2),LR(7),LR(6))=1
+2 KILL DR
SET DR=".09///^S X=LRWHO;S:'LR(""FS"") Y=1;1.3;1;1.1;"
+3 SET DR=DR_"S:'LR(""DX"") Y=.02;1.4;.02;.03;S:'LRV Y=10;.14;10"
+4 SET DR(2,63.12)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;I '$D(LR(1)) S Y=0;"
+5 SET DR(2,63.12)=DR(2,63.12)_"1;1.5;3"
+6 SET DR(3,63.16)=".01;I '$D(LR(1)) S Y=0;1"
+7 SET DR(3,63.82)=".01;D R^LRAPD;.02"
+8 QUIT
ASP ;Micro Description/ICDCM Coding
+1 SET LRSOP="A"
SET (LR(7),LR(6))=1
+2 KILL DR
SET DR=".09///^S X=LRWHO;S:'LR(""FS"") Y=1;1.3;1;1.1;"
+3 SET DR=DR_"S:'LR(""DX"") Y=.02;1.4;.02;.03;D F80^LRAPD1;.14;@1;"_$SELECT($GET(LRCDSYS)=30:"D EN^LRAPICD(LRDXV)",1:80)
+4 QUIT
F80 ;
+1 IF 'LRV
SET Y="@1"
+2 QUIT
SSP ;Supplementary Report, Surg Path
+1 SET (LRSOP,LRSFLG)="S"
SET (LR(2),LR(7),LR(6))=1
+2 KILL DR
+3 ;Entry of Supp rept must be allowed on released reports
+4 ;S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
+5 ;S DR=DR_"I LRREL(1) D VMSG^LRAPD1 S LRSFLG="""",Y=0;"
+6 ;S DR=DR_".09///^S X=LRWHO;.03;10"
+7 SET DR=".09///^S X=LRWHO;.03;10"
+8 SET DR(2,63.12)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;I '$D(LR(1)) "
+9 SET DR(2,63.12)=DR(2,63.12)_"S Y=0;1;1.5;3"
+10 SET DR(3,63.16)=".01;I '$D(LR(1)) S Y=0;1"
+11 SET DR(3,63.82)=".01;D R^LRAPD;.02"
+12 QUIT
PSP ;Special Studies, Surg Path
+1 SET LRSOP="P"
+2 KILL DR
+3 SET DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
+4 SET DR=DR_"I LRREL(1) D VMSG^LRAPD1 S Y=0;.03;10"
+5 SET DR(2,63.12)="5;1.5"
+6 SET DR(3,63.82)=".01;D R^LRAPD;.02"
SET LR(7)=1
+7 QUIT
CY ;Gross Desc/Clinic Hx, Cytopath
+1 SET LRSOP="G"
+2 KILL DR
SET DR=".09///^S X=LRWHO;.012;.013;.014;.015;.016;"
+3 SET DR=DR_".021//^S X=LR(""TR"");1"
+4 SET LR(6)=1
SET DR(2,63.902)=".01;.02;.06R;.07R"
+5 QUIT
MCY ;Micro Desc/Gross Review, Cytopath
+1 SET LRSOP="M"
+2 KILL DR
SET DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
+3 SET DR=DR_".021//^S X=LR(""TR"");.02;.03;.101;S:'LRV Y=0;.14"
+4 SET (LR(7),LR(6))=1
+5 QUIT
BCY ;Micro Desc/SNOMED Coding, Cytopath
+1 SET LRSOP="B"
SET DIC(0)="M"
+2 SET (LR(2),LR(7),LR(6))=1
+3 KILL DR
SET DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
+4 SET DR=DR_".021//^S X=LR(""TR"");.02;.03;.101;S:'LRV Y=10;.14;10"
+5 SET DR(2,63.912)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;"
+6 SET DR(2,63.912)=DR(2,63.912)_"I '$D(LR(1)) S Y=0;1;1.5;3"
+7 SET DR(3,63.916)=".01;I '$D(LR(1)) S Y=0;1"
+8 SET DR(3,63.982)=".01;D R^LRAPD;.02"
+9 QUIT
ACY ;Micro Desc/ICDCM Coding
+1 SET LRSOP="A"
+2 SET (LR(7),LR(6))=1
+3 KILL DR
SET DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
+4 SET DR=DR_".021//^S X=LR(""TR"");.02;.03;.101;D F80^LRAPD1;.14;@1;"_$SELECT($GET(LRCDSYS)=30:"D EN^LRAPICD(LRDXV)",1:80)
+5 QUIT
SCY ;Supplementary Report, Cyto
+1 SET LRSFLG="S"
+2 SET (LR(2),LR(7),LR(6))=1
+3 KILL DR
+4 ;Entry of Supp rept must be allowed on released reports
+5 ;S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
+6 ;S DR=DR_"I LRREL(1) D VMSG^LRAPD1 S LRSFLG="""",Y=0;"
+7 ;S DR=DR_".09///^S X=LRWHO;.03;10"
+8 SET DR=".09///^S X=LRWHO;.03;10"
+9 SET DR(2,63.912)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;I '$D(LR(1)) "
+10 SET DR(2,63.912)=DR(2,63.912)_"S Y=0;1;1.5;3"
+11 SET DR(3,63.916)=".01;I '$D(LR(1)) S Y=0;1"
+12 SET DR(3,63.982)=".01;D R^LRAPD;.02"
+13 QUIT
PCY ;Special Studies, Cyto
+1 KILL DR
+2 SET DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
+3 SET DR=DR_"I LRREL(1) D VMSG^LRAPD1 S Y=0;.03;10"
+4 SET DR(2,63.912)="5;1.5"
+5 SET DR(3,63.982)=".01;D R^LRAPD;.02"
+6 SET LR(7)=1
+7 QUIT
EM ;Gross Desc/Clinical Hx, Em
+1 SET LRSOP="G"
SET LR(6)=1
+2 KILL DR
SET DR=".09///^S X=LRWHO;.012;.013;.014;.015;.016;"
+3 SET DR=DR_".021//^S X=LR(""TR"");1"
+4 SET DR(2,63.202)=".01;.06R;.07R"
+5 QUIT
MEM ;Micro Desc/Gross Review, EM
+1 SET LRSOP="M"
+2 KILL DR
SET DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
+3 SET DR=DR_".021//^S X=LR(""TR"");.02;.03;S:'LRV Y=0;.14"
+4 SET (LR(7),LR(6))=1
+5 QUIT
BEM ;Micro Desc/SNOMED Coding
+1 SET LRSOP="B"
SET (LR(2),LR(7),LR(6))=1
+2 KILL DR
SET DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
+3 SET DR=DR_".021//^S X=LR(""TR"");.02;.03;S:'LRV Y=10;.14;10"
+4 SET DR(2,63.212)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;"
+5 SET DR(2,63.212)=DR(2,63.212)_"I '$D(LR(1)) S Y=0;1;1.5;3"
+6 SET DR(3,63.216)=".01;I '$D(LR(1)) S Y=0;1"
+7 SET DR(3,63.282)=".01;D R^LRAPD;.02"
+8 QUIT
AEM ;Micro Desc/ICDCM Coding
+1 SET LRSOP="A"
+2 SET (LR(7),LR(6))=1
+3 KILL DR
SET DR=".09///^S X=LRWHO;1;1.1;S:'LR(""DX"") Y=.021;1.4;"
+4 SET DR=DR_".021//^S X=LR(""TR"");.02;.03;D F80^LRAPD1;.14;@1;"_$SELECT($GET(LRCDSYS)=30:"D EN^LRAPICD(LRDXV)",1:80)
+5 QUIT
SEM ;Supplementary Report, EM
+1 SET LRSFLG="S"
+2 SET (LR(2),LR(7),LR(6))=1
+3 KILL DR
+4 ;Entry of Supp rept must be allowed on released reports
+5 ;S DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
+6 ;S DR=DR_"I LRREL(1) D VMSG^LRAPD1 S LRSFLG="""",Y=0;"
+7 ;S DR=DR_".09///^S X=LRWHO;.03;10"
+8 SET DR=".09///^S X=LRWHO;.03;10"
+9 SET DR(2,63.212)=".01;D T^LRAPD;S:'LR(8) Y=4;2;4;I '$D(LR(1)) "
+10 SET DR(2,63.212)=DR(2,63.212)_"S Y=0;1;1.5;3"
+11 SET DR(3,63.216)=".01;I '$D(LR(1)) S Y=0;1"
+12 SET DR(3,63.282)=".01;D R^LRAPD;.02"
+13 QUIT
PEM ;Special Studies, EM
+1 KILL DR
+2 SET DR="N LRREL D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,LRI) "
+3 SET DR=DR_"I LRREL(1) D VMSG^LRAPD1 S Y=0;.03;10"
+4 SET DR(2,63.212)=5
SET LR(7)=1
+5 QUIT
VMSG ;Verified message
+1 NEW LRMSG
+2 SET LRMSG=$CHAR(7)_"Report verified. Cannot edit with this option."
+3 DO EN^DDIOL(LRMSG,"","!!")
+4 QUIT
