- QAMAUTO3 ;HISC/GJC-AUTO ENROLL FALL OUT REPORT ;9/13/93 08:42
- ;;1.0;Clinical Monitoring System;;09/13/1993
- ;
- S ZTIO=$P($G(^QA(740,1,"QAM")),U,2) G:ZTIO="" K9
- S ZTDESC="Generate Fall-Out reports.",ZTDTH=$H,ZTRTN="EN1^QAMAUTO3",(ZTSAVE("^UTILITY($J,"),ZTSAVE("QAMD0"),ZTSAVE("QAMTODAY"))="" D ^%ZTLOAD
- G K9
- EN1 U IO
- K QAMST S QAMPG=0,Y=DT X ^DD("DD") S QAMDT=Y,$P(QAMST,"-",81)="",Y=QAMTODAY X ^DD("DD") S QAMDT0=Y
- D HDER G:'$D(QAMD0) K1
- I $D(^UTILITY($J,"QAM FALL OUT",QAMD0)),^(QAMD0)'>0 W !,"Zero fall outs for the ",$P($G(^QA(743,QAMD0,0)),U)," monitor." G K1
- ;GRAB THE PATIENT(S) FOR THE SPECIFIC MONITOR.
- S QAM1=0 K ^TMP($J,"QAMAUTO3")
- F S QAM1=$O(^UTILITY($J,"QAM FALL OUT",QAMD0,QAM1)) Q:QAM1'>0 D
- . S X=$P($G(^DPT(QAM1,0)),"^") Q:X=""
- . S ^TMP($J,"QAMAUTO3",X,QAM1)=""
- . Q
- S QAMPAT="" F S QAMPAT=$O(^TMP($J,"QAMAUTO3",QAMPAT)) Q:QAMPAT="" F QAM1=0:0 S QAM1=$O(^TMP($J,"QAMAUTO3",QAMPAT,QAM1)) Q:QAM1'>0 D PAT
- W !!,"Total number of Fall Outs is: ",^UTILITY($J,"QAM FALL OUT",QAMD0),!,"Fall Out sample size is: ",^UTILITY($J,"QAM SAMPLE",QAMD0),!,"Percent Fall Out: "
- I ^UTILITY($J,"QAM SAMPLE",QAMD0)>0 W $J((^UTILITY($J,"QAM FALL OUT",QAMD0)/^UTILITY($J,"QAM SAMPLE",QAMD0)*100),3,3)_"%",!
- E W "Division by zero!",!
- K1 W !
- K9 D ^%ZISC,HOME^%ZIS
- K %ZIS,DFN,IOP,QAM1,QAMDT,QAMDT0,QAMFG,QAMPG,QAMSSN,QAMST,QAMZ,VA,Y,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK,^TMP($J,"QAMAUTO3")
- S:$D(ZTQUEUED) ZTREQ="@"
- Q
- PAT ;
- S DFN=QAM1 D PID^VADPT6 S QAMSSN=VA("PID") W !,"PATIENT: ",$S($D(^DPT(QAM1,0))#2:$P(^(0),U),1:QAM1),?45,"SSN: ",QAMSSN D DATE
- Q
- DATE ;
- F QAMZ=0:0 S QAMZ=$O(^UTILITY($J,"QAM FALL OUT",QAMD0,QAM1,QAMZ)) Q:QAMZ'>0 S Y=QAMZ X ^DD("DD") W !," DATE: ",Y W:^UTILITY($J,"QAM FALL OUT",QAMD0,QAM1,QAMZ)="*" ?45,"*** Duplicate ***" D:$Y>(IOSL-5) HDER
- Q
- HDER ;HEADER
- S QAMPG=QAMPG+1 W:(QAMPG>1)!($E(IOST)="C") @IOF
- W !!?30,"DAILY FALL OUT REPORT",?68,QAMDT,!?32,"FOR: ",QAMDT0,?68,"PAGE: ",QAMPG D EN6^QAQAUTL W !,QAMST
- I $S($D(QAMD0)[0:1,$D(^QA(743,+QAMD0,0))[0:1,1:0) W !!,"*** Monitor data not found ***" Q
- S QAM=$G(^QA(743,+QAMD0,0))
- W !!,"CODE: ",$P(QAM,U)," ",$S($P(QAM,U,4):"(a)",1:"(m)"),?43,"TITLE: ",$P(QAM,U,2),! W "SERVICE: " I $P(QAM,U,3) W $P($G(^DIC(49,+$P(QAM,U,3),0)),U)
- W !
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMAUTO3 2270 printed Feb 18, 2025@23:08:10 Page 2
- QAMAUTO3 ;HISC/GJC-AUTO ENROLL FALL OUT REPORT ;9/13/93 08:42
- +1 ;;1.0;Clinical Monitoring System;;09/13/1993
- +2 ;
- +3 SET ZTIO=$PIECE($GET(^QA(740,1,"QAM")),U,2)
- if ZTIO=""
- GOTO K9
- +4 SET ZTDESC="Generate Fall-Out reports."
- SET ZTDTH=$HOROLOG
- SET ZTRTN="EN1^QAMAUTO3"
- SET (ZTSAVE("^UTILITY($J,"),ZTSAVE("QAMD0"),ZTSAVE("QAMTODAY"))=""
- DO ^%ZTLOAD
- +5 GOTO K9
- EN1 USE IO
- +1 KILL QAMST
- SET QAMPG=0
- SET Y=DT
- XECUTE ^DD("DD")
- SET QAMDT=Y
- SET $PIECE(QAMST,"-",81)=""
- SET Y=QAMTODAY
- XECUTE ^DD("DD")
- SET QAMDT0=Y
- +2 DO HDER
- if '$DATA(QAMD0)
- GOTO K1
- +3 IF $DATA(^UTILITY($JOB,"QAM FALL OUT",QAMD0))
- IF ^(QAMD0)'>0
- WRITE !,"Zero fall outs for the ",$PIECE($GET(^QA(743,QAMD0,0)),U)," monitor."
- GOTO K1
- +4 ;GRAB THE PATIENT(S) FOR THE SPECIFIC MONITOR.
- +5 SET QAM1=0
- KILL ^TMP($JOB,"QAMAUTO3")
- +6 FOR
- SET QAM1=$ORDER(^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAM1))
- if QAM1'>0
- QUIT
- Begin DoDot:1
- +7 SET X=$PIECE($GET(^DPT(QAM1,0)),"^")
- if X=""
- QUIT
- +8 SET ^TMP($JOB,"QAMAUTO3",X,QAM1)=""
- +9 QUIT
- End DoDot:1
- +10 SET QAMPAT=""
- FOR
- SET QAMPAT=$ORDER(^TMP($JOB,"QAMAUTO3",QAMPAT))
- if QAMPAT=""
- QUIT
- FOR QAM1=0:0
- SET QAM1=$ORDER(^TMP($JOB,"QAMAUTO3",QAMPAT,QAM1))
- if QAM1'>0
- QUIT
- DO PAT
- +11 WRITE !!,"Total number of Fall Outs is: ",^UTILITY($JOB,"QAM FALL OUT",QAMD0),!,"Fall Out sample size is: ",^UTILITY($JOB,"QAM SAMPLE",QAMD0),!,"Percent Fall Out: "
- +12 IF ^UTILITY($JOB,"QAM SAMPLE",QAMD0)>0
- WRITE $JUSTIFY((^UTILITY($JOB,"QAM FALL OUT",QAMD0)/^UTILITY($JOB,"QAM SAMPLE",QAMD0)*100),3,3)_"%",!
- +13 IF '$TEST
- WRITE "Division by zero!",!
- K1 WRITE !
- K9 DO ^%ZISC
- DO HOME^%ZIS
- +1 KILL %ZIS,DFN,IOP,QAM1,QAMDT,QAMDT0,QAMFG,QAMPG,QAMSSN,QAMST,QAMZ,VA,Y,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK,^TMP($JOB,"QAMAUTO3")
- +2 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +3 QUIT
- PAT ;
- +1 SET DFN=QAM1
- DO PID^VADPT6
- SET QAMSSN=VA("PID")
- WRITE !,"PATIENT: ",$SELECT($DATA(^DPT(QAM1,0))#2:$PIECE(^(0),U),1:QAM1),?45,"SSN: ",QAMSSN
- DO DATE
- +2 QUIT
- DATE ;
- +1 FOR QAMZ=0:0
- SET QAMZ=$ORDER(^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAM1,QAMZ))
- if QAMZ'>0
- QUIT
- SET Y=QAMZ
- XECUTE ^DD("DD")
- WRITE !," DATE: ",Y
- if ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAM1,QAMZ)="*"
- WRITE ?45,"*** Duplicate ***"
- if $Y>(IOSL-5)
- DO HDER
- +2 QUIT
- HDER ;HEADER
- +1 SET QAMPG=QAMPG+1
- if (QAMPG>1)!($EXTRACT(IOST)="C")
- WRITE @IOF
- +2 WRITE !!?30,"DAILY FALL OUT REPORT",?68,QAMDT,!?32,"FOR: ",QAMDT0,?68,"PAGE: ",QAMPG
- DO EN6^QAQAUTL
- WRITE !,QAMST
- +3 IF $SELECT($DATA(QAMD0)[0:1,$DATA(^QA(743,+QAMD0,0))[0:1,1:0)
- WRITE !!,"*** Monitor data not found ***"
- QUIT
- +4 SET QAM=$GET(^QA(743,+QAMD0,0))
- +5 WRITE !!,"CODE: ",$PIECE(QAM,U)," ",$SELECT($PIECE(QAM,U,4):"(a)",1:"(m)"),?43,"TITLE: ",$PIECE(QAM,U,2),!
- WRITE "SERVICE: "
- IF $PIECE(QAM,U,3)
- WRITE $PIECE($GET(^DIC(49,+$PIECE(QAM,U,3),0)),U)
- +6 WRITE !
- +7 QUIT