source: WorldVistAEHR/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMAHO3A.m@ 1005

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1QAMAHO3A ;HISC/GJC,DAD-PRINTS OUT REPORTS FOR FALL-OUT FILE. ;11/15/94 13:47
2 ;;1.0;Clinical Monitoring System;**3**;09/13/1993
3 S QAMTAB=0,SUB="" D ORD1,PRINT
4 Q
5ORD1 ;
6 G:$D(QAM2) ORD2
7 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
8 . S QA=$S(LABEL1["PAT":1,LABEL1["MON":2,LABEL1["DATE":3,LABEL1["DLMNT":4,1:0),QA=QA_";"_^UTILITY($J,LABEL1,SUB,MN1)
9 . S QAMTAB=QAMTAB+1,^UTILITY($J,"QAM IEN",QAMTAB,MN1)=QA
10 . Q
11 Q
12ORD2 ;
13 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
14 . S QA=$S(LABEL1["PAT":1,LABEL1["MON":2,LABEL1["DATE":3,LABEL1["DLMNT":4,1:0),QA=QA_";"_^UTILITY($J,LABEL1,SUB,MN1)
15 . 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)
16 . S QAMTAB=QAMTAB+1,^UTILITY($J,"QAM IEN",QAMTAB,MN1)=QA
17 . Q
18 Q
19PRINT ;
20 K ^UTILITY($J,"QAM SUB") D HDR I $O(^UTILITY($J,"QAM IEN",0))'>0 W !!,"NO DATA FOUND FOR THIS REPORT" Q
21 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
22 Q
23PRINT0 ;
24 S X=^UTILITY($J,"QAM IEN",JD,JD1),X1=$P(X,"^"),X2=$P(X,"^",2)
25 D SUBHD2:(X1]"")&(X2]""),SUBHD1:(X1]"")&(X2="")
26 W ! S QAMNDE=$S($D(^QA(743.1,JD1,0))#2:^(0),1:"") Q:QAMNDE=""
27 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
28 Q
29PRINT1 ;
30 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
31 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
32 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
33 I CD1=4,$D(^QA(743.1,JD1,1,0)) D PRINT2
34 K IEN Q
35PRINT2 ;
36 K ^UTILITY($J,"QAM TEMP")
37 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)
38 S GC="" W !
39 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
40 K ^UTILITY($J,"QAM TEMP")
41 Q
42SUBHD1 ;
43 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))=""
44 Q
45SUBHD2 ;
46 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))=""
47 Q
48HDH0 ;
49 I $O(^UTILITY($J,"QAM TEMP",GC))]""!$O(^UTILITY($J,"QAM TEMP",GC,GC(1))) G H
50 Q
51HDH ;
52 S QAMJD=$O(^UTILITY($J,"QAM IEN",JD)),QAMCD=$O(PARRY(CD)) I QAMJD'>0,QAMCD'>0 Q
53H I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S QAMFIN=$S(Y'>0:"^",1:"") Q:QAMFIN["^"
54 D HDR
55 Q
56HDR ;
57 S PAGE=PAGE+1 W:(PAGE>1)!($E(IOST)="C") @IOF
58 W !!?(80-$L(HEAD)/2),HEAD,?68,TODAY,!?(80-$L(HEAD(0))/2),HEAD(0),?68,"PAGE: ",PAGE D EN6^QAQAUTL W !,BNDRY
59 Q
Note: See TracBrowser for help on using the repository browser.