- 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 Mar 13, 2025@21:52:25 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
