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

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1DGRUGIX1 ;ALB/MLI - REPORT FOR RUG-II INDEX ; 9 FEB 88
2 ;;5.3;Registration;**89,97,173**;Aug 13, 1993
3HEAD D:$D(DG1) TRAIL S DGPG=DGPG+1 W:DGPG>1!($E(IOST,1,2)="C-") @IOF
4 W !?57,"RUG-II INDEX REPORT",?122,"PAGE: ",$J(DGPG,4),! W:DGX="AC" ?53 W:DGX="AA" ?57 W $S(DGX="AC":"BY ADMISSION/TRANSFER DATE",1:"BY ASSESSMENT DATE"),!?56,DGSRT,"-",DGEND,!?55,"RUN ON: ",DGNOW
5 W !!,?18,"RUG",?73,"ASSESSMENT",!,"LOCATION",?18,"GROUP",?25,"PATIENT NAME",?51,"SSN",?63,"DOB",?73,"DATE/PURPOSE",?87,"A/T DATE",?97,"CURRENT STATUS",?114,"CATEGORY",?128,"WWU" W ! K Y S $P(Y,"-",133)="" W Y,!!,$E($P(DGWD,U),1,15)
6 S DGNEW=1,DG1="" Q
71 D:(DGH'=DGWD)!($Y>(IOSL-8)) HEAD S DGI=^UTILITY($J,"I",DGWD,DGG,DFN,D) S:DGX="AA" DGAD=D,DGTD=$P(DGI,U,3) S:DGX="AC" DGTD=D,DGAD=$P(DGI,U,3) S DGN=$P(DGI,U),DGS=$P(DGI,U,2),DGP=$P(DGI,U,4),DGB=$P(DGI,U,5),DGC=$P(DGI,U,6)
8 S ^("TOT")=^UTILITY($J,"TOT")+1,^(DGG)=^("TOT",DGG)+1,^(DGWD)=^UTILITY($J,"W",DGWD)+1,^(DGG)=^(DGWD,DGG)+1
9 W:'DGNEW ! W ?18,"RUG"_DGG,?25,$E(DGN,1,20),?47,DGS,?61,$$FMTE^XLFDT(DGB,"5DZ"),?73 S X=DGAD D DT W ?82,$S(DGP=1:"A/T",DGP=2:"S-A",DGP=3:"CNH"),?87 S X=DGTD D DT W ?97 D INP^VADPT
10 W $S('+VAIN(4):"DISCHARGED",VAIN(6)']""!+VAIN(6):$E($P(VAIN(4),U,2),1,15),1:"**"_$E($P(VAIN(4),U,2),1,13))
11 W ?114,$S(DGC=1:"HEAVY REHAB",DGC=2:"SPECIAL CARE",DGC=3:"CLIN COMPLEX",DGC=4:"BEHAVIORAL",1:"PHYSICAL") D FY
12 S DGNEW=0,DGH=DGWD Q
13 Q
14DT W $$FMTE^XLFDT(X,"2DZ") Q
15TRAIL F I=$Y:1:(IOSL-8) W !
16 W !?74,"CURRENT STATUS:",?109,"** = Absent from ward",!?70,"ASSESSMENT PURPOSE:",?108,"S-A = Semi-annual census",!,?108,"A/T = Admission/transfer"
17 W !,?108,"CNH = Contract Nursing Home"
18 Q
19FY K DGWWU S DGYR=$E(DGAD,1,3)_"0000" S:$E(DGAD,4,5)>9 DGYR=DGYR+10000 I $D(^DG(45.91,DGG,"FY",DGYR,0)) S DGWWU=$P(^(0),U,2)
20 W ?128,$S($D(DGWWU):DGWWU,1:"N/A")
21 Q
22H K DG1 D:DGWD>0 TRAIL
23 S DGPG=DGPG+1 W @IOF,!,?16,"HISTOGRAM FOR"
24 W $S(DGWD'="":": "_DGWD,1:" ALL LOCATIONS"),?109,"PAGE:",$J(DGPG,4),!?16,"FOR PERIOD COVERING: ",DGSRT,"-",DGEND,?97,"RUN ON: ",DGNOW
25 W !!,?50,"PERCENTAGE OF PATIENTS IN GROUP",!! F I=1:1:9 W ?(I*10+16),I
26 W ! F I=1:1:9 W ?(I*10+16),"0"
27 K Y S $P(Y,"-",103)="" W !?16,Y I DGWD'="" S DGTOT=^UTILITY($J,"W",DGWD) F R=1:1:17 S DGSUM=^UTILITY($J,"W",DGWD,R),DGPER=DGSUM*100\DGTOT D PRINT
28 I DGWD="" S DGTOT=^UTILITY($J,"TOT") F R=1:1:17 S DGSUM=^UTILITY($J,"TOT",R),DGPER=DGSUM*100\DGTOT D PRINT
29 K Y S $P(Y,"-",103)="" W !?16,Y K DGCH,DGPER,DGSUM,DGTOT,Q Q
30PRINT F Q=1:1:3 K Y S DGCH=$S(Q'=2:"=",1:"*"),$P(Y,DGCH,DGPER+1)="" W ! W:Q'=2 ?16,"|",Y W:Q=2 ?9,"RUG "_$J(R,2),?16,"|",Y," ",$J(DGSUM*100/DGTOT,7,2),"%" W ?117,"|"
31 Q
32DATE S DGSRT=DGSD+.1,DGEND=DGED-.9,DGSRT=$$FMTE^XLFDT(DGSRT,"5DZ"),DGEND=$$FMTE^XLFDT(DGEND,"5DZ"),%DT="R",X="N" D ^%DT
33 S DGNOW=Y,DGNOW=$$FMTE^XLFDT(DGNOW,"5Z") Q
Note: See TracBrowser for help on using the repository browser.