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 Dec 13, 2024@01:41:47 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
