source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMBMR3.m@ 1306

Last change on this file since 1306 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1SDAMBMR3 ;ALB/MLI - AMBULATORY PROCEDURE MANAGEMENT REPORTS ; 24 MAR 88 07700
2 ;;5.3;Scheduling;**132**;Aug 13, 1993
3P S SDPRC=SDPRC(0)+SDPRC(1) I $D(I) S ^TMP($J,I,"PR")=^TMP($J,I,"PR",0)+^(1)
4 Q:SDFG I $E(IOST,1,2)="C-" R !?20,"Enter <RETURN> to continue",SDFG1:DTIME I SDFG1["^"!'$T S SDFG=1 Q
5 D HD^SDAMBMR2 W !!!,?67,"*TOTAL UNIQUE",!,?24,"VETERAN",?38,"NON-VETERAN",?57,"TOTAL",?72,"SSNS"
6 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)
7 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"
8 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)
9 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"
10 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"
11 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)
12 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)
13 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)
14 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
15INIT 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
16 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
17 I SDSC="S",SDAS F I="R","M","S","P","N","U","Z" D I
18 I SDSC="C",'VAUTC S I=0 F I1=0:0 S I=$O(VAUTC(I)) Q:I="" D I
19 I SDSC="S",'SDAS S I=0 F I1=0:0 S I=$O(SDS(I)) Q:I="" D I
20 Q
21I 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
Note: See TracBrowser for help on using the repository browser.