VistA-FOIAVistA/r/REGISTRATION-DGQE-DG-DPT-GR.../DGRUGIX1.m

34 lines
2.7 KiB
Mathematica

DGRUGIX1 ;ALB/MLI - REPORT FOR RUG-II INDEX ; 9 FEB 88
;;5.3;Registration;**89,97,173**;Aug 13, 1993
HEAD D:$D(DG1) TRAIL S DGPG=DGPG+1 W:DGPG>1!($E(IOST,1,2)="C-") @IOF
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
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)
S DGNEW=1,DG1="" Q
1 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)
S ^("TOT")=^UTILITY($J,"TOT")+1,^(DGG)=^("TOT",DGG)+1,^(DGWD)=^UTILITY($J,"W",DGWD)+1,^(DGG)=^(DGWD,DGG)+1
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
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))
W ?114,$S(DGC=1:"HEAVY REHAB",DGC=2:"SPECIAL CARE",DGC=3:"CLIN COMPLEX",DGC=4:"BEHAVIORAL",1:"PHYSICAL") D FY
S DGNEW=0,DGH=DGWD Q
Q
DT W $$FMTE^XLFDT(X,"2DZ") Q
TRAIL F I=$Y:1:(IOSL-8) W !
W !?74,"CURRENT STATUS:",?109,"** = Absent from ward",!?70,"ASSESSMENT PURPOSE:",?108,"S-A = Semi-annual census",!,?108,"A/T = Admission/transfer"
W !,?108,"CNH = Contract Nursing Home"
Q
FY 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)
W ?128,$S($D(DGWWU):DGWWU,1:"N/A")
Q
H K DG1 D:DGWD>0 TRAIL
S DGPG=DGPG+1 W @IOF,!,?16,"HISTOGRAM FOR"
W $S(DGWD'="":": "_DGWD,1:" ALL LOCATIONS"),?109,"PAGE:",$J(DGPG,4),!?16,"FOR PERIOD COVERING: ",DGSRT,"-",DGEND,?97,"RUN ON: ",DGNOW
W !!,?50,"PERCENTAGE OF PATIENTS IN GROUP",!! F I=1:1:9 W ?(I*10+16),I
W ! F I=1:1:9 W ?(I*10+16),"0"
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
I DGWD="" S DGTOT=^UTILITY($J,"TOT") F R=1:1:17 S DGSUM=^UTILITY($J,"TOT",R),DGPER=DGSUM*100\DGTOT D PRINT
K Y S $P(Y,"-",103)="" W !?16,Y K DGCH,DGPER,DGSUM,DGTOT,Q Q
PRINT 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,"|"
Q
DATE S DGSRT=DGSD+.1,DGEND=DGED-.9,DGSRT=$$FMTE^XLFDT(DGSRT,"5DZ"),DGEND=$$FMTE^XLFDT(DGEND,"5DZ"),%DT="R",X="N" D ^%DT
S DGNOW=Y,DGNOW=$$FMTE^XLFDT(DGNOW,"5Z") Q