PXRRLCCP ;ISL/PKR - encounter by clinic print. ;5/27/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18**;Aug 12, 1996
;
N BMARG,C2S,C3S,C3E,C3HS,CMAX,DONE,HEAD,HLOCMAX,INDENT,MID,PAGE
N CLASSNAM,DATE,IC,FACILITY,FACPNAME,FTOTAL
N GTOTAL,HLOC
N LOCLIST,LOCNAME,NLOCLIST,PNAME,SC,TEMP,VIEN
;
;Allow the task to be cleaned up upon successful completion.
S ZTREQ="@"
;
U IO
;Setup the formatting parameters.
S HLOCMAX=^XTMP(PXRRXTMP,"HLOCMAX")
S INDENT=3
S C2S=INDENT+HLOCMAX+1
S C3HS=INDENT+38
;We assume that the counts will never be longer than six digits.
S MID=C3HS+6
S BMARG=2
;
S DONE=0
S GTOTAL=0
;
S PAGE=1
D HDR^PXRRGPRT(PAGE)
W !!,"Criteria for Clinic Encounter Count Report"
D OLRCRIT^PXRRGPRT(3)
;
SET ;Set up print fields
S FACILITY=0
FAC S FACILITY=$O(^XTMP(PXRRXTMP,FACILITY))
I +FACILITY=0 G END
;Mark the facility as being found.
F IC=1:1:NFAC I $P(PXRRFAC(IC),U,1)=FACILITY D Q
. S $P(PXRRFAC(IC),U,4)="M"
K LOCLIST
K ^TMP(PXRRXTMP,$J,"PXRRLOC")
S HEAD=1
S FTOTAL=0
S FACPNAME=$P(PXRRFACN(FACILITY),U,1)_" "_$P(PXRRFACN(FACILITY),U,2)
;
;Check for a user request to stop the task.
I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRGUT
;
S PNAME=""
PRV S PNAME=$O(^XTMP(PXRRXTMP,FACILITY,PNAME))
I PNAME="" G TOTAL
;
S CLASSNAM=""
CLASS ;
S CLASSNAM=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM))
I CLASSNAM="" G PRV
;
S DATE=""
DATE S DATE=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE))
I DATE="" G CLASS
;
S HLOC=""
HLO S HLOC=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE,HLOC))
I HLOC="" G DATE
S VIEN=""
F S VIEN=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE,HLOC,VIEN)) Q:VIEN="" D
. S ^TMP(PXRRXTMP,$J,"PXRRLOC",HLOC,VIEN)=""
;
G HLO
;
TOTAL ;Total up the encounters.
S NLOCLIST=0
S CMAX=0
S HLOC=""
NLOC S HLOC=$O(^TMP(PXRRXTMP,$J,"PXRRLOC",HLOC))
I HLOC="" G OUTPUT
S TEMP=$$LOCCNT^PXRRLCHP(HLOC)
S CMAX=$$MAX^XLFMTH(CMAX,TEMP)
S LOCLIST(HLOC)=TEMP
S NLOCLIST=NLOCLIST+1
G NLOC
;
OUTPUT ;Print the data.
S HEAD=1
S C3E=MID+($L(CMAX)/2)
S HLOC=""
NEXTP S HLOC=$O(LOCLIST(HLOC))
I HLOC="" S GTOTAL=GTOTAL+FTOTAL G FINAL
S TEMP=LOCLIST(HLOC)
S FTOTAL=FTOTAL+TEMP
D HEAD
I DONE G EXIT
S C3S=C3E-$L(TEMP)
S LOCNAME=$P(HLOC,U,1)
S SC="("_$P(HLOC,U,3)_")"
W !,?INDENT,LOCNAME,?C2S,SC,?C3S,TEMP
G NEXTP
;
FINAL ;Print facility total.
I $Y>(IOSL-BMARG-3) D PAGE^PXRRGPRT
I DONE G EXIT
D PTOTAL^PXRRGPRT("Total facility encounters ",FTOTAL,C3E,1)
G FAC
END ;
I $Y>(IOSL-BMARG-3) D PAGE^PXRRGPRT
I DONE G EXIT
I GTOTAL>0 D PTOTAL^PXRRGPRT("Total encounters ",GTOTAL,C3E,0)
I $Y>(IOSL-BMARG-3) D PAGE^PXRRGPRT
I DONE G EXIT
D FACNE^PXRRGPRT(INDENT)
EXIT ;
D EXIT^PXRRGUT
D EOR^PXRRGUT
Q
;
;=======================================================================
HEAD ;If necessary, write the header.
I HEAD D
. I $Y>(IOSL-BMARG-6) D PAGE^PXRRGPRT
. I DONE Q
. W !!,"Facility: ",FACPNAME
. W !!,?INDENT,"Clinic Stop (Stop Code)",?C3HS,"Encounters"
. W !,?INDENT,"------------------------------------",?C3HS,"----------"
. S HEAD=0
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRLCCP 3166 printed Oct 16, 2024@18:31:22 Page 2
PXRRLCCP ;ISL/PKR - encounter by clinic print. ;5/27/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18**;Aug 12, 1996
+2 ;
+3 NEW BMARG,C2S,C3S,C3E,C3HS,CMAX,DONE,HEAD,HLOCMAX,INDENT,MID,PAGE
+4 NEW CLASSNAM,DATE,IC,FACILITY,FACPNAME,FTOTAL
+5 NEW GTOTAL,HLOC
+6 NEW LOCLIST,LOCNAME,NLOCLIST,PNAME,SC,TEMP,VIEN
+7 ;
+8 ;Allow the task to be cleaned up upon successful completion.
+9 SET ZTREQ="@"
+10 ;
+11 USE IO
+12 ;Setup the formatting parameters.
+13 SET HLOCMAX=^XTMP(PXRRXTMP,"HLOCMAX")
+14 SET INDENT=3
+15 SET C2S=INDENT+HLOCMAX+1
+16 SET C3HS=INDENT+38
+17 ;We assume that the counts will never be longer than six digits.
+18 SET MID=C3HS+6
+19 SET BMARG=2
+20 ;
+21 SET DONE=0
+22 SET GTOTAL=0
+23 ;
+24 SET PAGE=1
+25 DO HDR^PXRRGPRT(PAGE)
+26 WRITE !!,"Criteria for Clinic Encounter Count Report"
+27 DO OLRCRIT^PXRRGPRT(3)
+28 ;
SET ;Set up print fields
+1 SET FACILITY=0
FAC SET FACILITY=$ORDER(^XTMP(PXRRXTMP,FACILITY))
+1 IF +FACILITY=0
GOTO END
+2 ;Mark the facility as being found.
+3 FOR IC=1:1:NFAC
IF $PIECE(PXRRFAC(IC),U,1)=FACILITY
Begin DoDot:1
+4 SET $PIECE(PXRRFAC(IC),U,4)="M"
End DoDot:1
QUIT
+5 KILL LOCLIST
+6 KILL ^TMP(PXRRXTMP,$JOB,"PXRRLOC")
+7 SET HEAD=1
+8 SET FTOTAL=0
+9 SET FACPNAME=$PIECE(PXRRFACN(FACILITY),U,1)_" "_$PIECE(PXRRFACN(FACILITY),U,2)
+10 ;
+11 ;Check for a user request to stop the task.
+12 IF $$S^%ZTLOAD
SET ZTSTOP=1
DO EXIT^PXRRGUT
+13 ;
+14 SET PNAME=""
PRV SET PNAME=$ORDER(^XTMP(PXRRXTMP,FACILITY,PNAME))
+1 IF PNAME=""
GOTO TOTAL
+2 ;
+3 SET CLASSNAM=""
CLASS ;
+1 SET CLASSNAM=$ORDER(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM))
+2 IF CLASSNAM=""
GOTO PRV
+3 ;
+4 SET DATE=""
DATE SET DATE=$ORDER(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE))
+1 IF DATE=""
GOTO CLASS
+2 ;
+3 SET HLOC=""
HLO SET HLOC=$ORDER(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE,HLOC))
+1 IF HLOC=""
GOTO DATE
+2 SET VIEN=""
+3 FOR
SET VIEN=$ORDER(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE,HLOC,VIEN))
if VIEN=""
QUIT
Begin DoDot:1
+4 SET ^TMP(PXRRXTMP,$JOB,"PXRRLOC",HLOC,VIEN)=""
End DoDot:1
+5 ;
+6 GOTO HLO
+7 ;
TOTAL ;Total up the encounters.
+1 SET NLOCLIST=0
+2 SET CMAX=0
+3 SET HLOC=""
NLOC SET HLOC=$ORDER(^TMP(PXRRXTMP,$JOB,"PXRRLOC",HLOC))
+1 IF HLOC=""
GOTO OUTPUT
+2 SET TEMP=$$LOCCNT^PXRRLCHP(HLOC)
+3 SET CMAX=$$MAX^XLFMTH(CMAX,TEMP)
+4 SET LOCLIST(HLOC)=TEMP
+5 SET NLOCLIST=NLOCLIST+1
+6 GOTO NLOC
+7 ;
OUTPUT ;Print the data.
+1 SET HEAD=1
+2 SET C3E=MID+($LENGTH(CMAX)/2)
+3 SET HLOC=""
NEXTP SET HLOC=$ORDER(LOCLIST(HLOC))
+1 IF HLOC=""
SET GTOTAL=GTOTAL+FTOTAL
GOTO FINAL
+2 SET TEMP=LOCLIST(HLOC)
+3 SET FTOTAL=FTOTAL+TEMP
+4 DO HEAD
+5 IF DONE
GOTO EXIT
+6 SET C3S=C3E-$LENGTH(TEMP)
+7 SET LOCNAME=$PIECE(HLOC,U,1)
+8 SET SC="("_$PIECE(HLOC,U,3)_")"
+9 WRITE !,?INDENT,LOCNAME,?C2S,SC,?C3S,TEMP
+10 GOTO NEXTP
+11 ;
FINAL ;Print facility total.
+1 IF $Y>(IOSL-BMARG-3)
DO PAGE^PXRRGPRT
+2 IF DONE
GOTO EXIT
+3 DO PTOTAL^PXRRGPRT("Total facility encounters ",FTOTAL,C3E,1)
+4 GOTO FAC
END ;
+1 IF $Y>(IOSL-BMARG-3)
DO PAGE^PXRRGPRT
+2 IF DONE
GOTO EXIT
+3 IF GTOTAL>0
DO PTOTAL^PXRRGPRT("Total encounters ",GTOTAL,C3E,0)
+4 IF $Y>(IOSL-BMARG-3)
DO PAGE^PXRRGPRT
+5 IF DONE
GOTO EXIT
+6 DO FACNE^PXRRGPRT(INDENT)
EXIT ;
+1 DO EXIT^PXRRGUT
+2 DO EOR^PXRRGUT
+3 QUIT
+4 ;
+5 ;=======================================================================
HEAD ;If necessary, write the header.
+1 IF HEAD
Begin DoDot:1
+2 IF $Y>(IOSL-BMARG-6)
DO PAGE^PXRRGPRT
+3 IF DONE
QUIT
+4 WRITE !!,"Facility: ",FACPNAME
+5 WRITE !!,?INDENT,"Clinic Stop (Stop Code)",?C3HS,"Encounters"
+6 WRITE !,?INDENT,"------------------------------------",?C3HS,"----------"
+7 SET HEAD=0
End DoDot:1
+8 QUIT
+9 ;
