60 lines
3.2 KiB
Mathematica
60 lines
3.2 KiB
Mathematica
QAMAHO3A ;HISC/GJC,DAD-PRINTS OUT REPORTS FOR FALL-OUT FILE. ;11/15/94 13:47
|
|
;;1.0;Clinical Monitoring System;**3**;09/13/1993
|
|
S QAMTAB=0,SUB="" D ORD1,PRINT
|
|
Q
|
|
ORD1 ;
|
|
G:$D(QAM2) ORD2
|
|
F MN=0:0 S SUB=$O(^UTILITY($J,LABEL1,SUB)) Q:SUB="" F MN1=0:0 S MN1=$O(^UTILITY($J,LABEL1,SUB,MN1)) Q:MN1'>0 D
|
|
. S QA=$S(LABEL1["PAT":1,LABEL1["MON":2,LABEL1["DATE":3,LABEL1["DLMNT":4,1:0),QA=QA_";"_^UTILITY($J,LABEL1,SUB,MN1)
|
|
. S QAMTAB=QAMTAB+1,^UTILITY($J,"QAM IEN",QAMTAB,MN1)=QA
|
|
. Q
|
|
Q
|
|
ORD2 ;
|
|
F LP=0:0 S SUB=$O(^UTILITY($J,LABEL1,SUB)) Q:SUB="" S SUB2="" F MN=0:0 S SUB2=$O(^UTILITY($J,LABEL2,SUB2)) Q:SUB2="" F MN1=0:0 S MN1=$O(^UTILITY($J,LABEL2,SUB2,MN1)) Q:MN1'>0 D:$D(^UTILITY($J,LABEL1,SUB,MN1))#2
|
|
. S QA=$S(LABEL1["PAT":1,LABEL1["MON":2,LABEL1["DATE":3,LABEL1["DLMNT":4,1:0),QA=QA_";"_^UTILITY($J,LABEL1,SUB,MN1)
|
|
. S QA(0)=$S(LABEL2["PAT":1,LABEL2["MON":2,LABEL2["DATE":3,LABEL2["DLMNT":4,1:0),QA=QA_"^"_QA(0)_";"_^UTILITY($J,LABEL2,SUB2,MN1)
|
|
. S QAMTAB=QAMTAB+1,^UTILITY($J,"QAM IEN",QAMTAB,MN1)=QA
|
|
. Q
|
|
Q
|
|
PRINT ;
|
|
K ^UTILITY($J,"QAM SUB") D HDR I $O(^UTILITY($J,"QAM IEN",0))'>0 W !!,"NO DATA FOUND FOR THIS REPORT" Q
|
|
F JD=0:0 S JD=$O(^UTILITY($J,"QAM IEN",JD)) Q:JD'>0!(QAMFIN["^") F JD1=0:0 S JD1=$O(^UTILITY($J,"QAM IEN",JD,JD1)) Q:JD1'>0!(QAMFIN["^") D PRINT0
|
|
Q
|
|
PRINT0 ;
|
|
S X=^UTILITY($J,"QAM IEN",JD,JD1),X1=$P(X,"^"),X2=$P(X,"^",2)
|
|
D SUBHD2:(X1]"")&(X2]""),SUBHD1:(X1]"")&(X2="")
|
|
W ! S QAMNDE=$S($D(^QA(743.1,JD1,0))#2:^(0),1:"") Q:QAMNDE=""
|
|
F CD=0:0 S CD=$O(PARRY(CD)) Q:CD'>0!(QAMFIN["^") S CD1=PARRY(CD) D PRINT1 Q:QAMFIN["^" D:$Y>(IOSL-6) HDH
|
|
Q
|
|
PRINT1 ;
|
|
I CD1=1 S IEN=$P(QAMNDE,U),Y=$S($D(^DPT(IEN,0))#2:$P(^(0),U),1:IEN) W !,"Patient Name: ",Y Q
|
|
I CD1=2 S IEN=$P(QAMNDE,U,2),Y=$G(^QA(743,IEN,0)) W !,"Monitor: ",$P(Y,U,2),?46,$P(Y,U),$S(+$P(Y,U,4):" (a)",1:" (m)") Q
|
|
I CD1=3 S Y=$P(QAMNDE,U,3) X ^DD("DD") W !,"Event Date: ",Y S Y=$P(QAMNDE,U,4) X ^DD("DD") W ?40,"Creation Date: ",Y Q
|
|
I CD1=4,$D(^QA(743.1,JD1,1,0)) D PRINT2
|
|
K IEN Q
|
|
PRINT2 ;
|
|
K ^UTILITY($J,"QAM TEMP")
|
|
F GC=0:0 S GC=$O(^QA(743.1,JD1,1,GC)) Q:GC'>0 S Y=+^QA(743.1,JD1,1,GC,0),Y(0)=$S($D(^("E"))#2:$P(^("E"),U),1:""),X=$S($D(^QA(743.4,Y,0))#2:$P(^(0),U),1:Y) S:$D(^UTILITY($J,"QAM ELEMENT",X,Y))#2 ^UTILITY($J,"QAM TEMP",X,GC)=Y(0)
|
|
S GC="" W !
|
|
F GC(0)=0:0 S GC=$O(^UTILITY($J,"QAM TEMP",GC)) Q:GC=""!(QAMFIN["^") F GC(1)=0:0 S GC(1)=$O(^UTILITY($J,"QAM TEMP",GC,GC(1))) Q:GC(1)'>0!(QAMFIN["^") S X=^UTILITY($J,"QAM TEMP",GC,GC(1)) W !?2,GC,?40,$E(X,1,40) D:$Y>(IOSL-6) HDH0
|
|
K ^UTILITY($J,"QAM TEMP")
|
|
Q
|
|
SUBHD1 ;
|
|
I +X1,$D(PARRAY(+X1))[0,$D(^UTILITY($J,"QAM SUB",$P(X1,";",2)))[0 W !!?5,"---",SARRAY(1),": ",$P(X1,";",2) S ^UTILITY($J,"QAM SUB",$P(X1,";",2))=""
|
|
Q
|
|
SUBHD2 ;
|
|
D SUBHD1 I +X2,$D(PARRAY(+X2))[0,$D(^UTILITY($J,"QAM SUB",$P(X1,";",2),$P(X2,";",2)))[0 W !!?10,"---",SARRAY(2),": ",$P(X2,";",2) S ^UTILITY($J,"QAM SUB",$P(X1,";",2),$P(X2,";",2))=""
|
|
Q
|
|
HDH0 ;
|
|
I $O(^UTILITY($J,"QAM TEMP",GC))]""!$O(^UTILITY($J,"QAM TEMP",GC,GC(1))) G H
|
|
Q
|
|
HDH ;
|
|
S QAMJD=$O(^UTILITY($J,"QAM IEN",JD)),QAMCD=$O(PARRY(CD)) I QAMJD'>0,QAMCD'>0 Q
|
|
H I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S QAMFIN=$S(Y'>0:"^",1:"") Q:QAMFIN["^"
|
|
D HDR
|
|
Q
|
|
HDR ;
|
|
S PAGE=PAGE+1 W:(PAGE>1)!($E(IOST)="C") @IOF
|
|
W !!?(80-$L(HEAD)/2),HEAD,?68,TODAY,!?(80-$L(HEAD(0))/2),HEAD(0),?68,"PAGE: ",PAGE D EN6^QAQAUTL W !,BNDRY
|
|
Q
|