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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMAHO3A 3379 printed Dec 13, 2024@01:41:37 Page 2
QAMAHO3A ;HISC/GJC,DAD-PRINTS OUT REPORTS FOR FALL-OUT FILE. ;11/15/94 13:47
+1 ;;1.0;Clinical Monitoring System;**3**;09/13/1993
+2 SET QAMTAB=0
SET SUB=""
DO ORD1
DO PRINT
+3 QUIT
ORD1 ;
+1 if $DATA(QAM2)
GOTO ORD2
+2 FOR MN=0:0
SET SUB=$ORDER(^UTILITY($JOB,LABEL1,SUB))
if SUB=""
QUIT
FOR MN1=0:0
SET MN1=$ORDER(^UTILITY($JOB,LABEL1,SUB,MN1))
if MN1'>0
QUIT
Begin DoDot:1
+3 SET QA=$SELECT(LABEL1["PAT":1,LABEL1["MON":2,LABEL1["DATE":3,LABEL1["DLMNT":4,1:0)
SET QA=QA_";"_^UTILITY($JOB,LABEL1,SUB,MN1)
+4 SET QAMTAB=QAMTAB+1
SET ^UTILITY($JOB,"QAM IEN",QAMTAB,MN1)=QA
+5 QUIT
End DoDot:1
+6 QUIT
ORD2 ;
+1 FOR LP=0:0
SET SUB=$ORDER(^UTILITY($JOB,LABEL1,SUB))
if SUB=""
QUIT
SET SUB2=""
FOR MN=0:0
SET SUB2=$ORDER(^UTILITY($JOB,LABEL2,SUB2))
if SUB2=""
QUIT
FOR MN1=0:0
SET MN1=$ORDER(^UTILITY($JOB,LABEL2,SUB2,MN1))
if MN1'>0
QUIT
if $DATA(^UTILITY($JOB,LABEL1,SUB,MN1))#2
Begin DoDot:1
+2 SET QA=$SELECT(LABEL1["PAT":1,LABEL1["MON":2,LABEL1["DATE":3,LABEL1["DLMNT":4,1:0)
SET QA=QA_";"_^UTILITY($JOB,LABEL1,SUB,MN1)
+3 SET QA(0)=$SELECT(LABEL2["PAT":1,LABEL2["MON":2,LABEL2["DATE":3,LABEL2["DLMNT":4,1:0)
SET QA=QA_"^"_QA(0)_";"_^UTILITY($JOB,LABEL2,SUB2,MN1)
+4 SET QAMTAB=QAMTAB+1
SET ^UTILITY($JOB,"QAM IEN",QAMTAB,MN1)=QA
+5 QUIT
End DoDot:1
+6 QUIT
PRINT ;
+1 KILL ^UTILITY($JOB,"QAM SUB")
DO HDR
IF $ORDER(^UTILITY($JOB,"QAM IEN",0))'>0
WRITE !!,"NO DATA FOUND FOR THIS REPORT"
QUIT
+2 FOR JD=0:0
SET JD=$ORDER(^UTILITY($JOB,"QAM IEN",JD))
if JD'>0!(QAMFIN["^")
QUIT
FOR JD1=0:0
SET JD1=$ORDER(^UTILITY($JOB,"QAM IEN",JD,JD1))
if JD1'>0!(QAMFIN["^")
QUIT
DO PRINT0
+3 QUIT
PRINT0 ;
+1 SET X=^UTILITY($JOB,"QAM IEN",JD,JD1)
SET X1=$PIECE(X,"^")
SET X2=$PIECE(X,"^",2)
+2 if (X1]"")&(X2]"")
DO SUBHD2
if (X1]"")&(X2="")
DO SUBHD1
+3 WRITE !
SET QAMNDE=$SELECT($DATA(^QA(743.1,JD1,0))#2:^(0),1:"")
if QAMNDE=""
QUIT
+4 FOR CD=0:0
SET CD=$ORDER(PARRY(CD))
if CD'>0!(QAMFIN["^")
QUIT
SET CD1=PARRY(CD)
DO PRINT1
if QAMFIN["^"
QUIT
if $Y>(IOSL-6)
DO HDH
+5 QUIT
PRINT1 ;
+1 IF CD1=1
SET IEN=$PIECE(QAMNDE,U)
SET Y=$SELECT($DATA(^DPT(IEN,0))#2:$PIECE(^(0),U),1:IEN)
WRITE !,"Patient Name: ",Y
QUIT
+2 IF CD1=2
SET IEN=$PIECE(QAMNDE,U,2)
SET Y=$GET(^QA(743,IEN,0))
WRITE !,"Monitor: ",$PIECE(Y,U,2),?46,$PIECE(Y,U),$SELECT(+$PIECE(Y,U,4):" (a)",1:" (m)")
QUIT
+3 IF CD1=3
SET Y=$PIECE(QAMNDE,U,3)
XECUTE ^DD("DD")
WRITE !,"Event Date: ",Y
SET Y=$PIECE(QAMNDE,U,4)
XECUTE ^DD("DD")
WRITE ?40,"Creation Date: ",Y
QUIT
+4 IF CD1=4
IF $DATA(^QA(743.1,JD1,1,0))
DO PRINT2
+5 KILL IEN
QUIT
PRINT2 ;
+1 KILL ^UTILITY($JOB,"QAM TEMP")
+2 FOR GC=0:0
SET GC=$ORDER(^QA(743.1,JD1,1,GC))
if GC'>0
QUIT
SET Y=+^QA(743.1,JD1,1,GC,0)
SET Y(0)=$SELECT($DATA(^("E"))#2:$PIECE(^("E"),U),1:"")
SET X=$SELECT($DATA(^QA(743.4,Y,0))#2:$PIECE(^(0),U),1:Y)
if $DATA(^UTILITY($JOB,"QAM ELEMENT",X,Y))#2
SET ^UTILITY($JOB,"QAM TEMP",X,GC)=Y(0)
+3 SET GC=""
WRITE !
+4 FOR GC(0)=0:0
SET GC=$ORDER(^UTILITY($JOB,"QAM TEMP",GC))
if GC=""!(QAMFIN["^")
QUIT
FOR GC(1)=0:0
SET GC(1)=$ORDER(^UTILITY($JOB,"QAM TEMP",GC,GC(1)))
if GC(1)'>0!(QAMFIN["^")
QUIT
SET X=^UTILITY($JOB,"QAM TEMP",GC,GC(1))
WRITE !?2,GC,?40,$EXTRACT(X,1,40)
if $Y>(IOSL-6)
DO HDH0
+5 KILL ^UTILITY($JOB,"QAM TEMP")
+6 QUIT
SUBHD1 ;
+1 IF +X1
IF $DATA(PARRAY(+X1))[0
IF $DATA(^UTILITY($JOB,"QAM SUB",$PIECE(X1,";",2)))[0
WRITE !!?5,"---",SARRAY(1),": ",$PIECE(X1,";",2)
SET ^UTILITY($JOB,"QAM SUB",$PIECE(X1,";",2))=""
+2 QUIT
SUBHD2 ;
+1 DO SUBHD1
IF +X2
IF $DATA(PARRAY(+X2))[0
IF $DATA(^UTILITY($JOB,"QAM SUB",$PIECE(X1,";",2),$PIECE(X2,";",2)))[0
WRITE !!?10,"---",SARRAY(2),": ",$PIECE(X2,";",2)
SET ^UTILITY($JOB,"QAM SUB",$PIECE(X1,";",2),$PIECE(X2,";",2))=""
+2 QUIT
HDH0 ;
+1 IF $ORDER(^UTILITY($JOB,"QAM TEMP",GC))]""!$ORDER(^UTILITY($JOB,"QAM TEMP",GC,GC(1)))
GOTO H
+2 QUIT
HDH ;
+1 SET QAMJD=$ORDER(^UTILITY($JOB,"QAM IEN",JD))
SET QAMCD=$ORDER(PARRY(CD))
IF QAMJD'>0
IF QAMCD'>0
QUIT
H IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET QAMFIN=$SELECT(Y'>0:"^",1:"")
if QAMFIN["^"
QUIT
+1 DO HDR
+2 QUIT
HDR ;
+1 SET PAGE=PAGE+1
if (PAGE>1)!($EXTRACT(IOST)="C")
WRITE @IOF
+2 WRITE !!?(80-$LENGTH(HEAD)/2),HEAD,?68,TODAY,!?(80-$LENGTH(HEAD(0))/2),HEAD(0),?68,"PAGE: ",PAGE
DO EN6^QAQAUTL
WRITE !,BNDRY
+3 QUIT
