QAMPFAL1 ;HISC/DAD-PATIENTS WITH MULTIPLE FALL OUTS REPORT ;9/14/92 11:26
;;1.0;Clinical Monitoring System;;09/13/1993
S PAGE=1,QAMQUIT=0 K UNDL S $P(UNDL,"-",80)="-" D NOW^%DTC S Y=X X ^DD("DD") S TODAY=Y D HEAD
I $O(^UTILITY($J,"QAMPFAL",""))="" W !!,"NO DATA FOUND FOR THIS REPORT" G EXIT
S QAMNAME="" F QAMNAME(0)=0:0 S QAMNAME=$O(^UTILITY($J,"QAMPFAL",QAMNAME)) Q:QAMNAME=""!QAMQUIT D LOOP1
EXIT ;
Q
LOOP1 ;
S QAMSSN=^UTILITY($J,"QAMPFAL",QAMNAME) W !!,QAMNAME,?56,QAMSSN I $Y>(IOSL-6) D:$E(IOST)="C" PAUSE Q:QAMQUIT D HEAD
F QAMDT=0:0 S QAMDT=$O(^UTILITY($J,"QAMPFAL",QAMNAME,QAMDT)) Q:QAMDT'>0!QAMQUIT D
. F QAMONIEN=0:0 S QAMONIEN=$O(^UTILITY($J,"QAMPFAL",QAMNAME,QAMDT,QAMONIEN)) Q:QAMONIEN'>0!QAMQUIT D
.. F QAMD0=0:0 S QAMD0=$O(^UTILITY($J,"QAMPFAL",QAMNAME,QAMDT,QAMONIEN,QAMD0)) Q:QAMD0'>0!QAMQUIT D LOOP2
.. Q
. Q
Q
LOOP2 ;
S Y=QAMDT X ^DD("DD") S QAM=$S($D(^QA(743,QAMONIEN,0))#2:^(0),1:QAMONIEN) W !?2,Y,?24,$P(QAM,"^",2),?56,$E($P(QAM,"^"),1,20),$S($P(QAM,"^",4):" (a)",1:" (m)") I $Y>(IOSL-6) D:$E(IOST)="C" PAUSE Q:QAMQUIT D HEAD
Q
PAUSE ;
K DIR S DIR(0)="E" D ^DIR S QAMQUIT=$S(Y'>0:1,1:0)
Q
HEAD ;
W:(PAGE>1)!($E(IOST)="C") @IOF
W !!?20,"PATIENTS WITH MULTIPLE FALL OUTS (MIN=",QAMINFAL,")",?68,TODAY,!,?80-$L(QAQ2HED)/2,QAQ2HED,?68,"PAGE: ",PAGE S PAGE=PAGE+1
D EN6^QAQAUTL W !,"PATIENT",?56,"SOCIAL SECURITY NUMBER",!?2,"EVENT DATE",?24,"MONITOR TITLE",?56,"MONITOR CODE",!,UNDL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMPFAL1 1457 printed Dec 13, 2024@01:42:33 Page 2
QAMPFAL1 ;HISC/DAD-PATIENTS WITH MULTIPLE FALL OUTS REPORT ;9/14/92 11:26
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
+2 SET PAGE=1
SET QAMQUIT=0
KILL UNDL
SET $PIECE(UNDL,"-",80)="-"
DO NOW^%DTC
SET Y=X
XECUTE ^DD("DD")
SET TODAY=Y
DO HEAD
+3 IF $ORDER(^UTILITY($JOB,"QAMPFAL",""))=""
WRITE !!,"NO DATA FOUND FOR THIS REPORT"
GOTO EXIT
+4 SET QAMNAME=""
FOR QAMNAME(0)=0:0
SET QAMNAME=$ORDER(^UTILITY($JOB,"QAMPFAL",QAMNAME))
if QAMNAME=""!QAMQUIT
QUIT
DO LOOP1
EXIT ;
+1 QUIT
LOOP1 ;
+1 SET QAMSSN=^UTILITY($JOB,"QAMPFAL",QAMNAME)
WRITE !!,QAMNAME,?56,QAMSSN
IF $Y>(IOSL-6)
if $EXTRACT(IOST)="C"
DO PAUSE
if QAMQUIT
QUIT
DO HEAD
+2 FOR QAMDT=0:0
SET QAMDT=$ORDER(^UTILITY($JOB,"QAMPFAL",QAMNAME,QAMDT))
if QAMDT'>0!QAMQUIT
QUIT
Begin DoDot:1
+3 FOR QAMONIEN=0:0
SET QAMONIEN=$ORDER(^UTILITY($JOB,"QAMPFAL",QAMNAME,QAMDT,QAMONIEN))
if QAMONIEN'>0!QAMQUIT
QUIT
Begin DoDot:2
+4 FOR QAMD0=0:0
SET QAMD0=$ORDER(^UTILITY($JOB,"QAMPFAL",QAMNAME,QAMDT,QAMONIEN,QAMD0))
if QAMD0'>0!QAMQUIT
QUIT
DO LOOP2
+5 QUIT
End DoDot:2
+6 QUIT
End DoDot:1
+7 QUIT
LOOP2 ;
+1 SET Y=QAMDT
XECUTE ^DD("DD")
SET QAM=$SELECT($DATA(^QA(743,QAMONIEN,0))#2:^(0),1:QAMONIEN)
WRITE !?2,Y,?24,$PIECE(QAM,"^",2),?56,$EXTRACT($PIECE(QAM,"^"),1,20),$SELECT($PIECE(QAM,"^",4):" (a)",1:" (m)")
IF $Y>(IOSL-6)
if $EXTRACT(IOST)="C"
DO PAUSE
if QAMQUIT
QUIT
DO HEAD
+2 QUIT
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
SET QAMQUIT=$SELECT(Y'>0:1,1:0)
+2 QUIT
HEAD ;
+1 if (PAGE>1)!($EXTRACT(IOST)="C")
WRITE @IOF
+2 WRITE !!?20,"PATIENTS WITH MULTIPLE FALL OUTS (MIN=",QAMINFAL,")",?68,TODAY,!,?80-$LENGTH(QAQ2HED)/2,QAQ2HED,?68,"PAGE: ",PAGE
SET PAGE=PAGE+1
+3 DO EN6^QAQAUTL
WRITE !,"PATIENT",?56,"SOCIAL SECURITY NUMBER",!?2,"EVENT DATE",?24,"MONITOR TITLE",?56,"MONITOR CODE",!,UNDL
+4 QUIT
