SDAMBMR3 ;ALB/MLI - AMBULATORY PROCEDURE MANAGEMENT REPORTS ; 24 MAR 88 07700
;;5.3;Scheduling;**132**;Aug 13, 1993
P S SDPRC=SDPRC(0)+SDPRC(1) I $D(I) S ^TMP($J,I,"PR")=^TMP($J,I,"PR",0)+^(1)
Q:SDFG I $E(IOST,1,2)="C-" R !?20,"Enter <RETURN> to continue",SDFG1:DTIME I SDFG1["^"!'$T S SDFG=1 Q
D HD^SDAMBMR2 W !!!,?67,"*TOTAL UNIQUE",!,?24,"VETERAN",?38,"NON-VETERAN",?57,"TOTAL",?72,"SSNS"
W !!,"# OF PROCEDURES",?25,$J($S(SDFL:^TMP($J,I,"PR",1),1:SDPRC(1)),6),?41,$J($S(SDFL:^TMP($J,I,"PR",0),1:SDPRC(0)),6)
W ?56,$J($S(SDFL:^TMP($J,I,"PR"),1:SDPRC),6),?73,"N/A",!!,"# OF STOPS",?25,$J($S(SDFL:^TMP($J,I,"ST",1),1:SDSTP(1)),6),?41,$J($S(SDFL:^TMP($J,I,"ST",0),1:SDSTP(0)),6),?56,$J($S(SDFL:^TMP($J,I,"ST"),1:SDSTP),6),?73,"N/A"
W:'SDFL !!,"# OF VISITS",?25,$J(SDVST(1),6),?41,$J(SDVST(0),6),?56,$J(SDVST,6),?73,"N/A" W !!,"# OF PATIENTS",?25,$J($S(SDFL:^("T",1),1:SDTOT(1)),6) ;NAKED REFERENCE - ^TMP($J,Clinic Name,"T",1)
W ?41,$J($S(SDFL:^TMP($J,I,"T",0),1:SDTOT(0)),6),?56,$J($S(SDFL:^(0)+^(1),1:SDTOT(0)+SDTOT(1)),6),?70,$J($S(SDFL:^TMP($J,I,"T"),1:SDTOT),6),!!,"# OF MALE PATIENTS"
W ?25,$J($S(SDFL:^TMP($J,I,"SM",1),1:SDSXM(1)),6),?41,$J($S(SDFL:^(0),1:SDSXM(0)),6),?56,$J($S(SDFL:^(0)+^(1),1:SDSXM(0)+SDSXM(1)),6),?70,$J($S(SDFL:^TMP($J,I,"SM"),1:SDSXM),6),!!,"# OF FEMALE PATIENTS"
W ?25,$J($S(SDFL:^TMP($J,I,"SF",1),1:SDSXF(1)),6),?41,$J($S(SDFL:^(0),1:SDSXF(0)),6),?56,$J($S(SDFL:^(0)+^(1),1:SDSXF(0)+SDSXF(1)),6),?70,$J($S(SDFL:^TMP($J,I,"SF"),1:SDSXF),6)
I SDFL S SDAGEH=^TMP($J,I,"A")\^("T"),SDAGEH(0)=$S(^("A",0):^(0)\^TMP($J,I,"T",0),1:0),SDAGEH(1)=$S(^TMP($J,I,"A",1):^(1)\^TMP($J,I,"T",1),1:0),SDAGET=^TMP($J,I,"A",0)+^(1),SDTT=^TMP($J,I,"T",0)+^(1)
I 'SDFL S SDAGEH=SDAGE\SDTOT,SDAGEH(0)=$S(SDAGE(0):SDAGE(0)\SDTOT(0),1:0),SDAGEH(1)=$S(SDAGE(1):SDAGE(1)\SDTOT(1),1:0),SDAGET=SDAGE(0)+SDAGE(1),SDTT=SDTOT(0)+SDTOT(1)
S SDAGETT=SDAGET\SDTT W !!,"AVERAGE AGE",?28,$J(SDAGEH(1),3),?44,$J(SDAGEH(0),3),?59,$J(SDAGETT,3),?73,$J(SDAGEH,3) Q
INIT S (SDTOT,SDTOT(0),SDTOT(1),SDAGE,SDAGE(1),SDAGE(0),SDPG,SDPRC(0),SDPRC(1),SDVST,SDVST(0),SDVST(1),SDSTP,SDSTP(0),SDSTP(1),SDSXM,SDSXM(0),SDSXM(1),SDSXF,SDSXF(0),SDSXF(1))=0
I SDSC="C",VAUTC F J=0:0 S J=$O(^SC(J)) Q:'J I $D(^(J,0)),($P(^(0),U,3)="C") S I=$P(^(0),U) D I
I SDSC="S",SDAS F I="R","M","S","P","N","U","Z" D I
I SDSC="C",'VAUTC S I=0 F I1=0:0 S I=$O(VAUTC(I)) Q:I="" D I
I SDSC="S",'SDAS S I=0 F I1=0:0 S I=$O(SDS(I)) Q:I="" D I
Q
I S (^TMP($J,I,"T"),^("T",0),^(1),^TMP($J,I,"A"),^("A",0),^(1),^TMP($J,I,"ST"),^("ST",0),^(1),^TMP($J,I,"PR",0),^(1),^TMP($J,I,"SM"),^("SM",0),^(1),^TMP($J,I,"SF"),^("SF",0),^(1))=0 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMBMR3 2628 printed Apr 09, 2024@21:47:10 Page 2
SDAMBMR3 ;ALB/MLI - AMBULATORY PROCEDURE MANAGEMENT REPORTS ; 24 MAR 88 07700
+1 ;;5.3;Scheduling;**132**;Aug 13, 1993
P SET SDPRC=SDPRC(0)+SDPRC(1)
IF $DATA(I)
SET ^TMP($JOB,I,"PR")=^TMP($JOB,I,"PR",0)+^(1)
+1 if SDFG
QUIT
IF $EXTRACT(IOST,1,2)="C-"
READ !?20,"Enter <RETURN> to continue",SDFG1:DTIME
IF SDFG1["^"!'$TEST
SET SDFG=1
QUIT
+2 DO HD^SDAMBMR2
WRITE !!!,?67,"*TOTAL UNIQUE",!,?24,"VETERAN",?38,"NON-VETERAN",?57,"TOTAL",?72,"SSNS"
+3 WRITE !!,"# OF PROCEDURES",?25,$JUSTIFY($SELECT(SDFL:^TMP($JOB,I,"PR",1),1:SDPRC(1)),6),?41,$JUSTIFY($SELECT(SDFL:^TMP($JOB,I,"PR",0),1:SDPRC(0)),6)
+4 WRITE ?56,$JUSTIFY($SELECT(SDFL:^TMP($JOB,I,"PR"),1:SDPRC),6),?73,"N/A",!!,"# OF STOPS",?25,$JUSTIFY($SELECT(SDFL:^TMP($JOB,I,"ST",1),1:SDSTP(1)),6),?41,$JUSTIFY(...
... $SELECT(SDFL:^TMP($JOB,I,"ST",0),1:SDSTP(0)),6),?56,$JUSTIFY($SELECT(SDFL:^TMP($JOB,I,"ST"),1:SDSTP),6),?73,"N/A"
+5 ;NAKED REFERENCE - ^TMP($J,Clinic Name,"T",1)
if 'SDFL
WRITE !!,"# OF VISITS",?25,$JUSTIFY(SDVST(1),6),?41,$JUSTIFY(SDVST(0),6),?56,$JUSTIFY(SDVST,6),?73,"N/A"
WRITE !!,"# OF PATIENTS",?25,$JUSTIFY($SELECT(SDFL:^("T",1),1:SDTOT(1)),6)
+6 WRITE ?41,$JUSTIFY($SELECT(SDFL:^TMP($JOB,I,"T",0),1:SDTOT(0)),6),?56,$JUSTIFY($SELECT(SDFL:^(0)+^(1),1:SDTOT(0)+SDTOT(1)),6),?70,$JUSTIFY($SELECT(SDFL:^TMP($JOB,I,"T"),1:SDTOT),6),!!,"# OF MALE PATIENTS"
+7 WRITE ?25,$JUSTIFY($SELECT(SDFL:^TMP($JOB,I,"SM",1),1:SDSXM(1)),6),?41,$JUSTIFY($SELECT(SDFL:^(0),1:SDSXM(0)),6),?56,$JUSTIFY($SELECT(SDFL:^(0)+^(1),1:SDSXM(0)+SDSXM(1)),6),?70,$JUSTIFY($SELECT(SDFL:^TMP(...
... $JOB,I,"SM"),1:SDSXM),6),!!,"# OF FEMALE PATIENTS"
+8 WRITE ?25,$JUSTIFY($SELECT(SDFL:^TMP($JOB,I,"SF",1),1:SDSXF(1)),6),?41,$JUSTIFY($SELECT(SDFL:^(0),1:SDSXF(0)),6),?56,$JUSTIFY($SELECT(SDFL:^(0)+^(1),1:SDSXF(0)+SDSXF(1)),6),?70,$JUSTIFY($SELECT(SDFL:^TMP($JOB,I,"SF"),1:SDSXF),6)
+9 IF SDFL
SET SDAGEH=^TMP($JOB,I,"A")\^("T")
SET SDAGEH(0)=$SELECT(^("A",0):^(0)\^TMP($JOB,I,"T",0),1:0)
SET SDAGEH(1)=$SELECT(^TMP($JOB,I,"A",1):^(1)\^TMP($JOB,I,"T",1),1:0)
SET SDAGET=^TMP($JOB,I,"A",0)+^(1)
SET SDTT=^TMP($JOB,I,"T",0)+^(1)
+10 IF 'SDFL
SET SDAGEH=SDAGE\SDTOT
SET SDAGEH(0)=$SELECT(SDAGE(0):SDAGE(0)\SDTOT(0),1:0)
SET SDAGEH(1)=$SELECT(SDAGE(1):SDAGE(1)\SDTOT(1),1:0)
SET SDAGET=SDAGE(0)+SDAGE(1)
SET SDTT=SDTOT(0)+SDTOT(1)
+11 SET SDAGETT=SDAGET\SDTT
WRITE !!,"AVERAGE AGE",?28,$JUSTIFY(SDAGEH(1),3),?44,$JUSTIFY(SDAGEH(0),3),?59,$JUSTIFY(SDAGETT,3),?73,$JUSTIFY(SDAGEH,3)
QUIT
INIT SET (SDTOT,SDTOT(0),SDTOT(1),SDAGE,SDAGE(1),SDAGE(0),SDPG,SDPRC(0),SDPRC(1),SDVST,SDVST(0),SDVST(1),SDSTP,SDSTP(0),SDSTP(1),SDSXM,SDSXM(0),SDSXM(1),SDSXF,SDSXF(0),SDSXF(1))=0
+1 IF SDSC="C"
IF VAUTC
FOR J=0:0
SET J=$ORDER(^SC(J))
if 'J
QUIT
IF $DATA(^(J,0))
IF ($PIECE(^(0),U,3)="C")
SET I=$PIECE(^(0),U)
DO I
+2 IF SDSC="S"
IF SDAS
FOR I="R","M","S","P","N","U","Z"
DO I
+3 IF SDSC="C"
IF 'VAUTC
SET I=0
FOR I1=0:0
SET I=$ORDER(VAUTC(I))
if I=""
QUIT
DO I
+4 IF SDSC="S"
IF 'SDAS
SET I=0
FOR I1=0:0
SET I=$ORDER(SDS(I))
if I=""
QUIT
DO I
+5 QUIT
I SET (^TMP($JOB,I,"T"),^("T",0),^(1),^TMP($JOB,I,"A"),^("A",0),^(1),^TMP($JOB,I,"ST"),^("ST",0),^(1),^TMP($JOB,I,"PR",0),^(1),^TMP($JOB,I,"SM"),^("SM",0),^(1),^TMP($JOB,I,"SF"),^("SF",0),^(1))=0
QUIT
