source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRACDIAG.m@ 1261

Last change on this file since 1261 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1LRACDIAG ;SLC/DCM - DIAGNOSTIC REPORT FOR LAB REPORTS FILE (64.5) ;2/19/91 10:09 ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 ;
4 S:'$D(U) U="^" S LRCKW=1
5QUE S %ZIS="MQ" D ^%ZIS Q:POP I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^LRACDIAG",ZTDESC="Cumulative diagnostics",ZTSAVE("U")="",ZTSAVE("DT")="",ZTSAVE("LRCKW")="" D ^%ZTLOAD K ZTSK G END
6 D ENT W !! W:$E(IOST,1,2)="P-" @IOF D ^%ZISC
7 Q
8ENT ;from LRCKF
9 U IO K ^TMP($J),LR S A=0 W !!,?10,"Diagnostic Report for LAB REPORTS FILE (64.5)" I $O(^LAB(64.5,1,2,0))<1,LRCKW W !!,"SUPERVISOR'S SUMMARY REPORT field not defined",?68,">>WARNING<<"
10 I $D(^LAB(64.5,"AC",0)) W !!,"The ""AC"" x-ref indicates that the Lab Reports file may contain tests",!?3,"that do not have data names (cosmic). Remove test and re-cross-",!?3,"reference the ""AC"" index.",?70,">>FATAL<<"
11 I $O(^LAB(64.5,1,3,0))<1 W !!,"REPORT NAME field not defined",?70,">>FATAL<<"
12 F I=0:0 S A=$O(^LAB(64.5,1,3,A)) Q:A<1 I $D(^(A,0))#2 S LRST(A)=$P(^(0),U,2),LREN(A)=$P(^(0),U,3) I LREN(A)'=LRST(A) D
13 . W:LREN(A)']LRST(A) !!,"ENDING LOCATION does not follow STARTING LOCATION",?70,">>FATAL<<" D DEV
14MAJ S DA(3)=1,DA(2)=0 F S DA(2)=$O(^LAB(64.5,1,1,DA(2))) Q:DA(2)<1 S LRMAJ=$P(^(DA(2),0),U,1),LROFMT="" W !!,LRMAJ D MIN
15END K ^TMP($J),LRMAJ,LRMIN,LRTS,LRTST,LRSB,LRSITE,LR,LRCKW,LREN,LRFMT,LROFMT,LRST,I,J,K,DA
16 W !! W:$E(IOST,1,2)="P-" @IOF
17 Q
18DEV W:'$D(^LAB(64.5,1,3,A,.1))#2 !,"No device defined for report name: ",$P(^LAB(64.5,1,3,A,0),U),?70,">>FATAL<<"
19 Q
20MIN S J=0 F S J=$O(^LAB(64.5,1,1,DA(2),1,J)) Q:J<1 I $D(^(J,0))#2 S DA(1)=J,X=^(0),LRMIN=$P(X,U,1),LRSITE=$P(X,U,2),LRFMT=$P(X,U,3) S:'$L(LROFMT) LROFMT=LRFMT W !?3,LRMIN D TST
21 Q
22TST I LROFMT="V",LRFMT="H" W:'$D(LR) !?5,"Horizontal formats cannot be added after a vertical format.",?70,">>FATAL<<"
23 S K=0 F S K=$O(^LAB(64.5,1,1,DA(2),1,J,1,K)) Q:K<1 I $D(^(K,0))#2 S DA=K,X=^(0),LRTST=$P(X,U,3),LRTS=$P(X,U,1),LRSB=+$P($P(X,U,5),";",2),X=$P(X,U,1) D CHK,XREF
24 Q
25CHK I 'LRSB W:'$D(LR) !?5,LRTST," of the ",LRMIN," minor header of the ",LRMAJ,!?5," major header is not an atomic test (no data name).",?70,">>FATAL<<"
26 I $D(^TMP($J,LRSITE,LRTS)) W:'$D(LR) !?5,LRTST," with ",$S($D(^LAB(61,LRSITE,0)):$P(^(0),U,1),1:"")," specimen already exists on another minor header.",?70,">>FATAL<<"
27 E S:'$D(LR) ^TMP($J,LRSITE,LRTS)=""
28 Q
29XREF G:$D(LR) XREF1 I '$D(^LAB(64.5,"AR",$P(^LAB(64.5,DA(3),1,DA(2),1,DA(1),0),"^",2),$P(^(1,DA,0),"^",1))) W !?5,"""AR"" x-ref does not exist for ",LRTST,?70,">>FATAL<<"
30 I '$D(^LAB(64.5,"A",DA(3),DA(2),DA(1),DA)) W !?5,"""A"" x-ref does not exist for ",LRTST,?70,">>FATAL<<" Q
31 I $D(^LAB(60,LRTS,1,LRSITE,0)),^LAB(64.5,"A",DA(3),DA(2),DA(1),DA)'=^LAB(60,LRTS,1,LRSITE,0) W !?5,"""A"" x-ref for ",LRTST," is 'out-of-date' with file 60.",?70,">>FATAL<<"
32 I '$D(^LAB(64.5,"AC",+$P($P(^LAB(64.5,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",5),";",2),DA(3),DA(2),DA(1),DA)) W !?5,"""AC"" x-ref does not exist for ",LRTST,?70,">>FATAL<<"
33 Q
34XREF1 I $D(LR(1)) X ^DD(64.53,.01,1,6,1) W "."
35 I $D(LR(2)) X ^DD(64.53,4,1,1,1) W "."
36 I $D(LR(3)) X ^DD(64.53,.01,1,5,1) W "."
37 Q
38EN S:'$D(U) U="^" S:'$D(DTIME) DTIME=300
39 W:$D(LR(1)) !,"Mumps ""A"" index of the LAB TEST subfield",!?4,"(contains reference ranges, units, etc. from file 60)"
40 W:$D(LR(2)) !,"Mumps ""AC"" index of the LAB TEST LOCATION subfield",!?4,"(atomic test x-ref.)" W:$D(LR(3)) !,"Mumps ""AR"" index of the LAB TEST subfield",!?4,"(site/specimen x-ref.)"
41 W !!,"ARE YOU SURE" S %=2 D YN^DICN G END:%<1!(%=2)
42 K:$D(LR(1)) ^LAB(64.5,"A") K:$D(LR(2)) ^LAB(64.5,"AC") K:$D(LR(3)) ^LAB(64.5,"AR")
43 D MAJ
44 G END
45DQ U IO S:$D(ZTQUEUED) ZTREQ="@" D ENT D ^%ZISC Q
Note: See TracBrowser for help on using the repository browser.