- 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 Jan 18, 2025@02:43:46 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