Changeset 623 for WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPR.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPR.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPR.m
r613 r623 1 LRAPR ;DALOI/REG/WTY/KLL/CKA - ANAT RELEASE REPORTS ;10/30/01 2 ;;5.2;LAB SERVICE;**72,248,259,317,365**;Sep 27, 1994;Build 9 3 ; 4 N LRESSW 5 D SWITCH 6 I +LRESSW D Q 7 .D ^LRAPRES 8 .D END 9 W !!?27,"Release Pathology Reports",!! 10 D A 11 I '$D(LRSS) D END Q 12 I LRCAPA D G:'$D(X) END 13 .S X=$S(LRSS="CY":"CYTOLOGY REPORTING",LRSS="SP":"SURGICAL PATH REPORTING",1:"") 14 .D:X]"" X^LRUWK 15 I LRSS="AU" D B Q 16 S LRSOP="Z" 17 S DR="S A=^LR(LRDFN,LRSS,LRI,0),LRZ=$P(A,U,3),LRZ(1)=$P(A,U,13)," 18 S DR=DR_"LRZ(2)=$P(A,U,11),LRZ(3)=$P(A,U,2);" 19 S DR=DR_"I 'LRZ W $C(7),!,""No date report completed. " 20 S DR=DR_"Cannot release."" S Y=0;" 21 S DR=DR_"I 'LRZ(2) D NMPATH^LRAPR;" 22 S DR=DR_"I LRZ(2) D RINFO^LRAPR S Y=0;" 23 ;Perform supp edit regardless if date rept released since supp rpt 24 ; is added to released report 25 S DR=DR_"D SUPCHK^LRAPR;" 26 S DR=DR_"S DIR(0)=""YA"",DIR(""A"")=""Release report? """ 27 S DR=DR_",DIR(""B"")=""NO"" D ^DIR K:Y Y S:$D(Y) Y=0;" 28 S DR=DR_".11////^D NOW^%DTC S X=%;.13////^S X=DUZ;" 29 S DR=DR_"S LRELSD=1 W !!,""Report released...""" 30 D ^LRAPDA 31 D END 32 Q 33 ; 34 B ;Autopsy 35 S LRSOP="Z" 36 S DR="S A=$G(^LR(LRDFN,""AU"")) I A="""" S Y=0;" 37 S DR=DR_"S LRZ=$P(A,U,3),LRZ(1)=$P(A,U,16),LRZ(2)=$P(A,U,15)," 38 ;KLL-LRZ(3)=SR PATHOLOGIST,LRZ(4)=PROVISIONAL DATE 39 S DR=DR_"LRZ(3)=$P(A,U,10),LRZ(4)=$P(A,U,17);" 40 ;KLL-PROVISIONAL OR DATE REPORT COMPLETED IS REQUIRED 41 S DR=DR_"I 'LRZ(4),'LRZ W $C(7),!,""Provisional date or date report completed required. " 42 S DR=DR_"Cannot release."" S Y=0;" 43 S DR=DR_"I 'LRZ(2) D NMPATH^LRAPR;" 44 S DR=DR_"I LRZ(2) D RINFO^LRAPR S Y=0;" 45 ;Perform supp edit regardless if date rept released since supp rpt 46 ; is added to released report 47 S DR=DR_"D SUPCHK^LRAPR;" 48 S DR=DR_"D RELEASE^LRAPR;" 49 S DR=DR_"D NOW^%DTC S LRDTE=%;" 50 S DR=DR_"14.7////^S X=$S(LRZ(2):""@"",1:LRDTE);" 51 S DR=DR_"14.8////^S X=$S(LRZ(2):""@"",1:DUZ);" 52 S DR=DR_"S:'LRZ(2) LRELSD=1 " 53 S DR=DR_"W !!,""Report "" W:LRZ(2) ""un"" W ""released..."";K LRDTE" 54 D ^LRAPDA 55 D END 56 Q 57 EN ;Supplementary Report Entry Point 58 N LRESSW 59 D SWITCH 60 W !!?20,"Release Supplementary Pathology Reports",! 61 ;D A 62 ;Section prompt replaces the line above 63 S LRQUIT=0 64 D SECTION^LRAPRES 65 I '$D(LRSS) D END Q 66 ;Verify User ID has access to release supp. reports 67 S LREND=0 68 I LRESSW D CLSSCHK^LRAPRES1(DUZ,.LREND) 69 Q:LREND 70 ; 71 W !!,"Data entry for ",LRH(0)," " 72 S %=1 D YN^LRU G:%<1 END 73 I %=2 D G:Y<1 END 74 .S %DT="AE",%DT(0)="-N",%DT("A")="Enter YEAR: " D ^%DT K %DT 75 .Q:Y<1 S LRAD=$E(Y,1,3)_"0000",LRH(0)=$E(Y,1,3)+1700 76 I '$D(^LRO(68,LRAA,1,LRAD,0)) D Q 77 .W $C(7),!!,"NO ",LRAA(1)," ACCESIONS IN FILE FOR ",LRH(0),!! 78 W K X,Y,LR("CK") R !!,"Select Accession Number/Pt name: ",LRAN:DTIME 79 G:LRAN=""!(LRAN[U) END 80 I LRAN'?1N.N D G:LRAN<1 END G W 81 .D PNAME^LRAPDA 82 .Q:LRAN<1 83 .D DIE 84 D REST 85 G W 86 REST W " for ",LRH(0) 87 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D Q 88 .W $C(7),!!,"Accession # ",LRAN," for ",LRH(0) 89 .W " not in ACCESSION file",!! 90 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRLLOC=$P(X,"^",7),LRDFN=+X 91 Q:'$D(^LR(LRDFN,0)) S X=^(0) D ^LRUP 92 W !,LRP," ID: ",SSN 93 I LRSS'="AU" D 94 .S LRI=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^",5) 95 .W !,"Specimen(s):" 96 .S X=0 F S X=$O(^LR(LRDFN,LRSS,LRI,.1,X)) Q:'X D 97 ..I $D(^LR(LRDFN,LRSS,LRI,.1,X,0)),$L(^(0)) W !,^(0) 98 DIE ;Define default supplementary report 99 N LRFILE,LRIENS,LRIENS1,LRX,LRRLS,LRFDA,LRLKFL,LRDA,LRQUIT,LRNOSP 100 N LRMSG,LRSRFL,LRFDA2,LRSRMD,LRRLM 101 S DIC("B")="",LRNOSP=0 102 I LRSS'="AU" D 103 .S LRFILE=+$$GET1^DID(LRSF,1.2,"","SPECIFIER") 104 .S LRIENS1=LRI_","_LRDFN_"," 105 .I '+$P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),"^",4) S LRNOSP=1 Q 106 .S LRX=0 F S LRX=$O(^LR(LRDFN,LRSS,LRI,1.2,LRX)) Q:'LRX D 107 ..S LRIENS=LRX_","_LRIENS1 108 ..S LRSRFL=$$GET1^DIQ(LRFILE,LRIENS,.02,"I") 109 ..;LRSRMD-set to 1 if supp rpt modified and requires release 110 ..S LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I") 111 ..Q:LRSRFL&('LRSRMD) 112 ..S DIC("B")=$$GET1^DIQ(LRFILE,LRIENS,.01,"I") 113 I LRSS="AU" D 114 .S LRFILE=63.324,LRIENS1=LRDFN_"," 115 .I '+$P($G(^LR(LRDFN,84,0)),"^",4) S LRNOSP=1 Q 116 .S LRX=0 F S LRX=$O(^LR(LRDFN,84,LRX)) Q:'LRX D 117 ..S LRIENS=LRX_","_LRIENS1 118 ..S LRSRFL=$$GET1^DIQ(LRFILE,LRIENS,.02,"I") 119 ..;LRSRMD-set to 1 if supp rpt modified and requires release 120 ..S LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I") 121 ..Q:LRSRFL&('LRSRMD) 122 ..S DIC("B")=$$GET1^DIQ(LRFILE,LRIENS,.01,"I") 123 I LRNOSP D Q 124 .K LRMSG 125 .S LRMSG=$C(7)_"No supplementary reports exist for this accession." 126 .D EN^DDIOL(LRMSG,"","!!") 127 I 'DIC("B") D Q 128 .K LRMSG 129 .S LRMSG=$C(7)_"All supplementary reports have been released." 130 .D EN^DDIOL(LRMSG,"","!!") 131 DIE1 ; 132 S (LRQUIT,LRRLM)=0 133 F D Q:LRQUIT 134 .W ! 135 .S:LRSS="AU" (LRLKFL,DIC)="^LR(LRDFN,84," 136 .S:LRSS'="AU" (LRLKFL,DIC)="^LR(LRDFN,LRSS,LRI,1.2," 137 .S DIC("A")="Select SUPPLEMENTARY REPORT DATE: " 138 .S DIC(0)="AEQM" 139 .D ^DIC K DIC 140 .I Y<1 S LRQUIT=1 Q 141 .S LRDA=+Y 142 .S LRIENS=LRDA_","_LRIENS1 143 .S LRRLS=+$$GET1^DIQ(LRFILE,LRIENS,.02,"I") 144 .;If E-Sign OFF, must check LRRLM. LRRLM=1 if supp rpt has been 145 .; modified and requires release 146 .S LRRLM=+$$GET1^DIQ(LRFILE,LRIENS,.03,"I") 147 .I LRESSW,LRRLS D Q 148 ..W !!,"This supplementary report has already been released.",! 149 .I 'LRESSW,LRRLS D Q:'LRRLM 150 ..I 'LRRLM W !!,"This supplementary rept has already been released.",! 151 .W ! 152 .I LRESSW D Q 153 ..D ESIG Q:LRQUIT 154 ..D UPDATE 155 .S DIR("A")="Release supplementary report",DIR(0)="Y",DIR("B")="NO" 156 .D ^DIR K DIR 157 .Q:'Y 158 .D UPDATE 159 .;If E-sign switch OFF and orig report released, must verify all 160 .; supp reports released before release main report. 161 .I LRCKREL,'LRESSW D CHKSUP^LRAPR1 162 Q 163 ; 164 A D ^LRAP G:'$D(Y) END 165 Q 166 C ; 167 S LRDICS="SPCYEM" D ^LRAP 168 G:'$D(Y) END 169 Q 170 S ;from LRAPDA 171 S LRK=$P(^LR(LRDFN,LRSS,LRI,0),"^",11) Q:'LRK S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)) ^(0)="^68.04PA^^" 172 Q:$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0)) S ^(0)=LRT_"^50^^"_DUZ_"^"_LRK,X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,0),^(0)=$P(X,"^",1,2)_"^"_LRT_"^"_($P(X,"^",4)+1) 173 S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0)) ^(0)="^68.14P^^" 174 S C=0 F S C=$O(LRT(C)) Q:'C D CAP 175 S ^LRO(68,"AA",LRAA_"|"_LRAD_"|"_LRAN_"|"_LRT)="" 176 Q 177 ; 178 CAP S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,C,0)=C_"^1^0^0^^"_LRK_"^"_DUZ_"^"_DUZ(2)_"^"_LRAA_"^"_LRAA_"^"_LRAA 179 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0),^(0)=$P(X,"^",1,2)_"^"_C_"^"_($P(X,"^",4)+1) 180 Q 181 ; 182 SWITCH ;Check to see if electronic signature is enabled 183 D GETDATA^LRAPESON(.LRESSW) 184 Q 185 ESIG ;Prompt for electronic signature 186 S LRQUIT=0 187 D SIG^XUSESIG 188 I X1="" D 189 .W " SIGNATURE NOT VERIFIED" 190 .S LRQUIT=1 191 Q 192 UPDATE ; 193 S LRLKFL=LRLKFL_LRDA_",0)" 194 L +@(LRLKFL):5 I '$T D Q 195 .S LRMSG="This record is locked by another user. " 196 .S LRMSG=LRMSG_"Please wait and try again." 197 .D EN^DDIOL(LRMSG,"","!!") 198 S LRFDA(LRFILE,LRIENS,.02)=1 199 S LRFDA2(LRFILE,LRIENS,.02)="@" ;Set but don't file unless unrel needed 200 ;File signer ID and Date/time of released supp report 201 D CKSIGNR^LRAPR1 202 D FILE^DIE("","LRFDA") 203 W "...Released" 204 L -@(LRLKFL) 205 I LRSS="AU" D 206 .S LRA=^LR(LRDFN,"AU") 207 .S LRAC=$$GET1^DIQ(63,LRDFN_",",14,"I") 208 .S LRI=$P(LRA,U) 209 I LRSS'="AU" D 210 .S LRA=^LR(LRDFN,LRSS,LRI,0) 211 .S LRAC=$$GET1^DIQ(LRSF,LRIENS,.06,"I") 212 D MAIN^LRAPRES1(LRDFN,LRSS,LRI,LRSF,LRP,LRAC) 213 ;If all supp reports released, and E-Sign switch is ON, proceed to 214 ; release main report 215 S LRCKREL=0 216 S:LRSS'="AU" LRCKREL=$P(^LR(LRDFN,LRSS,LRI,0),"^",11) 217 S:LRSS="AU" LRCKREL=$P(^LR(LRDFN,LRSS),"^",15) 218 I LRCKREL,LRESSW D RELMN 219 Q 220 SUPCHK ;Check for unreleased supplementary reports 221 N LRSR,LRSR1,LRSR2 222 S LRSR=0,LRSR1=1 223 I LRSS'="AU" D 224 .Q:'+$P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4) 225 .F S LRSR=$O(^LR(LRDFN,LRSS,LRI,1.2,LRSR)) Q:LRSR'>0!('LRSR1) D 226 ..S LRSR1=+$P(^LR(LRDFN,LRSS,LRI,1.2,LRSR,0),U,2) 227 ..I 'LRSR1 D 228 ...S Y=+$P(^LR(LRDFN,LRSS,LRI,1.2,LRSR,0),U) 229 ...D DD^%DT S LRSR2=Y 230 I LRSS="AU" D 231 .Q:'+$P($G(^LR(LRDFN,84,0)),U,4) 232 .F S LRSR=$O(^LR(LRDFN,84,LRSR)) Q:LRSR'>0!('LRSR1) D 233 ..S LRSR1=+$P(^LR(LRDFN,84,LRSR,0),U,2) 234 ..I 'LRSR1 D 235 ...S Y=+$P(^LR(LRDFN,84,LRSR,0),U) 236 ...D DD^%DT S LRSR2=Y 237 I 'LRSR1 D 238 .W $C(7),!,"Supplementary report "_LRSR2_" has not been released. " 239 .W "Cannot release." 240 .S Y=0 241 Q 242 RINFO ;Display release information 243 W $C(7),!,"Report " 244 W:LRZ(2)=1 "has already been " 245 W "released " 246 S Y=LRZ(2) 247 D DD^%DT 248 W:LRZ(2)>1 Y 249 W:LRZ(1)'="" " by "_$P($G(^VA(200,LRZ(1),0)),U) 250 K Y 251 Q 252 NMPATH ;Check for missing pathologist name 253 I 'LRZ(3) D 254 .W $C(7),!,"Pathologist name missing. Cannot release." 255 .S Y=0 256 Q 257 RELEASE ;Prompt for release/unrelease 258 W ! S DIR(0)="YA",DIR("B")="NO" 259 S:LRZ(2) DIR("A")="Unrelease report? " 260 S:'LRZ(2) DIR("A")="Release report? " 261 D ^DIR 262 K:Y Y 263 I $D(Y) S Y=0 264 Q 265 RELMN ;Allow release of main report as long as all supp reports are 266 ; released, and signer is same person for main and supp report(s) 267 ;Make sure all supp reports signed out 268 S LRQT=0 269 D RELCHK^LRAPR1 270 Q:LRQT 271 ; 272 ;Continue with electronic signature and storage in TIU 273 S LRAU=$S(LRSS="AU":1,1:0) 274 I 'LRAU D 275 .S LRPAT=+$$GET1^DIQ(LRSF,LRIENS1,.02,"I") 276 .S LRZ=$$GET1^DIQ(LRSF,LRIENS1,.03,"I") 277 .S LRZ(1)=$$GET1^DIQ(LRSF,LRIENS1,.13,"I") 278 .S LRZ(1.1)=$$GET1^DIQ(LRSF,LRIENS1,.13) 279 .S LRZ(2)=$$GET1^DIQ(LRSF,LRIENS1,.11,"I") 280 I LRAU D 281 .S LRPAT=+$$GET1^DIQ(63,LRDFN_",",13.6,"I") 282 .S LRZ=$$GET1^DIQ(63,LRDFN_",",13,"I") 283 .S LRZ(1)=$$GET1^DIQ(63,LRDFN_",",14.8,"I") 284 .S LRZ(1.1)=$$GET1^DIQ(63,LRDFN_",",14.8) 285 .S LRZ(2)=$$GET1^DIQ(63,LRDFN_",",14.7,"I") 286 W !!,?25,"*** Main Report Release ***",! 287 D NOW^%DTC S LRNTIME=% 288 D TIUPREP^LRAPRES 289 D STORE^LRAPRES 290 I LRQUIT D FILE^DIE("","LRFDA2") Q 291 D UNRLSE^LRAPR1 292 D RELEASE^LRAPRES 293 I LRQUIT D FILE^DIE("","LRFDA2") Q 294 D OERR^LR7OB63D 295 S LRQUIT=1 296 Q 297 END ; 298 D V^LRU 299 Q 1 LRAPR ;AVAMC/REG/WTY/KLL- ANAT RELEASE REPORTS ;10/30/01 2 ;;5.2;LAB SERVICE;**72,248,259,317**;Sep 27, 1994 3 ; 4 N LRESSW 5 D SWITCH 6 I +LRESSW D Q 7 .D ^LRAPRES 8 .D END 9 W !!?27,"Release Pathology Reports",!! 10 D A 11 I '$D(LRSS) D END Q 12 I LRCAPA D G:'$D(X) END 13 .S X=$S(LRSS="CY":"CYTOLOGY REPORTING",LRSS="SP":"SURGICAL PATH REPORTING",1:"") 14 .D:X]"" X^LRUWK 15 I LRSS="AU" D B Q 16 S LRSOP="Z" 17 S DR="S A=^LR(LRDFN,LRSS,LRI,0),LRZ=$P(A,U,3),LRZ(1)=$P(A,U,13)," 18 S DR=DR_"LRZ(2)=$P(A,U,11),LRZ(3)=$P(A,U,2);" 19 S DR=DR_"I 'LRZ W $C(7),!,""No date report completed. " 20 S DR=DR_"Cannot release."" S Y=0;" 21 S DR=DR_"I 'LRZ(2) D NMPATH^LRAPR;" 22 S DR=DR_"I LRZ(2) D RINFO^LRAPR S Y=0;" 23 ;Perform supp edit regardless if date rept released since supp rpt 24 ; is added to released report 25 S DR=DR_"D SUPCHK^LRAPR;" 26 S DR=DR_"S DIR(0)=""YA"",DIR(""A"")=""Release report? """ 27 S DR=DR_",DIR(""B"")=""NO"" D ^DIR K:Y Y S:$D(Y) Y=0;" 28 S DR=DR_".11////^D NOW^%DTC S X=%;.13////^S X=DUZ;" 29 S DR=DR_"W !!,""Report released...""" 30 D ^LRAPDA 31 D END 32 Q 33 ; 34 B ;Autopsy 35 S LRSOP="Z" 36 S DR="S A=$G(^LR(LRDFN,""AU"")) I A="""" S Y=0;" 37 S DR=DR_"S LRZ=$P(A,U,3),LRZ(1)=$P(A,U,16),LRZ(2)=$P(A,U,15)," 38 ;KLL-LRZ(3)=SR PATHOLOGIST,LRZ(4)=PROVISIONAL DATE 39 S DR=DR_"LRZ(3)=$P(A,U,10),LRZ(4)=$P(A,U,17);" 40 ;KLL-PROVISIONAL OR DATE REPORT COMPLETED IS REQUIRED 41 S DR=DR_"I 'LRZ(4),'LRZ W $C(7),!,""Provisional date or date report completed required. " 42 S DR=DR_"Cannot release."" S Y=0;" 43 S DR=DR_"I 'LRZ(2) D NMPATH^LRAPR;" 44 S DR=DR_"I LRZ(2) D RINFO^LRAPR S Y=0;" 45 ;Perform supp edit regardless if date rept released since supp rpt 46 ; is added to released report 47 S DR=DR_"D SUPCHK^LRAPR;" 48 S DR=DR_"D RELEASE^LRAPR;" 49 S DR=DR_"D NOW^%DTC S LRDTE=%;" 50 S DR=DR_"14.7////^S X=$S(LRZ(2):""@"",1:LRDTE);" 51 S DR=DR_"14.8////^S X=$S(LRZ(2):""@"",1:DUZ);" 52 S DR=DR_"W !!,""Report "" W:LRZ(2) ""un"" W ""released..."";K LRDTE" 53 D ^LRAPDA 54 D END 55 Q 56 EN ;Supplementary Report Entry Point 57 N LRESSW 58 D SWITCH 59 W !!?20,"Release Supplementary Pathology Reports",! 60 ;D A 61 ;Section prompt replaces the line above 62 S LRQUIT=0 63 D SECTION^LRAPRES 64 I '$D(LRSS) D END Q 65 ;Verify User ID has access to release supp. reports 66 S LREND=0 67 I LRESSW D CLSSCHK^LRAPRES1(DUZ,.LREND) 68 Q:LREND 69 ; 70 W !!,"Data entry for ",LRH(0)," " 71 S %=1 D YN^LRU G:%<1 END 72 I %=2 D G:Y<1 END 73 .S %DT="AE",%DT(0)="-N",%DT("A")="Enter YEAR: " D ^%DT K %DT 74 .Q:Y<1 S LRAD=$E(Y,1,3)_"0000",LRH(0)=$E(Y,1,3)+1700 75 I '$D(^LRO(68,LRAA,1,LRAD,0)) D Q 76 .W $C(7),!!,"NO ",LRAA(1)," ACCESIONS IN FILE FOR ",LRH(0),!! 77 W K X,Y,LR("CK") R !!,"Select Accession Number/Pt name: ",LRAN:DTIME 78 G:LRAN=""!(LRAN[U) END 79 I LRAN'?1N.N D G:LRAN<1 END G W 80 .D PNAME^LRAPDA 81 .Q:LRAN<1 82 .D DIE 83 D REST 84 G W 85 REST W " for ",LRH(0) 86 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D Q 87 .W $C(7),!!,"Accession # ",LRAN," for ",LRH(0) 88 .W " not in ACCESSION file",!! 89 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRLLOC=$P(X,"^",7),LRDFN=+X 90 Q:'$D(^LR(LRDFN,0)) S X=^(0) D ^LRUP 91 W !,LRP," ID: ",SSN 92 I LRSS'="AU" D 93 .S LRI=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^",5) 94 .W !,"Specimen(s):" 95 .S X=0 F S X=$O(^LR(LRDFN,LRSS,LRI,.1,X)) Q:'X D 96 ..I $D(^LR(LRDFN,LRSS,LRI,.1,X,0)),$L(^(0)) W !,^(0) 97 DIE ;Define default supplementary report 98 N LRFILE,LRIENS,LRIENS1,LRX,LRRLS,LRFDA,LRLKFL,LRDA,LRQUIT,LRNOSP 99 N LRMSG,LRSRFL,LRFDA2,LRSRMD,LRRLM 100 S DIC("B")="",LRNOSP=0 101 I LRSS'="AU" D 102 .S LRFILE=+$$GET1^DID(LRSF,1.2,"","SPECIFIER") 103 .S LRIENS1=LRI_","_LRDFN_"," 104 .I '+$P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),"^",4) S LRNOSP=1 Q 105 .S LRX=0 F S LRX=$O(^LR(LRDFN,LRSS,LRI,1.2,LRX)) Q:'LRX D 106 ..S LRIENS=LRX_","_LRIENS1 107 ..S LRSRFL=$$GET1^DIQ(LRFILE,LRIENS,.02,"I") 108 ..;LRSRMD-set to 1 if supp rpt modified and requires release 109 ..S LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I") 110 ..Q:LRSRFL&('LRSRMD) 111 ..S DIC("B")=$$GET1^DIQ(LRFILE,LRIENS,.01,"I") 112 I LRSS="AU" D 113 .S LRFILE=63.324,LRIENS1=LRDFN_"," 114 .I '+$P($G(^LR(LRDFN,84,0)),"^",4) S LRNOSP=1 Q 115 .S LRX=0 F S LRX=$O(^LR(LRDFN,84,LRX)) Q:'LRX D 116 ..S LRIENS=LRX_","_LRIENS1 117 ..S LRSRFL=$$GET1^DIQ(LRFILE,LRIENS,.02,"I") 118 ..;LRSRMD-set to 1 if supp rpt modified and requires release 119 ..S LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I") 120 ..Q:LRSRFL&('LRSRMD) 121 ..S DIC("B")=$$GET1^DIQ(LRFILE,LRIENS,.01,"I") 122 I LRNOSP D Q 123 .K LRMSG 124 .S LRMSG=$C(7)_"No supplementary reports exist for this accession." 125 .D EN^DDIOL(LRMSG,"","!!") 126 I 'DIC("B") D Q 127 .K LRMSG 128 .S LRMSG=$C(7)_"All supplementary reports have been released." 129 .D EN^DDIOL(LRMSG,"","!!") 130 DIE1 ; 131 S (LRQUIT,LRRLM)=0 132 F D Q:LRQUIT 133 .W ! 134 .S:LRSS="AU" (LRLKFL,DIC)="^LR(LRDFN,84," 135 .S:LRSS'="AU" (LRLKFL,DIC)="^LR(LRDFN,LRSS,LRI,1.2," 136 .S DIC("A")="Select SUPPLEMENTARY REPORT DATE: " 137 .S DIC(0)="AEQM" 138 .D ^DIC K DIC 139 .I Y<1 S LRQUIT=1 Q 140 .S LRDA=+Y 141 .S LRIENS=LRDA_","_LRIENS1 142 .S LRRLS=+$$GET1^DIQ(LRFILE,LRIENS,.02,"I") 143 .;If E-Sign OFF, must check LRRLM. LRRLM=1 if supp rpt has been 144 .; modified and requires release 145 .S LRRLM=+$$GET1^DIQ(LRFILE,LRIENS,.03,"I") 146 .I LRESSW,LRRLS D Q 147 ..W !!,"This supplementary report has already been released.",! 148 .I 'LRESSW,LRRLS D Q:'LRRLM 149 ..I 'LRRLM W !!,"This supplementary rept has already been released.",! 150 .W ! 151 .I LRESSW D Q 152 ..D ESIG Q:LRQUIT 153 ..D UPDATE 154 .S DIR("A")="Release supplementary report",DIR(0)="Y",DIR("B")="NO" 155 .D ^DIR K DIR 156 .Q:'Y 157 .D UPDATE 158 .;If E-sign switch OFF and orig report released, must verify all 159 .; supp reports released before release main report. 160 .I LRCKREL,'LRESSW D CHKSUP^LRAPR1 161 Q 162 ; 163 A D ^LRAP G:'$D(Y) END 164 Q 165 C ; 166 S LRDICS="SPCYEM" D ^LRAP 167 G:'$D(Y) END 168 Q 169 S ;from LRAPDA 170 S LRK=$P(^LR(LRDFN,LRSS,LRI,0),"^",11) Q:'LRK S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)) ^(0)="^68.04PA^^" 171 Q:$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0)) S ^(0)=LRT_"^50^^"_DUZ_"^"_LRK,X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,0),^(0)=$P(X,"^",1,2)_"^"_LRT_"^"_($P(X,"^",4)+1) 172 S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0)) ^(0)="^68.14P^^" 173 S C=0 F S C=$O(LRT(C)) Q:'C D CAP 174 S ^LRO(68,"AA",LRAA_"|"_LRAD_"|"_LRAN_"|"_LRT)="" 175 Q 176 ; 177 CAP S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,C,0)=C_"^1^0^0^^"_LRK_"^"_DUZ_"^"_DUZ(2)_"^"_LRAA_"^"_LRAA_"^"_LRAA 178 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0),^(0)=$P(X,"^",1,2)_"^"_C_"^"_($P(X,"^",4)+1) 179 Q 180 ; 181 SWITCH ;Check to see if electronic signature is enabled 182 D GETDATA^LRAPESON(.LRESSW) 183 Q 184 ESIG ;Prompt for electronic signature 185 S LRQUIT=0 186 D SIG^XUSESIG 187 I X1="" D 188 .W " SIGNATURE NOT VERIFIED" 189 .S LRQUIT=1 190 Q 191 UPDATE ; 192 S LRLKFL=LRLKFL_LRDA_",0)" 193 L +@(LRLKFL):5 I '$T D Q 194 .S LRMSG="This record is locked by another user. " 195 .S LRMSG=LRMSG_"Please wait and try again." 196 .D EN^DDIOL(LRMSG,"","!!") 197 S LRFDA(LRFILE,LRIENS,.02)=1 198 S LRFDA2(LRFILE,LRIENS,.02)="@" ;Set but don't file unless unrel needed 199 ;File signer ID and Date/time of released supp report 200 D CKSIGNR^LRAPR1 201 D FILE^DIE("","LRFDA") 202 W "...Released" 203 L -@(LRLKFL) 204 ;If all supp reports released, and E-Sign switch is ON, proceed to 205 ; release main report 206 S LRCKREL=0 207 S:LRSS'="AU" LRCKREL=$P(^LR(LRDFN,LRSS,LRI,0),"^",11) 208 S:LRSS="AU" LRCKREL=$P(^LR(LRDFN,LRSS),"^",15) 209 I LRCKREL,LRESSW D RELMN 210 Q 211 SUPCHK ;Check for unreleased supplementary reports 212 N LRSR,LRSR1,LRSR2 213 S LRSR=0,LRSR1=1 214 I LRSS'="AU" D 215 .Q:'+$P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4) 216 .F S LRSR=$O(^LR(LRDFN,LRSS,LRI,1.2,LRSR)) Q:LRSR'>0!('LRSR1) D 217 ..S LRSR1=+$P(^LR(LRDFN,LRSS,LRI,1.2,LRSR,0),U,2) 218 ..I 'LRSR1 D 219 ...S Y=+$P(^LR(LRDFN,LRSS,LRI,1.2,LRSR,0),U) 220 ...D DD^%DT S LRSR2=Y 221 I LRSS="AU" D 222 .Q:'+$P($G(^LR(LRDFN,84,0)),U,4) 223 .F S LRSR=$O(^LR(LRDFN,84,LRSR)) Q:LRSR'>0!('LRSR1) D 224 ..S LRSR1=+$P(^LR(LRDFN,84,LRSR,0),U,2) 225 ..I 'LRSR1 D 226 ...S Y=+$P(^LR(LRDFN,84,LRSR,0),U) 227 ...D DD^%DT S LRSR2=Y 228 I 'LRSR1 D 229 .W $C(7),!,"Supplementary report "_LRSR2_" has not been released. " 230 .W "Cannot release." 231 .S Y=0 232 Q 233 RINFO ;Display release information 234 W $C(7),!,"Report " 235 W:LRZ(2)=1 "has already been " 236 W "released " 237 S Y=LRZ(2) 238 D DD^%DT 239 W:LRZ(2)>1 Y 240 W:LRZ(1)'="" " by "_$P($G(^VA(200,LRZ(1),0)),U) 241 K Y 242 Q 243 NMPATH ;Check for missing pathologist name 244 I 'LRZ(3) D 245 .W $C(7),!,"Pathologist name missing. Cannot release." 246 .S Y=0 247 Q 248 RELEASE ;Prompt for release/unrelease 249 W ! S DIR(0)="YA",DIR("B")="NO" 250 S:LRZ(2) DIR("A")="Unrelease report? " 251 S:'LRZ(2) DIR("A")="Release report? " 252 D ^DIR 253 K:Y Y 254 I $D(Y) S Y=0 255 Q 256 RELMN ;Allow release of main report as long as all supp reports are 257 ; released, and signer is same person for main and supp report(s) 258 ;Make sure all supp reports signed out 259 S LRQT=0 260 D RELCHK^LRAPR1 261 Q:LRQT 262 ; 263 ;Continue with electronic signature and storage in TIU 264 S LRAU=$S(LRSS="AU":1,1:0) 265 I 'LRAU D 266 .S LRPAT=+$$GET1^DIQ(LRSF,LRIENS1,.02,"I") 267 .S LRZ=$$GET1^DIQ(LRSF,LRIENS1,.03,"I") 268 .S LRZ(1)=$$GET1^DIQ(LRSF,LRIENS1,.13,"I") 269 .S LRZ(1.1)=$$GET1^DIQ(LRSF,LRIENS1,.13) 270 .S LRZ(2)=$$GET1^DIQ(LRSF,LRIENS1,.11,"I") 271 I LRAU D 272 .S LRPAT=+$$GET1^DIQ(63,LRDFN_",",13.6,"I") 273 .S LRZ=$$GET1^DIQ(63,LRDFN_",",13,"I") 274 .S LRZ(1)=$$GET1^DIQ(63,LRDFN_",",14.8,"I") 275 .S LRZ(1.1)=$$GET1^DIQ(63,LRDFN_",",14.8) 276 .S LRZ(2)=$$GET1^DIQ(63,LRDFN_",",14.7,"I") 277 .S LRI="" 278 W !!,?25,"*** Main Report Release ***",! 279 D NOW^%DTC S LRNTIME=% 280 D TIUPREP^LRAPRES 281 D STORE^LRAPRES 282 I LRQUIT D FILE^DIE("","LRFDA2") Q 283 D UNRLSE^LRAPR1 284 D RELEASE^LRAPRES 285 I LRQUIT D FILE^DIE("","LRFDA2") Q 286 D MAIN^LRAPRES1(LRDFN,LRSS,LRI,LRSF,LRP,LRAC) 287 D OERR^LR7OB63D 288 S LRQUIT=1 289 Q 290 END ; 291 D V^LRU 292 Q
Note:
See TracChangeset
for help on using the changeset viewer.
