- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUGIX1 2778 printed Feb 19, 2025@00:24:28 Page 2
- DGRUGIX1 ;ALB/MLI - REPORT FOR RUG-II INDEX ; 9 FEB 88
- +1 ;;5.3;Registration;**89,97,173**;Aug 13, 1993
- HEAD if $DATA(DG1)
- DO TRAIL
- SET DGPG=DGPG+1
- if DGPG>1!($EXTRACT(IOST,1,2)="C-")
- WRITE @IOF
- +1 WRITE !?57,"RUG-II INDEX REPORT",?122,"PAGE: ",$JUSTIFY(DGPG,4),!
- if DGX="AC"
- WRITE ?53
- if DGX="AA"
- WRITE ?57
- WRITE $SELECT(DGX="AC":"BY ADMISSION/TRANSFER DATE",1:"BY ASSESSMENT DATE"),!?56,DGSRT,"-",DGEND,!?55,"RUN ON: ",DGNOW
- +2 WRITE !!,?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"
- WRITE !
- KILL Y
- SET $PIECE(Y,"-",133)=""
- WRITE Y,!!,$EXTRACT($PIECE(DGWD,U),1,15)
- +3 SET DGNEW=1
- SET DG1=""
- QUIT
- 1 if (DGH'=DGWD)!($Y>(IOSL-8))
- DO HEAD
- SET DGI=^UTILITY($JOB,"I",DGWD,DGG,DFN,D)
- if DGX="AA"
- SET DGAD=D
- SET DGTD=$PIECE(DGI,U,3)
- if DGX="AC"
- SET DGTD=D
- SET DGAD=$PIECE(DGI,U,3)
- SET DGN=$PIECE(DGI,U)
- SET DGS=$PIECE(DGI,U,2)
- SET DGP=$PIECE(DGI,U,4)
- SET DGB=$PIECE(DGI,U,5)
- SET DGC=$PIECE(DGI,U,6)
- +1 SET ^("TOT")=^UTILITY($JOB,"TOT")+1
- SET ^(DGG)=^("TOT",DGG)+1
- SET ^(DGWD)=^UTILITY($JOB,"W",DGWD)+1
- SET ^(DGG)=^(DGWD,DGG)+1
- +2 if 'DGNEW
- WRITE !
- WRITE ?18,"RUG"_DGG,?25,$EXTRACT(DGN,1,20),?47,DGS,?61,$$FMTE^XLFDT(DGB,"5DZ"),?73
- SET X=DGAD
- DO DT
- WRITE ?82,$SELECT(DGP=1:"A/T",DGP=2:"S-A",DGP=3:"CNH"),?87
- SET X=DGTD
- DO DT
- WRITE ?97
- DO INP^VADPT
- +3 WRITE $SELECT('+VAIN(4):"DISCHARGED",VAIN(6)']""!+VAIN(6):$EXTRACT($PIECE(VAIN(4),U,2),1,15),1:"**"_$EXTRACT($PIECE(VAIN(4),U,2),1,13))
- +4 WRITE ?114,$SELECT(DGC=1:"HEAVY REHAB",DGC=2:"SPECIAL CARE",DGC=3:"CLIN COMPLEX",DGC=4:"BEHAVIORAL",1:"PHYSICAL")
- DO FY
- +5 SET DGNEW=0
- SET DGH=DGWD
- QUIT
- +6 QUIT
- DT WRITE $$FMTE^XLFDT(X,"2DZ")
- QUIT
- TRAIL FOR I=$Y:1:(IOSL-8)
- WRITE !
- +1 WRITE !?74,"CURRENT STATUS:",?109,"** = Absent from ward",!?70,"ASSESSMENT PURPOSE:",?108,"S-A = Semi-annual census",!,?108,"A/T = Admission/transfer"
- +2 WRITE !,?108,"CNH = Contract Nursing Home"
- +3 QUIT
- FY KILL DGWWU
- SET DGYR=$EXTRACT(DGAD,1,3)_"0000"
- if $EXTRACT(DGAD,4,5)>9
- SET DGYR=DGYR+10000
- IF $DATA(^DG(45.91,DGG,"FY",DGYR,0))
- SET DGWWU=$PIECE(^(0),U,2)
- +1 WRITE ?128,$SELECT($DATA(DGWWU):DGWWU,1:"N/A")
- +2 QUIT
- H KILL DG1
- if DGWD>0
- DO TRAIL
- +1 SET DGPG=DGPG+1
- WRITE @IOF,!,?16,"HISTOGRAM FOR"
- +2 WRITE $SELECT(DGWD'="":": "_DGWD,1:" ALL LOCATIONS"),?109,"PAGE:",$JUSTIFY(DGPG,4),!?16,"FOR PERIOD COVERING: ",DGSRT,"-",DGEND,?97,"RUN ON: ",DGNOW
- +3 WRITE !!,?50,"PERCENTAGE OF PATIENTS IN GROUP",!!
- FOR I=1:1:9
- WRITE ?(I*10+16),I
- +4 WRITE !
- FOR I=1:1:9
- WRITE ?(I*10+16),"0"
- +5 KILL Y
- SET $PIECE(Y,"-",103)=""
- WRITE !?16,Y
- IF DGWD'=""
- SET DGTOT=^UTILITY($JOB,"W",DGWD)
- FOR R=1:1:17
- SET DGSUM=^UTILITY($JOB,"W",DGWD,R)
- SET DGPER=DGSUM*100\DGTOT
- DO PRINT
- +6 IF DGWD=""
- SET DGTOT=^UTILITY($JOB,"TOT")
- FOR R=1:1:17
- SET DGSUM=^UTILITY($JOB,"TOT",R)
- SET DGPER=DGSUM*100\DGTOT
- DO PRINT
- +7 KILL Y
- SET $PIECE(Y,"-",103)=""
- WRITE !?16,Y
- KILL DGCH,DGPER,DGSUM,DGTOT,Q
- QUIT
- PRINT FOR Q=1:1:3
- KILL Y
- SET DGCH=$SELECT(Q'=2:"=",1:"*")
- SET $PIECE(Y,DGCH,DGPER+1)=""
- WRITE !
- if Q'=2
- WRITE ?16,"|",Y
- if Q=2
- WRITE ?9,"RUG "_$JUSTIFY(R,2),?16,"|",Y," ",$JUSTIFY(DGSUM*100/DGTOT,7,2),"%"
- WRITE ?117,"|"
- +1 QUIT
- DATE SET DGSRT=DGSD+.1
- SET DGEND=DGED-.9
- SET DGSRT=$$FMTE^XLFDT(DGSRT,"5DZ")
- SET DGEND=$$FMTE^XLFDT(DGEND,"5DZ")
- SET %DT="R"
- SET X="N"
- DO ^%DT
- +1 SET DGNOW=Y
- SET DGNOW=$$FMTE^XLFDT(DGNOW,"5Z")
- QUIT