- 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 Feb 18, 2025@23:08:54 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