source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRLCNT2.m@ 738

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

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1IMRLCNT2 ;ISC-SF/JLI-LOCAL COUNT OF PTS, STATUS, OP VISITS, IP STAYS, ETC. CONTINUED (PRINT) ;9/2/97 14:10
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**6**;Feb 09, 1998
3 S (IMRPG,IMRUT)=0
4 F IMR0C=0:1:4,"T" Q:IMRUT S IMRLBL=$S(+IMR0C=IMR0C:$P("NO CATEGORY DEFINED^HIV+^HIV+ (CD4<500)^AIDS-3^AIDS","^",IMR0C+1),1:"TOTAL HIV+ (ALL CATEGORIES) POPULATION"),IMR1C="C"_IMR0C D OPPRNT Q:IMRUT D IPPRNT^IMRLCNT3
5 Q
6 ;
7OPPRNT ;
8 S IMRD="FOR THE PERIOD "_$E(IMRSD,4,5)_"/"_$E(IMRSD,6,7)_"/"_$E(IMRSD,2,3)_" TO "_$E(IMRED,4,5)_"/"_$E(IMRED,6,7)_"/"_$E(IMRED,2,3)
9 D GETNOW^IMRACESS
10 Q:'$D(^TMP($J,IMR1C,"OP")) S IMRX="SELECTED OUTPATIENT ACTIVITY" D HEDR
11 W !!,"A 'stop' is credited for each entry of a stop code, while a 'visit' is split",!,"among each stop credited on a given date. Thus, a single visit with two stop",!,"codes credited will show as 0.5 visit for each stop code. "
12 W "A total of 1.00",!,"visit is given for out patient activity on a given date.",!!
13 W !!,"Totals: " S X=^TMP($J,IMR1C,"S"),Y=^("S","VIS") W X," patients for ",Y," visits (",^TMP($J,IMR1C,"OP","VIS")," stops)",!
14 F I=0:0 S I=$O(^TMP($J,IMR1C,"VI",I)) Q:I'>0!(IMRUT) D
15 .I ($Y+4)>IOSL D PRTC Q:IMRUT D HEDR
16 .S X=+^TMP($J,IMR1C,"VI",I),Y=$P(^(I),U,2) W !?10,$J(X,4)," patient",$S(X>1:"s",1:""),?25,$J(Y,4)," visit",$S(Y>1:"s",1:"")
17 .Q
18 Q:IMRUT D PRTC Q:IMRUT D HEDR S X1="NOT IDENTIFIED"
19 F I=-1:0 S I=$O(^TMP($J,IMR1C,"OP",I)) Q:+I'=I!(IMRUT) D
20 .I ($Y+4)>IOSL D PRTC Q:IMRUT D HEDR
21 .S X=^TMP($J,IMR1C,"OP",I),Y=^(I,"VIS"),L=$O(^DIC(40.7,"C",I,0)),Z=$S($D(^TMP($J,IMR1C,"SA",I)):^(I),1:0)
22 .D OPP1
23 .Q
24 Q:IMRUT
25 I $D(^XUSEC("IMRMGR",DUZ)),$D(^TMP($J,IMR1C,"NO SC")) D
26 .D PRTC Q:IMRUT D HEDR
27 .W !!,"OCCURRENCES OF NO STOP CODE ID",!!
28 .F IMRDFN=0:0 S IMRDFN=$O(^TMP($J,IMR1C,"NO SC",IMRDFN)) Q:IMRDFN'>0!(IMRUT) D OPP2
29 .Q
30 Q
31OPP1 W !,$J(I,3),". ",$S(L'>0:X1,'$D(^DIC(40.7,+L,0)):X1,1:$P(^(0),U)),?35,$J(X,3)," patient",$S(X>1:"s",1:" ")," ",$J(Z,8,2)," visit",$S(Y>1:"s",1:" ")," ",$J(Y,4)," stops"
32 Q
33OPP2 S DFN=IMRDFN D NS^IMRCALL
34 F IMRD11=0:0 S IMRD11=$O(^TMP($J,IMR1C,"NO SC",IMRDFN,IMRD11)) Q:IMRD11'>0!(IMRUT) D
35 .I ($Y+4)>IOSL D PRTC Q:IMRUT D HEDR W !!,"OCCURRENCES OF NO STOP CODE ID",!!
36 .W !,$E(IMRNAM,1,25),?27,IMRSSN," ",$E(IMRD11,4,5),"/",$E(IMRD11,6,7),"/",$E(IMRD11,2,3)," ",$S($D(^TMP($J,IMR1C,"NO SC",IMRDFN,IMRD11,1)):"ADD/EDIT STOP CODE",1:"SCHEDULED VISIT")
37 .Q
38 K VA,VADM,DFN,IMRD11
39 Q
40 ;
41PRTC ; press return to continue
42 Q:$E(IOST)'="C"!(IMRUT)!($D(IO("S")))
43 K DIR S DIR(0)="E" D ^DIR S:$D(DIRUT)!(Y=0) IMRUT=1
44 Q
45HEDR ;
46 S IMRZ="INPATIENT AND OUTPATIENT ACTIVITY"
47 W:$Y>0 @IOF W:IOST'["C-" !!! W !,?(IOM-$L(IMRZ)\2),IMRZ,!,?(IOM-$L(IMRX)\2),IMRX,!?(IOM-$L(IMRD)\2),IMRD,!?(IOM-$L(IMRLBL)\2),IMRLBL,!?(IOM-$L(IMRDTE)\2),IMRDTE,!! S IMRPG=IMRPG+1
48 Q
49 ;
50HEDRA W ?69,"DIFFERENT",!,"PATIENT NAME",?35,"SSN",?48,"VISITS",?60,"STOPS",?68,"STOP CODES",!
51 Q
52 ;
53HEDRB W "PATIENT NAME",?35,"SSN",?48,"# STAYS",?66,"# DAYS",!
54 Q
55 ;
Note: See TracBrowser for help on using the repository browser.