source: FOIAVistA/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMAHO3A.m@ 1154

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