QAMPFAL0 ;HISC/DAD-PATIENTS WITH MULTIPLE FALL OUTS REPORT ;7/2/92 08:13
;;1.0;Clinical Monitoring System;;09/13/1993
K ^UTILITY($J,"QAMPFAL"),^UTILITY($J,"QAM MONITOR")
S QAQDIC="^QA(743,",QAQDIC(0)="AEMNQZ",QAQDIC("A")="Select MONITOR: ",QAQUTIL="QAM MONITOR" D EN1^QAQSELCT G:QAQQUIT EXIT
K DIR,DIRUT S DIR(0)="NO^1:99:0",DIR("A")="Minimum number of fall outs per patient",DIR("?",1)="Enter the minimum number of fall outs a patient must have",DIR("?")="in order to appear on this report."
W ! D ^DIR G:$D(DIRUT) EXIT S QAMINFAL=Y D ^QAQDATE G:QAQQUIT EXIT
K %ZIS,IOP S %ZIS="MQ" D ^%ZIS G:POP EXIT
I $D(IO("Q")) K IO("Q") S ZTRTN="ENTSK^QAMPFAL0",(ZTSAVE("QAM*"),ZTSAVE("QAQ*"),ZTSAVE("^UTILITY($J,"))="",ZTDESC="Patients with multiple fall outs report" D ^%ZTLOAD G EXIT
ENTSK ;
S QAMONTXT="" F QAMONTXT(0)=0:0 S QAMONTXT=$O(^UTILITY($J,"QAM MONITOR",QAMONTXT)) Q:QAMONTXT="" F QAMONIEN=0:0 S QAMONIEN=$O(^UTILITY($J,"QAM MONITOR",QAMONTXT,QAMONIEN)) Q:QAMONIEN'>0 D LOOP1
D ^QAMPFAL1
EXIT ;
W ! D ^%ZISC
K %ZIS,DFN,DIR,DIRUT,FALLDATE,MONITOR,PAGE,POP,QAM,QAMCOUNT,QAMD0,QAMDFN,QAMDT,QAMINFAL,QAMNAME,QAMONIEN,QAMONTXT,QAMQUIT,QAMSSN,TODAY,UNDL,VA,X,Y,ZTRTN,ZTSAVE,QAQQUIT,VAERR,^UTILITY($J,"QAMPFAL"),^UTILITY($J,"QAM MONITOR")
D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
Q
LOOP1 ;
F QAMDT=(QAQNBEG-.0000001):0 S QAMDT=$O(^QA(743.1,"AA",QAMONIEN,QAMDT)) Q:(QAMDT'>0)!(QAMDT>(QAQNEND+.9999999)) F QAMDFN=0:0 S QAMDFN=$O(^QA(743.1,"AA",QAMONIEN,QAMDT,QAMDFN)) Q:QAMDFN'>0 D LOOP2
Q
LOOP2 ;
S QAM=$S($D(^DPT(QAMDFN,0))#2:^(0),1:"") Q:QAM="" S QAMNAME=$P(QAM,"^"),QAMCOUNT=0 Q:$D(^UTILITY($J,"QAMPFAL",QAMNAME))
S DFN=QAMDFN D PID^VADPT6 S QAMSSN=VA("PID")
S ^UTILITY($J,"QAMPFAL",QAMNAME)=QAMSSN
F QAMD0=0:0 S QAMD0=$O(^QA(743.1,"B",QAMDFN,QAMD0)) Q:QAMD0'>0 D LOOP3
K:QAMCOUNT<QAMINFAL ^UTILITY($J,"QAMPFAL",QAMNAME)
Q
LOOP3 ;
S QAM=$S($D(^QA(743.1,QAMD0,0))#2:^(0),1:""),MONITOR=$P(QAM,"^",2),FALLDATE=$P(QAM,"^",3) Q:(MONITOR'>0)!(FALLDATE<QAQNBEG)!(FALLDATE>(QAQNEND+.9999999))
S ^UTILITY($J,"QAMPFAL",QAMNAME,FALLDATE,MONITOR,QAMD0)="",QAMCOUNT=QAMCOUNT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMPFAL0 2120 printed Dec 13, 2024@01:42:32 Page 2
QAMPFAL0 ;HISC/DAD-PATIENTS WITH MULTIPLE FALL OUTS REPORT ;7/2/92 08:13
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
+2 KILL ^UTILITY($JOB,"QAMPFAL"),^UTILITY($JOB,"QAM MONITOR")
+3 SET QAQDIC="^QA(743,"
SET QAQDIC(0)="AEMNQZ"
SET QAQDIC("A")="Select MONITOR: "
SET QAQUTIL="QAM MONITOR"
DO EN1^QAQSELCT
if QAQQUIT
GOTO EXIT
+4 KILL DIR,DIRUT
SET DIR(0)="NO^1:99:0"
SET DIR("A")="Minimum number of fall outs per patient"
SET DIR("?",1)="Enter the minimum number of fall outs a patient must have"
SET DIR("?")="in order to appear on this report."
+5 WRITE !
DO ^DIR
if $DATA(DIRUT)
GOTO EXIT
SET QAMINFAL=Y
DO ^QAQDATE
if QAQQUIT
GOTO EXIT
+6 KILL %ZIS,IOP
SET %ZIS="MQ"
DO ^%ZIS
if POP
GOTO EXIT
+7 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="ENTSK^QAMPFAL0"
SET (ZTSAVE("QAM*"),ZTSAVE("QAQ*"),ZTSAVE("^UTILITY($J,"))=""
SET ZTDESC="Patients with multiple fall outs report"
DO ^%ZTLOAD
GOTO EXIT
ENTSK ;
+1 SET QAMONTXT=""
FOR QAMONTXT(0)=0:0
SET QAMONTXT=$ORDER(^UTILITY($JOB,"QAM MONITOR",QAMONTXT))
if QAMONTXT=""
QUIT
FOR QAMONIEN=0:0
SET QAMONIEN=$ORDER(^UTILITY($JOB,"QAM MONITOR",QAMONTXT,QAMONIEN))
if QAMONIEN'>0
QUIT
DO LOOP1
+2 DO ^QAMPFAL1
EXIT ;
+1 WRITE !
DO ^%ZISC
+2 KILL %ZIS,DFN,DIR,DIRUT,FALLDATE,MONITOR,PAGE,POP,QAM,QAMCOUNT,QAMD0,QAMDFN,QAMDT,QAMINFAL,QAMNAME,QAMONIEN,QAMONTXT,QAMQUIT,QAMSSN,TODAY,UNDL,VA,X,Y,ZTRTN,ZTSAVE,QAQQUIT,VAERR,^UTILITY($JOB,"QAMPFAL"),^UTILITY($JOB,"QAM MONITOR")
+3 DO K^QAQDATE
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 QUIT
LOOP1 ;
+1 FOR QAMDT=(QAQNBEG-.0000001):0
SET QAMDT=$ORDER(^QA(743.1,"AA",QAMONIEN,QAMDT))
if (QAMDT'>0)!(QAMDT>(QAQNEND+.9999999))
QUIT
FOR QAMDFN=0:0
SET QAMDFN=$ORDER(^QA(743.1,"AA",QAMONIEN,QAMDT,QAMDFN))
if QAMDFN'>0
QUIT
DO LOOP2
+2 QUIT
LOOP2 ;
+1 SET QAM=$SELECT($DATA(^DPT(QAMDFN,0))#2:^(0),1:"")
if QAM=""
QUIT
SET QAMNAME=$PIECE(QAM,"^")
SET QAMCOUNT=0
if $DATA(^UTILITY($JOB,"QAMPFAL",QAMNAME))
QUIT
+2 SET DFN=QAMDFN
DO PID^VADPT6
SET QAMSSN=VA("PID")
+3 SET ^UTILITY($JOB,"QAMPFAL",QAMNAME)=QAMSSN
+4 FOR QAMD0=0:0
SET QAMD0=$ORDER(^QA(743.1,"B",QAMDFN,QAMD0))
if QAMD0'>0
QUIT
DO LOOP3
+5 if QAMCOUNT<QAMINFAL
KILL ^UTILITY($JOB,"QAMPFAL",QAMNAME)
+6 QUIT
LOOP3 ;
+1 SET QAM=$SELECT($DATA(^QA(743.1,QAMD0,0))#2:^(0),1:"")
SET MONITOR=$PIECE(QAM,"^",2)
SET FALLDATE=$PIECE(QAM,"^",3)
if (MONITOR'>0)!(FALLDATE<QAQNBEG)!(FALLDATE>(QAQNEND+.9999999))
QUIT
+2 SET ^UTILITY($JOB,"QAMPFAL",QAMNAME,FALLDATE,MONITOR,QAMD0)=""
SET QAMCOUNT=QAMCOUNT+1
+3 QUIT
