QAMPMON1 ;HISC/DAD-MONITOR DESCRIPTION REPORT ;9/14/92 11:29
;;1.0;Clinical Monitoring System;;09/13/1993
S (QAMPAGE,QAMHEAD,QAMPAUSE)=1,QAMZERO=$S($D(^QA(743,QAMD0,0))#2:^(0),1:""),QAMONE=$S($D(^(1))#2:^(1),1:"") Q:QAMZERO="" S QAMFOUND=1 D HEAD
W !!,"CODE: ",$P(QAMZERO,"^")," ",$S($P(QAMZERO,"^",4):"(a)",1:"(m)"),?43,"TITLE: ",$P(QAMZERO,"^",2) S X=$P(QAMZERO,"^",3),X=$S($D(^DIC(49,+X,0))#2:$P(^(0),"^"),1:X) W !,"SERVICE: ",X
W !,"STATUS: ",$S($P(QAMZERO,"^",5):"Finished",1:"Under Construction"),?28,"SWITCH: ",$S($P(QAMONE,"^",5):"On",1:"Off") S Y=$P(QAMONE,"^",6) X ^DD("DD") W ?43,"START: ",Y S Y=$P(QAMONE,"^",7) X ^DD("DD") W ?62,"END: ",Y
S X=$P(QAMONE,"^"),X=$S($D(^QA(743.92,+X,0))#2:$P(^(0),"^"),1:X)
W !,"TIME FRAME: ",X,?43,"THRESHOLD: ",$P(QAMONE,"^",3),?60,$S($P(QAMONE,"^",3)["%":"MIN SAMPLE: ",1:"ALERT LEVEL: "),$P(QAMONE,"^",2)
W !?43,"HI/LO %: ",$S($P(QAMONE,"^",3)'["%":"n/a",$P(QAMONE,"^",4)="H":"High",$P(QAMONE,"^",4)="L":"Low",1:""),?60,"DUPLICATES: ",$S($P(QAMONE,"^",14):"Yes",1:"No")
W !!," STANDARD OF CARE",!,"------------------" K ^UTILITY($J,"W") S DIWL=2,DIWR=78,DIWF="W"
F QAMD1=0:0 S QAMD1=$O(^QA(743,QAMD0,"STDC",QAMD1)) Q:QAMD1'>0!QAMQUIT S X=^QA(743,QAMD0,"STDC",QAMD1,0) D ^DIWP,PAGE
G:QAMQUIT EXIT D ^DIWW,PAGE G:QAMQUIT EXIT
W !!," CLINICAL INDICATOR",!,"--------------------" K ^UTILITY($J,"W") S DIWL=2,DIWR=78,DIWF="W" D PAGE
F QAMD1=0:0 S QAMD1=$O(^QA(743,QAMD0,"CLIN",QAMD1)) Q:QAMD1'>0!QAMQUIT S X=^QA(743,QAMD0,"CLIN",QAMD1,0) D ^DIWP,PAGE
G:QAMQUIT EXIT D ^DIWW,PAGE G:QAMQUIT EXIT
W !!," RATIONALE",?35,"EXPLANATION",!,"-----------",?34,"-------------" S QAMHEAD=$O(^QA(743,QAMD0,"RAT",0)) D PAGE
F QAMD1=0:0 S QAMD1=$O(^QA(743,QAMD0,"RAT",QAMD1)) Q:QAMD1'>0!QAMQUIT D RAT1
EXIT D:$E(IOST)="C" PAUSE
Q
RAT1 ;
S X=$S($D(^QA(743,QAMD0,"RAT",QAMD1,0))#2:$P(^(0),"^"),1:""),QAMRAT=$S($D(^QA(743.91,+X,0))#2:$P(^(0),"^"),1:X)
K ^UTILITY($J,"W") S DIWL=35,DIWR=78,DIWF="" F QAMD2=0:0 S QAMD2=$O(^QA(743,QAMD0,"RAT",QAMD1,"EXP",QAMD2)) Q:QAMD2'>0 S X=^QA(743,QAMD0,"RAT",QAMD1,"EXP",QAMD2,0) D ^DIWP
W !?1,QAMRAT S QAMD2=$O(^UTILITY($J,"W",DIWL,0)) W:QAMD2 ?DIWL,^UTILITY($J,"W",DIWL,QAMD2,0) S QAMHEAD=$O(^UTILITY($J,"W",DIWL,QAMD2)) D PAGE
I QAMD2 F QAMD2=QAMD2:0 S QAMD2=$O(^UTILITY($J,"W",DIWL,QAMD2)) Q:QAMD2'>0!QAMQUIT W !?DIWL,^UTILITY($J,"W",DIWL,QAMD2,0) S QAMHEAD=$O(^UTILITY($J,"W",DIWL,QAMD2)) D PAGE
Q
HEAD ;REPORT HEADER
W:(QAMPAGE>1)!($E(IOST)="C") @IOF
W !!?27,"MONITOR DESCRIPTION REPORT",?68,QAMTODAY,!?68,"PAGE: ",QAMPAGE S QAMPAGE=QAMPAGE+1 W !,"================================================================================"
Q
PAUSE ;PAUSE AT END OF PAGE
I QAMPAUSE K DIR S DIR(0)="E" D ^DIR K DIR S QAMQUIT=$S(Y:0,1:1),QAMPAUSE=0
Q
PAGE ;CHECK FOR END OF PAGE
S QAMPAUSE=1 Q:$Y'>(IOSL-6) D:$E(IOST)="C" PAUSE Q:QAMQUIT D:QAMHEAD HEAD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMPMON1 2883 printed Nov 22, 2024@16:52:52 Page 2
QAMPMON1 ;HISC/DAD-MONITOR DESCRIPTION REPORT ;9/14/92 11:29
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
+2 SET (QAMPAGE,QAMHEAD,QAMPAUSE)=1
SET QAMZERO=$SELECT($DATA(^QA(743,QAMD0,0))#2:^(0),1:"")
SET QAMONE=$SELECT($DATA(^(1))#2:^(1),1:"")
if QAMZERO=""
QUIT
SET QAMFOUND=1
DO HEAD
+3 WRITE !!,"CODE: ",$PIECE(QAMZERO,"^")," ",$SELECT($PIECE(QAMZERO,"^",4):"(a)",1:"(m)"),?43,"TITLE: ",$PIECE(QAMZERO,"^",2)
SET X=$PIECE(QAMZERO,"^",3)
SET X=$SELECT($DATA(^DIC(49,+X,0))#2:$PIECE(^(0),"^"),1:X)
WRITE !,"SERVICE: ",X
+4 WRITE !,"STATUS: ",$SELECT($PIECE(QAMZERO,"^",5):"Finished",1:"Under Construction"),?28,"SWITCH: ",$SELECT($PIECE(QAMONE,"^",5):"On",1:"Off")
SET Y=$PIECE(QAMONE,"^",6)
XECUTE ^DD("DD")
WRITE ?43,"START: ",Y
SET Y=$PIECE(QAMONE,"^",7)
XECUTE ^DD("DD")
WRITE ?62,"END: ",Y
+5 SET X=$PIECE(QAMONE,"^")
SET X=$SELECT($DATA(^QA(743.92,+X,0))#2:$PIECE(^(0),"^"),1:X)
+6 WRITE !,"TIME FRAME: ",X,?43,"THRESHOLD: ",$PIECE(QAMONE,"^",3),?60,$SELECT($PIECE(QAMONE,"^",3)["%":"MIN SAMPLE: ",1:"ALERT LEVEL: "),$PIECE(QAMONE,"^",2)
+7 WRITE !?43,"HI/LO %: ",$SELECT($PIECE(QAMONE,"^",3)'["%":"n/a",$PIECE(QAMONE,"^",4)="H":"High",$PIECE(QAMONE,"^",4)="L":"Low",1:""),?60,"DUPLICATES: ",$SELECT($PIECE(QAMONE,"^",14):"Yes",1:"No")
+8 WRITE !!," STANDARD OF CARE",!,"------------------"
KILL ^UTILITY($JOB,"W")
SET DIWL=2
SET DIWR=78
SET DIWF="W"
+9 FOR QAMD1=0:0
SET QAMD1=$ORDER(^QA(743,QAMD0,"STDC",QAMD1))
if QAMD1'>0!QAMQUIT
QUIT
SET X=^QA(743,QAMD0,"STDC",QAMD1,0)
DO ^DIWP
DO PAGE
+10 if QAMQUIT
GOTO EXIT
DO ^DIWW
DO PAGE
if QAMQUIT
GOTO EXIT
+11 WRITE !!," CLINICAL INDICATOR",!,"--------------------"
KILL ^UTILITY($JOB,"W")
SET DIWL=2
SET DIWR=78
SET DIWF="W"
DO PAGE
+12 FOR QAMD1=0:0
SET QAMD1=$ORDER(^QA(743,QAMD0,"CLIN",QAMD1))
if QAMD1'>0!QAMQUIT
QUIT
SET X=^QA(743,QAMD0,"CLIN",QAMD1,0)
DO ^DIWP
DO PAGE
+13 if QAMQUIT
GOTO EXIT
DO ^DIWW
DO PAGE
if QAMQUIT
GOTO EXIT
+14 WRITE !!," RATIONALE",?35,"EXPLANATION",!,"-----------",?34,"-------------"
SET QAMHEAD=$ORDER(^QA(743,QAMD0,"RAT",0))
DO PAGE
+15 FOR QAMD1=0:0
SET QAMD1=$ORDER(^QA(743,QAMD0,"RAT",QAMD1))
if QAMD1'>0!QAMQUIT
QUIT
DO RAT1
EXIT if $EXTRACT(IOST)="C"
DO PAUSE
+1 QUIT
RAT1 ;
+1 SET X=$SELECT($DATA(^QA(743,QAMD0,"RAT",QAMD1,0))#2:$PIECE(^(0),"^"),1:"")
SET QAMRAT=$SELECT($DATA(^QA(743.91,+X,0))#2:$PIECE(^(0),"^"),1:X)
+2 KILL ^UTILITY($JOB,"W")
SET DIWL=35
SET DIWR=78
SET DIWF=""
FOR QAMD2=0:0
SET QAMD2=$ORDER(^QA(743,QAMD0,"RAT",QAMD1,"EXP",QAMD2))
if QAMD2'>0
QUIT
SET X=^QA(743,QAMD0,"RAT",QAMD1,"EXP",QAMD2,0)
DO ^DIWP
+3 WRITE !?1,QAMRAT
SET QAMD2=$ORDER(^UTILITY($JOB,"W",DIWL,0))
if QAMD2
WRITE ?DIWL,^UTILITY($JOB,"W",DIWL,QAMD2,0)
SET QAMHEAD=$ORDER(^UTILITY($JOB,"W",DIWL,QAMD2))
DO PAGE
+4 IF QAMD2
FOR QAMD2=QAMD2:0
SET QAMD2=$ORDER(^UTILITY($JOB,"W",DIWL,QAMD2))
if QAMD2'>0!QAMQUIT
QUIT
WRITE !?DIWL,^UTILITY($JOB,"W",DIWL,QAMD2,0)
SET QAMHEAD=$ORDER(^UTILITY($JOB,"W",DIWL,QAMD2))
DO PAGE
+5 QUIT
HEAD ;REPORT HEADER
+1 if (QAMPAGE>1)!($EXTRACT(IOST)="C")
WRITE @IOF
+2 WRITE !!?27,"MONITOR DESCRIPTION REPORT",?68,QAMTODAY,!?68,"PAGE: ",QAMPAGE
SET QAMPAGE=QAMPAGE+1
WRITE !,"================================================================================"
+3 QUIT
PAUSE ;PAUSE AT END OF PAGE
+1 IF QAMPAUSE
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET QAMQUIT=$SELECT(Y:0,1:1)
SET QAMPAUSE=0
+2 QUIT
PAGE ;CHECK FOR END OF PAGE
+1 SET QAMPAUSE=1
if $Y'>(IOSL-6)
QUIT
if $EXTRACT(IOST)="C"
DO PAUSE
if QAMQUIT
QUIT
if QAMHEAD
DO HEAD
+2 QUIT
