- HBHCRP20 ; LR VAMC(IRMS)/MJT-HBHC report on file 632, unique patients by date range summary ; Apr 2000
- ;;1.0;HOSPITAL BASED HOME CARE;**8,10,16**;NOV 01, 1993
- D START^HBHCUTL
- G:(HBHCBEG1=-1)!(HBHCEND1=-1) EXIT
- S %ZIS="Q",HBHCCC=0 K IOP,ZTIO,ZTSAVE D ^%ZIS G:POP EXIT
- I $D(IO("Q")) S ZTRTN="DQ^HBHCRP20",ZTDESC="HBPC Unique Patients by Date Range Summary Report",ZTSAVE("HBHC*")="" D ^%ZTLOAD G EXIT
- DQ ; De-queue
- U IO
- K ^TMP("HBHC",$J)
- S $P(HBHCY,"-",81)="",HBHCHEAD="Unique Patients by Date Range Summary",(HBHCCNT,HBHCCNT1)=0
- S HBHCCOLM=(80-(30+$L(HBHCHEAD))\2) S:HBHCCOLM'>0 HBHCCOLM=1
- D TODAY^HBHCUTL D:IO'=IO(0)!($D(IO("S"))) HDRRANGE^HBHCUTL
- I '$D(IO("S")),(IO=IO(0)) S HBHCCC=HBHCCC+1 D HDRRANGE^HBHCUTL
- LOOP ; Loop thru ^HBHC(632) "C" (appointment date) cross-ref to build report
- S X1=HBHCBEG1,X2=-1 D C^%DTC S HBHCAPDT=X_.9999
- F S HBHCAPDT=$O(^HBHC(632,"C",HBHCAPDT)) Q:(HBHCAPDT="")!(HBHCAPDT>HBHCEND1) S HBHCDFN="" F S HBHCDFN=$O(^HBHC(632,"C",HBHCAPDT,HBHCDFN)) Q:HBHCDFN="" S HBHCNOD0=^HBHC(632,HBHCDFN,0) D:$P(HBHCNOD0,U,7)="" PROCESS
- D CNTLOOP
- W !!,"Total Patients with Single Appointment Only:",?46,$J(HBHCCNT1,4)
- W !,"Total Patients with Multiple Appointments:",?46,$J(HBHCCNT,4)
- W !!,"Total Unique Patients: ",$J((HBHCCNT+HBHCCNT1),5)
- D ENDRPT^HBHCUTL1
- EXIT ; Exit module
- D ^%ZISC
- K HBHCAPDT,HBHCBEG1,HBHCBEG2,HBHCCC,HBHCCNT,HBHCCNT1,HBHCCOLM,HBHCDFN,HBHCDPT0,HBHCEND1,HBHCEND2,HBHCHEAD,HBHCNAME,HBHCNOD0,HBHCPAGE,HBHCSSN,HBHCTDY,HBHCY,HBHCZ,X,X1,X2,Y,^TMP("HBHC",$J)
- Q
- PROCESS ; Process record & build ^TMP("HBHC",$J) global
- S HBHCDPT0=^DPT($P(HBHCNOD0,U),0)
- D:$D(^TMP("HBHC",$J,$P(HBHCDPT0,U),$E($P(HBHCDPT0,U,9),1,3)_"-"_$E($P(HBHCDPT0,U,9),4,5)_"-"_$E($P(HBHCDPT0,U,9),6,9))) SET
- S:'$D(^TMP("HBHC",$J,$P(HBHCDPT0,U),$E($P(HBHCDPT0,U,9),1,3)_"-"_$E($P(HBHCDPT0,U,9),4,5)_"-"_$E($P(HBHCDPT0,U,9),6,9))) ^TMP("HBHC",$J,$P(HBHCDPT0,U),$E($P(HBHCDPT0,U,9),1,3)_"-"_$E($P(HBHCDPT0,U,9),4,5)_"-"_$E($P(HBHCDPT0,U,9),6,9))=HBHCAPDT
- Q
- SET ; Set ^TMP("HBHC",$J
- S ^TMP("HBHC",$J,$P(HBHCDPT0,U),$E($P(HBHCDPT0,U,9),1,3)_"-"_$E($P(HBHCDPT0,U,9),4,5)_"-"_$E($P(HBHCDPT0,U,9),6,9))=HBHCAPDT_U_"*"
- Q
- CNTLOOP ; Count loop
- S HBHCNAME="" F S HBHCNAME=$O(^TMP("HBHC",$J,HBHCNAME)) Q:HBHCNAME="" S HBHCSSN="" F S HBHCSSN=$O(^TMP("HBHC",$J,HBHCNAME,HBHCSSN)) Q:HBHCSSN="" D COUNT
- Q
- COUNT ; Count
- ; patients with multiple visits
- S:$P(^TMP("HBHC",$J,HBHCNAME,HBHCSSN),U,2)]"" HBHCCNT=HBHCCNT+1
- ; patients with only 1 visit
- S:$P(^TMP("HBHC",$J,HBHCNAME,HBHCSSN),U,2)="" HBHCCNT1=HBHCCNT1+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCRP20 2574 printed Jan 18, 2025@02:59:38 Page 2
- HBHCRP20 ; LR VAMC(IRMS)/MJT-HBHC report on file 632, unique patients by date range summary ; Apr 2000
- +1 ;;1.0;HOSPITAL BASED HOME CARE;**8,10,16**;NOV 01, 1993
- +2 DO START^HBHCUTL
- +3 if (HBHCBEG1=-1)!(HBHCEND1=-1)
- GOTO EXIT
- +4 SET %ZIS="Q"
- SET HBHCCC=0
- KILL IOP,ZTIO,ZTSAVE
- DO ^%ZIS
- if POP
- GOTO EXIT
- +5 IF $DATA(IO("Q"))
- SET ZTRTN="DQ^HBHCRP20"
- SET ZTDESC="HBPC Unique Patients by Date Range Summary Report"
- SET ZTSAVE("HBHC*")=""
- DO ^%ZTLOAD
- GOTO EXIT
- DQ ; De-queue
- +1 USE IO
- +2 KILL ^TMP("HBHC",$JOB)
- +3 SET $PIECE(HBHCY,"-",81)=""
- SET HBHCHEAD="Unique Patients by Date Range Summary"
- SET (HBHCCNT,HBHCCNT1)=0
- +4 SET HBHCCOLM=(80-(30+$LENGTH(HBHCHEAD))\2)
- if HBHCCOLM'>0
- SET HBHCCOLM=1
- +5 DO TODAY^HBHCUTL
- if IO'=IO(0)!($DATA(IO("S")))
- DO HDRRANGE^HBHCUTL
- +6 IF '$DATA(IO("S"))
- IF (IO=IO(0))
- SET HBHCCC=HBHCCC+1
- DO HDRRANGE^HBHCUTL
- LOOP ; Loop thru ^HBHC(632) "C" (appointment date) cross-ref to build report
- +1 SET X1=HBHCBEG1
- SET X2=-1
- DO C^%DTC
- SET HBHCAPDT=X_.9999
- +2 FOR
- SET HBHCAPDT=$ORDER(^HBHC(632,"C",HBHCAPDT))
- if (HBHCAPDT="")!(HBHCAPDT>HBHCEND1)
- QUIT
- SET HBHCDFN=""
- FOR
- SET HBHCDFN=$ORDER(^HBHC(632,"C",HBHCAPDT,HBHCDFN))
- if HBHCDFN=""
- QUIT
- SET HBHCNOD0=^HBHC(632,HBHCDFN,0)
- if $PIECE(HBHCNOD0,U,7)=""
- DO PROCESS
- +3 DO CNTLOOP
- +4 WRITE !!,"Total Patients with Single Appointment Only:",?46,$JUSTIFY(HBHCCNT1,4)
- +5 WRITE !,"Total Patients with Multiple Appointments:",?46,$JUSTIFY(HBHCCNT,4)
- +6 WRITE !!,"Total Unique Patients: ",$JUSTIFY((HBHCCNT+HBHCCNT1),5)
- +7 DO ENDRPT^HBHCUTL1
- EXIT ; Exit module
- +1 DO ^%ZISC
- +2 KILL HBHCAPDT,HBHCBEG1,HBHCBEG2,HBHCCC,HBHCCNT,HBHCCNT1,HBHCCOLM,HBHCDFN,HBHCDPT0,HBHCEND1,HBHCEND2,HBHCHEAD,HBHCNAME,HBHCNOD0,HBHCPAGE,HBHCSSN,HBHCTDY,HBHCY,HBHCZ,X,X1,X2,Y,^TMP("HBHC",$JOB)
- +3 QUIT
- PROCESS ; Process record & build ^TMP("HBHC",$J) global
- +1 SET HBHCDPT0=^DPT($PIECE(HBHCNOD0,U),0)
- +2 if $DATA(^TMP("HBHC",$JOB,$PIECE(HBHCDPT0,U),$EXTRACT($PIECE(HBHCDPT0,U,9),1,3)_"-"_$EXTRACT($PIECE(HBHCDPT0,U,9),4,5)_"-"_$EXTRACT($PIECE(HBHCDPT0,U,9),6,9)))
- DO SET
- +3 if '$DATA(^TMP("HBHC",$JOB,$PIECE(HBHCDPT0,U),$EXTRACT($PIECE(HBHCDPT0,U,9),1,3)_"-"_$EXTRACT($PIECE(HBHCDPT0,U,9),4,5)_"-"_$EXTRACT($PIECE(HBHCDPT0,U,9),6,9)))
- SET ^TMP("HBHC",$JOB,$PIECE(HBHCDPT0,U),$EXTRACT($PIECE(HBHCDPT0,U,9),1,3)_"-"_$EXTRACT($PIECE(HBHCDPT0,U,9),4,5)_"-"_$EXTRACT($PIECE(HBHCDPT0,U,9),6,9))=HBHCAPDT
- +4 QUIT
- SET ; Set ^TMP("HBHC",$J
- +1 SET ^TMP("HBHC",$JOB,$PIECE(HBHCDPT0,U),$EXTRACT($PIECE(HBHCDPT0,U,9),1,3)_"-"_$EXTRACT($PIECE(HBHCDPT0,U,9),4,5)_"-"_$EXTRACT($PIECE(HBHCDPT0,U,9),6,9))=HBHCAPDT_U_"*"
- +2 QUIT
- CNTLOOP ; Count loop
- +1 SET HBHCNAME=""
- FOR
- SET HBHCNAME=$ORDER(^TMP("HBHC",$JOB,HBHCNAME))
- if HBHCNAME=""
- QUIT
- SET HBHCSSN=""
- FOR
- SET HBHCSSN=$ORDER(^TMP("HBHC",$JOB,HBHCNAME,HBHCSSN))
- if HBHCSSN=""
- QUIT
- DO COUNT
- +2 QUIT
- COUNT ; Count
- +1 ; patients with multiple visits
- +2 if $PIECE(^TMP("HBHC",$JOB,HBHCNAME,HBHCSSN),U,2)]""
- SET HBHCCNT=HBHCCNT+1
- +3 ; patients with only 1 visit
- +4 if $PIECE(^TMP("HBHC",$JOB,HBHCNAME,HBHCSSN),U,2)=""
- SET HBHCCNT1=HBHCCNT1+1
- +5 QUIT