source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGDISS.m@ 789

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1DGDISS ;ALB/JDS - DISPOSITION SUMMARY ; 26 AUG 84 14:14
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4 D LO^DGUTL
5SD R !,"START DATE: ",X:DTIME G Q:X=""!(X["^") S %DT="XPE",%DT(0)=-DT D ^%DT G SD:Y'>0 S SD=+Y
6AN G ED:+$E(SD,6,7)'=1 S %=1 W !!,"Run statistics for the whole month" D YN^DICN G MON:%=1,ED:%=2,Q:%=-1
7 W !?4,"YES - To generate a log for this entire month",!?4,"NO - To select an end date to which to generate log." G AN
8ED R !,"END DATE: ",X:DTIME G Q:X=""!(X["^") S %DT="XE" D ^%DT G ED:Y'>0 S ED=+Y I ED<SD W !?4,*7,"Can't preceed start date." G ED
9OU S DGPGM="START^DGDISS",DGVAR="SD^ED" W ! D ZIS^DGUTQ G Q:POP
10START U IO S S=SD-.00001,ED=ED+.25 K DIS
11S S S=$O(^DPT("ADIS",S)) G DON:'S!(S>ED) S S1=0
12S1 S S1=$O(^DPT("ADIS",S,S1)) G S:'S1 S S2=0
13S2 S S2=$O(^DPT("ADIS",S,S1,S2)) G S1:'S2,S2:'$D(^DPT(S1,"DIS",S2,0)) S L=^(0),S3=$O(^DPT(S1,"DIS",S2)),L1="" I S3>0 S L1=^(S3,0)
14 S SITE=+$P(L,"^",4),DIST=+$P(L,"^",7),ST=$P(L,U,2),SITE=$S(SITE>0:SITE,1:$S($D(^DD("SITE",1)):^(1),1:0)),DIS(SITE,DIST,+ST)=$S($D(DIS(SITE,DIST,+ST)):DIS(SITE,DIST,+ST),1:0)+1 G S2
15 ;
16DON S (SITE,PG)=0,DGX="" F II=0:0 S SITE=$O(DIS(SITE)) Q:'SITE!(DGX["^") D PRINT
17Q K %DT,D,DTD,DIS,I,I1,PG,POP,ST,T1,Z,T,TOT,S,S1,S2,S3,L,L1,L2,L3,ED,SD,SITE,DIST,STAT,X,Y D CLOSE^DGUTQ Q
18 ;
19PRINT ;
20 D HD Q:DGX["^" S S=0 F S1=0:1:2 S TOT(S1)=0,T(S1)=0
21P1 S S=$O(^DIC(37,S)) D HD:($Y+4)>IOSL Q:DGX["^" G TOT:'S W !,$S($D(^DIC(37,S,0)):$E($P(^(0),"^",1),1,30),S=0:"NOT DISPOSITIONED YET",1:"UNDEFINED DISPOSITION "_S),?30
22 F T=-1:0 S T=$O(DIS(SITE,S,T)) Q:T="" S T1=DIS(SITE,S,T),T(T)=T1,TOT(T)=TOT(T)+T1
23 S T=0 F S1=0:1:2 W ?(S1*13+30),$J(T(S1),6) S T=T+T(S1),T(S1)=0
24 W $J(T,13) G P1
25TOT W ! F I=1:1:80 W "="
26 W !!,"TOTAL" S TOT=0 F S1=0:1:2 W ?(S1*13+30),$J(TOT(S1),6) S TOT=TOT+TOT(S1)
27 W $J(TOT,13),! Q
28 ;
29D S %=$E(Y,4,5)*3,Y=$E("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",%-2,%)_" "_$S($E(Y,6,7):$J(+$E(Y,6,7),2)_", ",1:"")_($E(Y,1,3)+1700)_$S(Y[".":" "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),1:"") Q
30 ;
31MON S X1=SD,X2=+33 D C^%DTC S X1=$E(X,1,5)_"01",X2=-1 D C^%DTC S ED=X G OU
32 Q
33 ;
34HD D CRCHK Q:DGX["^" W @IOF W !?20,"REGISTRATION DISPOSITION SUMMARY",!?25,"for ",$S(SITE=0!('$D(^DG(40.8,SITE,0))):^DD("SITE",1),1:$P(^DG(40.8,SITE,0),"^",1)),!?20,"for " S Y=SD D D W Y," to " S Y=ED\1 D D W Y
35 K %DT S X="N",%DT="TN" D ^%DT S DTD=+Y W !,?25," run " S Y=DTD D D W Y,?70,"PAGE: ",PG+1 S PG=PG+1
36 W !!?31,"10-10",?38,"UNSCHEDULED",?52,"APPLICATIONS",!,"DISPOSITION",?30,"VISITS",?43,"VISITS",?54,"W/O EXAM",?70,"TOTAL",! F I=1:1:80 W "="
37 Q
38 ;
39CRCHK I PG,$E(IOST,1)="C" W !!,*7,"Press RETURN to continue or '^' to stop " R X:DTIME S:'$T X="^" S DGX=X
40 Q
Note: See TracBrowser for help on using the repository browser.