Changeset 623 for WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPDA.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPDA.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPDA.m
r613 r623 1 LRAPDA ;DALOI/REG/WTY/KLL/CKA - ANATOMIC PATH DATA ENTRY;11/02/01 2 ;;5.2;LAB SERVICE;**72,73,91,121,248,259,295,317,365**;Sep 27, 1994;Build 9 3 ; 4 ;Reference to ^%DT supported by IA #10003 5 ;Reference to ^DIE supported by IA #10018 6 ;Reference to ^VA(200 supported by IA #10060 7 ;Reference to EN^DDIOL supported by IA #10142 8 ; 9 W !?20,LRO(68)," (",LRABV,")",! 10 S:'$D(LRSOP) LRSOP=1 S:'$D(LRD(1)) LRD(1)="0" 11 S:'$D(^LRO(69.2,LRAA,2,0)) ^(0)="^69.23A^0^0" 12 SEL K LR(1) 13 I $D(LR(2)) D G:%<1 END S:%=1 LR(1)=1 14 .W !!,"Enter Etiology, Function, Procedure & Disease " 15 .S %=2 D YN^LRU 16 AK ;from LRAPD1 17 N CORRECT 18 S:'$D(LRSFLG) LRSFLG="" 19 W !!,"Data entry for ",LRH(0)," " 20 S %=1 D YN^LRU G:%<1 END 21 I %=2 D G:Y<1 END S LRAD=$E(Y,1,3)_"0000",LRH(0)=$E(Y,1,3)+1700 22 .S %DT="AE",%DT(0)="-N",%DT("A")="Enter YEAR: " D ^%DT K %DT 23 I '$O(^LRO(68,LRAA,1,LRAD,1,0)) D Q 24 .W $C(7),!!,"NO ",LRO(68)," ACCESSIONS IN FILE FOR ",LRH(0),!! 25 W K X,Y,LR("CK") 26 R !!,"Select Accession Number/Pt name: ",LRAN:DTIME 27 G:LRAN=""!(LRAN[U) END 28 I LRAN["?" D G W 29 .W !!,"Enter the year ",LRH(0)," ",LRO(68)," accession number to be " 30 .W "updated" 31 .W !,"or locate the accession by entering the patient name." 32 I LRAN'?1N.N D PNAME G:LRAN<1 W D OE1^LR7OB63D,REST,OERR^LR7OB63D G W 33 D OE1^LR7OB63D,REST S:$D(DR(1))#2 DR=DR(1) D OERR^LR7OB63D G W 34 REST ; 35 N LRXSTOP,LRX,LRX1 36 W " for ",LRH(0) 37 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D Q 38 .W $C(7),!!,"Accession # ",LRAN," for ",LRH(0)," not in ",LRO(68),!! 39 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRLLOC=$P(X,"^",7),LRDFN=+X 40 Q:'$D(^LR(LRDFN,0)) S X=^(0) D ^LRUP 41 W !,LRP," ID: ",SSN 42 S LRI=+$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",5) 43 I LRSS'="AU",'$D(^LR(LRDFN,LRSS,LRI,0)) D Q 44 .W $C(7),!,"Inverse date missing or incorrect in Accession Area file " 45 .W "for",!,LRO(68)," Year: ",$E(LRAD,2,3)," Accession: ",LRAN 46 I "SPCYEM"[LRSS,$O(^LR(LRDFN,LRSS,LRI,.1,0)) D 47 .W !,"Specimen(s):" 48 .S X=0 F S X=$O(^LR(LRDFN,LRSS,LRI,.1,X)) Q:'X D 49 ..W !,$P($G(^LR(LRDFN,LRSS,LRI,.1,X,0)),"^") 50 ; 51 ;Don't allow supp. report to be added to a released report if 52 ; modifications are being added via MM option 53 S LRXSTOP=0,(LRX,LRX1)="" 54 I LRSS'="AU",LRD(1)="S" D 55 .S LRX=$P($G(^LR(LRDFN,LRSS,LRI,0)),"^",11) ;release date/time 56 .S LRX1=$P($G(^LR(LRDFN,LRSS,LRI,0)),"^",15) ;orig rel date/time 57 I LRSS="AU",LRSOP="R" D 58 .S LRX=$P($G(^LR(LRDFN,"AU")),"^",15) ;release date/time 59 .S LRX1=$P($G(^LR(LRDFN,"AU")),"^",3) ;date report completed 60 I 'LRX,LRX1 D 61 .W $C(7),!!,"This "_$G(LRAA(1))_" report is currently being" 62 .W !,"modified; it must first be released before Supplementary" 63 .W !,"report can be added.",! 64 .S LRXSTOP=1 65 Q:LRXSTOP 66 ; 67 DIE ;Edit 68 I LRSS="AU" D AUE Q 69 N LRRDT1,LRRDT2,LRIENS,LREL,LRQUIT,LRSNO,LRCPT,LRESCPT 70 S (LREL,LRESCPT,LRQUIT,LRSNO,LRCPT)=0,LRIENS=LRI_","_LRDFN_"," 71 S LRRDT1=$$GET1^DIQ(LRSF,LRIENS,.11,"I") 72 S LRRDT2=$$GET1^DIQ(LRSF,LRIENS,.15,"I") 73 S:LRRDT1!LRRDT2 LREL=1 74 ;Determine if CPT activated 75 I $T(ES^LRCAPES)'="" S LRESCPT=$$ES^LRCAPES() 76 I LRSOP="G",LREL D Q 77 .W $C(7),!!,"Report verified. Cannot edit with this option." 78 I LRSOP'="","ABM"[LRSOP,LREL D Q:LRQUIT 79 .;Allow SNOMED and CPT coding even after release. 80 .W $C(7),!!,"Report has been verified. " 81 .I 'LRESCPT,LRSOP'="B" D Q 82 ..W "Cannot edit with this option." 83 ..S LRQUIT=1 84 .W "Only " 85 .I LRESCPT W "CPT " W:LRSOP="B" "and " 86 .W:LRSOP="B" "SNOMED " 87 .W "coding permitted.",! 88 .I LRSOP="B" D 89 ..K DIR S DIR(0)="Y",DIR("A")="Enter SNOMED coding",DIR("B")="NO" 90 ..D ^DIR W ! 91 ..S LRSNO=+Y 92 .Q:'LRESCPT 93 .K DIR S DIR(0)="Y",DIR("A")="Enter CPT coding",DIR("B")="NO" 94 .D ^DIR W ! 95 .S LRCPT=+Y 96 .I "AM"[LRSOP,'LRCPT S LRQUIT=1 Q 97 .I LRSOP="B",'LRCPT,'LRSNO S LRQUIT=1 98 RESET ;Reset DR string if altered by prior accession/patient 99 ;Reset DR to orig value in LRAPD1 100 I LRSOP'="","AMBS"[LRSOP,$G(LRD)'="" D @LRD 101 I LRSFLG="S",$G(LRD)'="" D @LRD ;For CY,EM Supp entry 102 S:LRSNO DR=10 ;Modify DR string if only SNOMED coding permitted 103 I 'LRSNO,LRCPT S DR="" ;Set DR string to null in only CPT coding 104 ;If adding supp rpt to released rpt, remove date rpt completed from DR 105 I LRRDT1,LRSOP="S"!(LRSFLG="S") S DR=".09///^S X=LRWHO;10" 106 EDIT ;Call to ^DIE 107 W ! S LRA=^LR(LRDFN,LRSS,LRI,0),LRRC=$P(LRA,"^",10) 108 I LRCAPA,"SPCYEM"[LRSS D C^LRAPSWK 109 S DIE="^LR(LRDFN,LRSS,",DA=LRI,DA(1)=LRDFN 110 D CK^LRU Q:$D(LR("CK")) 111 I LRSS="SP",LRSOP="B",$O(^LR(LRDFN,LRSS,LRI,1.3,0)) D 112 .W $C(7),!!,"This accession has a FROZEN SECTION report." 113 .W !,"Be sure 'FROZEN SECTION' is entered as a SNOMED code in the " 114 .W "PROCEDURE field" 115 .W !,"for the appropriate organ or tissue.",!! 116 ;Code S LRELSD is in DR string setup in LRAPR 117 N LRELSD S LRELSD=0 118 D ^DIE 119 S LRAC=$P(LRA,U,6) 120 I LRELSD D MAIN^LRAPRES1(LRDFN,LRSS,LRI,LRSF,LRP,LRAC) 121 D UPDATE^LRPXRM(LRDFN,LRSS,LRI) 122 D:LRSFLG="S"&('$D(Y)) ^LRAPDSR 123 D FRE^LRU 124 I LRSOP'="","ABM"[LRSOP D CPTCOD 125 WKLD ;Capture Workload 126 I LRSOP="Z","CYSP"[LRSS,LRCAPA D S^LRAPR Q 127 I LRCAPA,"SPCYEM"[LRSS,LRD(1)'="","MBA"[LRD(1) D C1^LRAPSWK 128 I LRCAPA,"SPCYEM"[LRSS,LRSOP="G" D C1^LRAPSWK 129 QUEUES ;Update Queues 130 S X=$P(^LR(LRDFN,LRSS,LRI,0),"^",4) 131 I X,$D(^VA(200,X,0)) S LR("TR")=$P(^(0),"^") 132 I "CYEMSP"[LRSS,$D(LR(6)),LRSOP="G" Q:$D(^LRO(69.2,LRAA,1,LRAN,0)) D Q 133 .L +^LRO(69.2,LRAA,1):5 I '$T D Q 134 ..S MSG(1)="The preliminary reports queue is in use by another person." 135 ..S MSG(1,"F")="!!" 136 ..S MSG(2)=" You will need to add this accession to the queue later." 137 ..D EN^DDIOL(.MSG) K MSG 138 .S ^LRO(69.2,LRAA,1,LRAN,0)=LRDFN_"^"_LRI_"^"_LRH(0) 139 .S X=^LRO(69.2,LRAA,1,0),^(0)=$P(X,"^",1,2)_"^"_LRAN_"^"_($P(X,"^",4)+1) 140 .L -^LRO(69.2,LRAA,1) 141 I "CYEMSP"[LRSS,$D(LR(7)),'$D(^LRO(69.2,LRAA,2,LRAN,0)),LRD(1)'="S" D 142 .L +^LRO(69.2,LRAA,2):5 I '$T D Q 143 ..S MSG(1)="The final reports queue is in use by another person. " 144 ..S MSG(1,"F")="!!" 145 ..S MSG(2)="You will need to add this accession to the queue later." 146 ..D EN^DDIOL(.MSG) K MSG 147 .S ^LRO(69.2,LRAA,2,LRAN,0)=LRDFN_"^"_LRI_"^"_LRH(0) 148 .S X=^LRO(69.2,LRAA,2,0),^(0)=$P(X,"^",1,2)_"^"_LRAN_"^"_($P(X,"^",4)+1) 149 .L -^LRO(69.2,LRAA,2) 150 D:LRSOP="M"!(LRSOP="B") EN^LRSPGD 151 Q 152 NM ; 153 I X'["@"!(X["@"&(Y(Z)="")) D Q 154 .W $C(7),!?4,"ENTER WHOLE NUMBERS ONLY",! K X 155 I Y(Z)'="" W $C(7),?40,"OK TO DELETE" S %=2 D YN^LRU I %'=1 K X Q 156 S Y(Z)="" Q 157 ; 158 AUE ;Autopsy Data Entry 159 W ! 160 N LREL,LRQUIT,LRSNO,LRESCPT,LRCPT 161 S (LREL,LRQUIT,LRSNO,LRCPT)=0 162 S LREL=+$$GET1^DIQ(63,LRDFN_",",14.7,"I") 163 ;Determine if CPT activated 164 I $T(ES^LRCAPES)'="" S LRESCPT=$$ES^LRCAPES() 165 ; Allow supp report to be added on verified AU 166 I LRSOP'="","AFIP"[LRSOP,LREL D Q:LRQUIT 167 .Q:LRESCPT&("AP"[LRSOP) 168 .W $C(7),!!,"Report verified. Cannot edit with this option!" 169 .S LRQUIT=1 170 I LRSOP'="","ABP"[LRSOP,LREL D Q:LRQUIT 171 .W $C(7),!!,"Report has been verified. " 172 .W "Only " 173 .I LRESCPT W "CPT " W:LRSOP="B" "and " 174 .W:LRSOP="B" "SNOMED " 175 .W "coding permitted.",! 176 .I LRSOP="B" D 177 ..K DIR S DIR(0)="Y",DIR("A")="Enter SNOMED coding",DIR("B")="NO" 178 ..D ^DIR W ! 179 ..S LRSNO=+Y 180 .Q:'LRESCPT 181 .K DIR S DIR(0)="Y",DIR("A")="Enter CPT coding",DIR("B")="NO" 182 .D ^DIR W ! 183 .S LRCPT=+Y 184 .I "AP"[LRSOP,'LRCPT S LRQUIT=1 Q 185 .I LRSOP="B",'LRCPT,'LRSNO S LRQUIT=1 186 AURESET ;Reset DR to orig value in LRAUDA 187 I LRSOP'="","AP"[LRSOP D @(LRSOP_"DR^LRAUDA") 188 I LRSOP="B" D BDR^LRAUDA 189 S:LRSNO DR=32 ;Modify DR string if only SNOMED coding permitted 190 I 'LRSNO,LRCPT S DR="" ;Set DR string to null inf only CPT coding 191 ; ; 192 ;Not all of the autopsy fields are within the AU subscript. 193 ;Therefore, we must lock the entire LRDFN. 194 L +^LR(LRDFN):5 I '$T D Q 195 .S MSG="This record is locked by another user. " 196 .S MSG=MSG_"Please wait and try again." 197 .D EN^DDIOL(MSG,"","!!") K MSG 198 I LRSFLG'="S" D 199 .N LRELSD S LRELSD=0 200 .S DIE="^LR(",DA=LRDFN 201 .D ^DIE 202 .S LRA=^LR(LRDFN,"AU") 203 .S LRI=$P(LRA,U) 204 .S LRAC=$P(LRA,U,6) 205 .I LRELSD D MAIN^LRAPRES1(LRDFN,LRSS,LRI,LRSF,LRP,LRAC) 206 D:LRSFLG="S" ^LRAPDSR 207 D UPDATE^LRPXRM(LRDFN,"AU") 208 L -^LR(LRDFN) 209 D:"BAP"[LRSOP AU 210 D:LRSOP="R" R 211 I LRSOP'="","ABP"[LRSOP D CPTCOD 212 Q 213 AU I '$D(^LRO(69.2,LRAA,2,LRAN,0)) D 214 .L +^LRO(69.2,LRAA,2):5 I '$T D Q 215 ..S MSG(1)="The final reports queue is in use by another person. " 216 ..S MSG(1,"F")="!!" 217 ..S MSG(2)="You will need to add this accession to the queue later." 218 ..D EN^DDIOL(.MSG) K MSG 219 .S ^LRO(69.2,LRAA,2,LRAN,0)=LRDFN 220 .S X=^LRO(69.2,LRAA,2,0),^(0)=$P(X,"^",1,2)_"^"_LRAN_"^"_($P(X,"^",4)+1) 221 .L -^LRO(69.2,LRAA,2) 222 D AU^LRSPGD 223 Q 224 R I '$D(^LRO(69.2,LRAA,3,LRAN,0)) D 225 .L +^LRO(69.2,LRAA,3):5 I '$T D Q 226 ..S MSG(1)="The interim reports queue is in use by another person. " 227 ..S MSG(1,"F")="!!" 228 ..S MSG(2)="You will need to add this accession to the queue later." 229 ..D EN^DDIOL(.MSG) K MSG 230 .S ^LRO(69.2,LRAA,3,LRAN,0)=LRDFN 231 .S X=^LRO(69.2,LRAA,3,0),^(0)=$P(X,"^",1,2)_"^"_LRAN_"^"_($P(X,"^",4)+1) 232 .L -^LRO(69.2,LRAA,3) 233 Q 234 PNAME ;Patient Name Lookup 235 N LRPFLG ;LRPFLG tells LRUPS to limit accessions to 236 S X=LRAN,LRPFLG=1 ;the chosen year. 237 K LRAN,DIC,VADM,VAIN,VA 238 S DFN=-1,DIC(0)="EQM",(LRX,LRDPF)="" 239 D:'$D(LRLABKY) LABKEY^LRPARAM 240 D DPA1^LRDPA 241 I DFN=-1 S LRAN=-1 Q 242 D I^LRUPS 243 Q 244 CPTCOD ;CPT Coding 245 N LRPRO 246 Q:$T(CPT^LRCAPES)="" 247 Q:LREL&('LRCPT) 248 I 'LREL D 249 .K DIR S DIR(0)="Y",DIR("A")="Enter CPT coding",DIR("B")="NO" 250 .D ^DIR W ! 251 .S LRCPT=+Y 252 Q:'LRCPT 253 ;SET PROVIDER TO CURRENT USER, ALLOW UPDATES 254 S LRPRO=DUZ 255 D PROVIDR^LRAPUTL 256 Q:LRQUIT 257 D CPT^LRCAPES(LRAA,LRAD,LRAN,LRPRO) 258 Q 259 END K LRSFLG 260 D:$T(CLEAN^LRCAPES)'="" CLEAN^LRCAPES 261 D V^LRU 262 Q 1 LRAPDA ;AVAMC/REG/WTY/KLL - ANATOMIC PATH DATA ENTRY;11/02/01 2 ;;5.2;LAB SERVICE;**72,73,91,121,248,259,295,317**;Sep 27, 1994 3 ; 4 ;Reference to ^%DT supported by IA #10003 5 ;Reference to ^DIE supported by IA #10018 6 ;Reference to ^VA(200 supported by IA #10060 7 ;Reference to EN^DDIOL supported by IA #10142 8 ; 9 W !?20,LRO(68)," (",LRABV,")",! 10 S:'$D(LRSOP) LRSOP=1 S:'$D(LRD(1)) LRD(1)="0" 11 S:'$D(^LRO(69.2,LRAA,2,0)) ^(0)="^69.23A^0^0" 12 SEL K LR(1) 13 I $D(LR(2)) D G:%<1 END S:%=1 LR(1)=1 14 .W !!,"Enter Etiology, Function, Procedure & Disease " 15 .S %=2 D YN^LRU 16 AK ;from LRAPD1 17 N CORRECT 18 S:'$D(LRSFLG) LRSFLG="" 19 W !!,"Data entry for ",LRH(0)," " 20 S %=1 D YN^LRU G:%<1 END 21 I %=2 D G:Y<1 END S LRAD=$E(Y,1,3)_"0000",LRH(0)=$E(Y,1,3)+1700 22 .S %DT="AE",%DT(0)="-N",%DT("A")="Enter YEAR: " D ^%DT K %DT 23 I '$O(^LRO(68,LRAA,1,LRAD,1,0)) D Q 24 .W $C(7),!!,"NO ",LRO(68)," ACCESSIONS IN FILE FOR ",LRH(0),!! 25 W K X,Y,LR("CK") 26 R !!,"Select Accession Number/Pt name: ",LRAN:DTIME 27 G:LRAN=""!(LRAN[U) END 28 I LRAN["?" D G W 29 .W !!,"Enter the year ",LRH(0)," ",LRO(68)," accession number to be " 30 .W "updated" 31 .W !,"or locate the accession by entering the patient name." 32 I LRAN'?1N.N D PNAME G:LRAN<1 W D OE1^LR7OB63D,REST,OERR^LR7OB63D G W 33 D OE1^LR7OB63D,REST S:$D(DR(1))#2 DR=DR(1) D OERR^LR7OB63D G W 34 REST ; 35 N LRXSTOP,LRX,LRX1 36 W " for ",LRH(0) 37 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D Q 38 .W $C(7),!!,"Accession # ",LRAN," for ",LRH(0)," not in ",LRO(68),!! 39 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRLLOC=$P(X,"^",7),LRDFN=+X 40 Q:'$D(^LR(LRDFN,0)) S X=^(0) D ^LRUP 41 W !,LRP," ID: ",SSN 42 S LRI=+$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",5) 43 I LRSS'="AU",'$D(^LR(LRDFN,LRSS,LRI,0)) D Q 44 .W $C(7),!,"Inverse date missing or incorrect in Accession Area file " 45 .W "for",!,LRO(68)," Year: ",$E(LRAD,2,3)," Accession: ",LRAN 46 I "SPCYEM"[LRSS,$O(^LR(LRDFN,LRSS,LRI,.1,0)) D 47 .W !,"Specimen(s):" 48 .S X=0 F S X=$O(^LR(LRDFN,LRSS,LRI,.1,X)) Q:'X D 49 ..W !,$P($G(^LR(LRDFN,LRSS,LRI,.1,X,0)),"^") 50 ; 51 ;Don't allow supp. report to be added to a released report if 52 ; modifications are being added via MM option 53 S LRXSTOP=0,(LRX,LRX1)="" 54 I LRSS'="AU",LRD(1)="S" D 55 .S LRX=$P($G(^LR(LRDFN,LRSS,LRI,0)),"^",11) ;release date/time 56 .S LRX1=$P($G(^LR(LRDFN,LRSS,LRI,0)),"^",15) ;orig rel date/time 57 I LRSS="AU",LRSOP="R" D 58 .S LRX=$P($G(^LR(LRDFN,"AU")),"^",15) ;release date/time 59 .S LRX1=$P($G(^LR(LRDFN,"AU")),"^",3) ;date report completed 60 I 'LRX,LRX1 D 61 .W $C(7),!!,"This "_$G(LRAA(1))_" report is currently being" 62 .W !,"modified; it must first be released before Supplementary" 63 .W !,"report can be added.",! 64 .S LRXSTOP=1 65 Q:LRXSTOP 66 ; 67 DIE ;Edit 68 I LRSS="AU" D AUE Q 69 N LRRDT1,LRRDT2,LRIENS,LREL,LRQUIT,LRSNO,LRCPT,LRESCPT 70 S (LREL,LRESCPT,LRQUIT,LRSNO,LRCPT)=0,LRIENS=LRI_","_LRDFN_"," 71 S LRRDT1=$$GET1^DIQ(LRSF,LRIENS,.11,"I") 72 S LRRDT2=$$GET1^DIQ(LRSF,LRIENS,.15,"I") 73 S:LRRDT1!LRRDT2 LREL=1 74 I $T(ES^LRCAPES)'="" S LRESCPT=$$ES^LRCAPES() 75 I LRSOP="G",LREL D Q 76 .W $C(7),!!,"Report verified. Cannot edit with this option." 77 I LRSOP'="","ABM"[LRSOP,LREL D Q:LRQUIT 78 .;Allow SNOMED and CPT coding even after release. 79 .W $C(7),!!,"Report has been verified. " 80 .I 'LRESCPT,LRSOP'="B" D Q 81 ..W "Cannot edit with this option." 82 ..S LRQUIT=1 83 .W "Only " 84 .I LRESCPT W "CPT " W:LRSOP="B" "and " 85 .W:LRSOP="B" "SNOMED " 86 .W "coding permitted.",! 87 .I LRSOP="B" D 88 ..K DIR S DIR(0)="Y",DIR("A")="Enter SNOMED coding",DIR("B")="NO" 89 ..D ^DIR W ! 90 ..S LRSNO=+Y 91 .Q:'LRESCPT 92 .K DIR S DIR(0)="Y",DIR("A")="Enter CPT coding",DIR("B")="NO" 93 .D ^DIR W ! 94 .S LRCPT=+Y 95 .I "AM"[LRSOP,'LRCPT S LRQUIT=1 Q 96 .I LRSOP="B",'LRCPT,'LRSNO S LRQUIT=1 97 RESET ;Reset DR string if altered by prior accession/patient 98 ;Reset DR to orig value in LRAPD1 99 I LRSOP'="","AMBS"[LRSOP,$G(LRD)'="" D @LRD 100 I LRSFLG="S",$G(LRD)'="" D @LRD ;For CY,EM Supp entry 101 S:LRSNO DR=10 ;Modify DR string if only SNOMED coding permitted 102 I 'LRSNO,LRCPT S DR="" ;Set DR string to null in only CPT coding 103 ;If adding supp rpt to released rpt, remove date rpt completed from DR 104 I LRRDT1,LRSOP="S"!(LRSFLG="S") S DR=".09///^S X=LRWHO;10" 105 EDIT ;Call to ^DIE 106 W ! S LRA=^LR(LRDFN,LRSS,LRI,0),LRRC=$P(LRA,"^",10) 107 I LRCAPA,"SPCYEM"[LRSS D C^LRAPSWK 108 S DIE="^LR(LRDFN,LRSS,",DA=LRI,DA(1)=LRDFN 109 D CK^LRU Q:$D(LR("CK")) 110 I LRSS="SP",LRSOP="B",$O(^LR(LRDFN,LRSS,LRI,1.3,0)) D 111 .W $C(7),!!,"This accession has a FROZEN SECTION report." 112 .W !,"Be sure 'FROZEN SECTION' is entered as a SNOMED code in the " 113 .W "PROCEDURE field" 114 .W !,"for the appropriate organ or tissue.",!! 115 D ^DIE 116 D UPDATE^LRPXRM(LRDFN,LRSS,LRI) 117 D:LRSFLG="S"&('$D(Y)) ^LRAPDSR 118 D FRE^LRU 119 I LRSOP'="","ABM"[LRSOP D CPTCOD 120 WKLD ;Capture Workload 121 I LRSOP="Z","CYSP"[LRSS,LRCAPA D S^LRAPR Q 122 I LRCAPA,"SPCYEM"[LRSS,LRD(1)'="","MBA"[LRD(1) D C1^LRAPSWK 123 I LRCAPA,"SPCYEM"[LRSS,LRSOP="G" D C1^LRAPSWK 124 QUEUES ;Update Queues 125 S X=$P(^LR(LRDFN,LRSS,LRI,0),"^",4) 126 I X,$D(^VA(200,X,0)) S LR("TR")=$P(^(0),"^") 127 I "CYEMSP"[LRSS,$D(LR(6)),LRSOP="G" Q:$D(^LRO(69.2,LRAA,1,LRAN,0)) D Q 128 .L +^LRO(69.2,LRAA,1):5 I '$T D Q 129 ..S MSG(1)="The preliminary reports queue is in use by another person." 130 ..S MSG(1,"F")="!!" 131 ..S MSG(2)=" You will need to add this accession to the queue later." 132 ..D EN^DDIOL(.MSG) K MSG 133 .S ^LRO(69.2,LRAA,1,LRAN,0)=LRDFN_"^"_LRI_"^"_LRH(0) 134 .S X=^LRO(69.2,LRAA,1,0),^(0)=$P(X,"^",1,2)_"^"_LRAN_"^"_($P(X,"^",4)+1) 135 .L -^LRO(69.2,LRAA,1) 136 I "CYEMSP"[LRSS,$D(LR(7)),'$D(^LRO(69.2,LRAA,2,LRAN,0)),LRD(1)'="S" D 137 .L +^LRO(69.2,LRAA,2):5 I '$T D Q 138 ..S MSG(1)="The final reports queue is in use by another person. " 139 ..S MSG(1,"F")="!!" 140 ..S MSG(2)="You will need to add this accession to the queue later." 141 ..D EN^DDIOL(.MSG) K MSG 142 .S ^LRO(69.2,LRAA,2,LRAN,0)=LRDFN_"^"_LRI_"^"_LRH(0) 143 .S X=^LRO(69.2,LRAA,2,0),^(0)=$P(X,"^",1,2)_"^"_LRAN_"^"_($P(X,"^",4)+1) 144 .L -^LRO(69.2,LRAA,2) 145 D:LRSOP="M"!(LRSOP="B") EN^LRSPGD 146 Q 147 NM ; 148 I X'["@"!(X["@"&(Y(Z)="")) D Q 149 .W $C(7),!?4,"ENTER WHOLE NUMBERS ONLY",! K X 150 I Y(Z)'="" W $C(7),?40,"OK TO DELETE" S %=2 D YN^LRU I %'=1 K X Q 151 S Y(Z)="" Q 152 ; 153 AUE ;Autopsy Data Entry 154 W ! 155 N LREL,LRQUIT,LRSNO,LRESCPT,LRCPT 156 S (LREL,LRQUIT,LRSNO,LRCPT)=0 157 S LREL=+$$GET1^DIQ(63,LRDFN_",",14.7,"I") 158 I $T(ES^LRCAPES)'="" S LRESCPT=$$ES^LRCAPES() 159 ; Allow supp report to be added on verified AU 160 I LRSOP'="","AFIP"[LRSOP,LREL D Q:LRQUIT 161 .Q:LRESCPT&("AP"[LRSOP) 162 .W $C(7),!!,"Report verified. Cannot edit with this option!" 163 .S LRQUIT=1 164 I LRSOP'="","ABP"[LRSOP,LREL D Q:LRQUIT 165 .W $C(7),!!,"Report has been verified. " 166 .W "Only " 167 .I LRESCPT W "CPT " W:LRSOP="B" "and " 168 .W:LRSOP="B" "SNOMED " 169 .W "coding permitted.",! 170 .I LRSOP="B" D 171 ..K DIR S DIR(0)="Y",DIR("A")="Enter SNOMED coding",DIR("B")="NO" 172 ..D ^DIR W ! 173 ..S LRSNO=+Y 174 .Q:'LRESCPT 175 .K DIR S DIR(0)="Y",DIR("A")="Enter CPT coding",DIR("B")="NO" 176 .D ^DIR W ! 177 .S LRCPT=+Y 178 .I "AP"[LRSOP,'LRCPT S LRQUIT=1 Q 179 .I LRSOP="B",'LRCPT,'LRSNO S LRQUIT=1 180 AURESET ;Reset DR to orig value in LRAUDA 181 I LRSOP'="","AP"[LRSOP D @(LRSOP_"DR^LRAUDA") 182 I LRSOP="B" D BDR^LRAUDA 183 S:LRSNO DR=32 ;Modify DR string if only SNOMED coding permitted 184 I 'LRSNO,LRCPT S DR="" ;Set DR string to null inf only CPT coding 185 ; ; 186 ;Not all of the autopsy fields are within the AU subscript. 187 ;Therefore, we must lock the entire LRDFN. 188 L +^LR(LRDFN):5 I '$T D Q 189 .S MSG="This record is locked by another user. " 190 .S MSG=MSG_"Please wait and try again." 191 .D EN^DDIOL(MSG,"","!!") K MSG 192 I LRSFLG'="S" D 193 .S DIE="^LR(",DA=LRDFN 194 .D ^DIE 195 D:LRSFLG="S" ^LRAPDSR 196 D UPDATE^LRPXRM(LRDFN,"AU") 197 L -^LR(LRDFN) 198 D:"BAP"[LRSOP AU 199 D:LRSOP="R" R 200 I LRSOP'="","ABP"[LRSOP D CPTCOD 201 Q 202 AU I '$D(^LRO(69.2,LRAA,2,LRAN,0)) D 203 .L +^LRO(69.2,LRAA,2):5 I '$T D Q 204 ..S MSG(1)="The final reports queue is in use by another person. " 205 ..S MSG(1,"F")="!!" 206 ..S MSG(2)="You will need to add this accession to the queue later." 207 ..D EN^DDIOL(.MSG) K MSG 208 .S ^LRO(69.2,LRAA,2,LRAN,0)=LRDFN 209 .S X=^LRO(69.2,LRAA,2,0),^(0)=$P(X,"^",1,2)_"^"_LRAN_"^"_($P(X,"^",4)+1) 210 .L -^LRO(69.2,LRAA,2) 211 D AU^LRSPGD 212 Q 213 R I '$D(^LRO(69.2,LRAA,3,LRAN,0)) D 214 .L +^LRO(69.2,LRAA,3):5 I '$T D Q 215 ..S MSG(1)="The interim reports queue is in use by another person. " 216 ..S MSG(1,"F")="!!" 217 ..S MSG(2)="You will need to add this accession to the queue later." 218 ..D EN^DDIOL(.MSG) K MSG 219 .S ^LRO(69.2,LRAA,3,LRAN,0)=LRDFN 220 .S X=^LRO(69.2,LRAA,3,0),^(0)=$P(X,"^",1,2)_"^"_LRAN_"^"_($P(X,"^",4)+1) 221 .L -^LRO(69.2,LRAA,3) 222 Q 223 PNAME ;Patient Name Lookup 224 N LRPFLG ;LRPFLG tells LRUPS to limit accessions to 225 S X=LRAN,LRPFLG=1 ;the chosen year. 226 K LRAN,DIC,VADM,VAIN,VA 227 S DFN=-1,DIC(0)="EQM",(LRX,LRDPF)="" 228 D:'$D(LRLABKY) LABKEY^LRPARAM 229 D DPA1^LRDPA 230 I DFN=-1 S LRAN=-1 Q 231 D I^LRUPS 232 Q 233 CPTCOD ;CPT Coding 234 N LRPRO 235 Q:$T(CPT^LRCAPES)="" 236 Q:LREL&('LRCPT) 237 I 'LREL D 238 .K DIR S DIR(0)="Y",DIR("A")="Enter CPT coding",DIR("B")="NO" 239 .D ^DIR W ! 240 .S LRCPT=+Y 241 Q:'LRCPT 242 ;SET PROVIDER TO CURRENT USER, ALLOW UPDATES 243 S LRPRO=DUZ 244 D PROVIDR^LRAPUTL 245 Q:LRQUIT 246 D CPT^LRCAPES(LRAA,LRAD,LRAN,LRPRO) 247 Q 248 END K LRSFLG 249 D:$T(CLEAN^LRCAPES)'="" CLEAN^LRCAPES 250 D V^LRU 251 Q
Note:
See TracChangeset
for help on using the changeset viewer.
