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

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1DGRUGPP1 ;ALB/BOK/MLI - PRINT PAI FOR A PATIENT ; 25 FEB 87 12:00
2 ;;5.3;Registration;**89,173**;Aug 13, 1993
3 S DIC="^DG(45.9,",DIC(0)="AEQMZ" D ^DIC K DIC G QUIT:Y'>0 S DGPT=+Y
4 W !!,*7,!!,"THIS REPORT REQUIRES 132 COLUMN OUTPUT"
5 S DGPGM="START^DGRUGPP1",DGVAR="DGPT",%ZIS("B")="" D ZIS^DGUTQ G:POP QUIT D START
6 D CLOSE^DGUTQ
7QUIT K %,^UTILITY($J),%DT,%ZIS,DA,DGA,DGA1,DGAD,DGALL,DGCAT,DGED,DGFY,DGG,DGHM,DGI,DGNO,DGNOW,DGPGM,DGPT,DGR,DGS,DGSD,DGT,DGVAR,DGW,DGX,DIC,DIV,E,I,J,K,M,POP,W,X,X1,VAUTD,Y,Z Q
8START U IO S X=132 X ^%ZOSF("RM")
9EN D NOW^DGPTOTRL Q:'$D(^DG(45.9,DGPT)) S DGI=^(DGPT,0),DGG=$S($D(^DG(45.9,DGPT,"R")):^("R"),1:""),DGS=$S($D(^DG(45.9,DGPT,"C")):^("C"),1:"")
10 S DGFY=$S($E($P(DGI,U,2),4,5)<10:($E($P(DGI,U,2),1,3)_"0000"),1:($E($P(DGI,U,2),1,3)+1_"0000"))
11 S Z=$P(DGG,U,4),DGCAT=$S(Z=1:"1 - HEAVY REHABILITATION",Z=2:"2 - SPECIAL CARE",Z=3:"3 - CLINICAL COMPLEX",Z=4:"4 - BEHAVIORAL",Z=5:"5 - PHYSICAL",1:"")
12 Q:'$D(^DPT(+DGI,0))
13 I ($E(IOST)="C")!($D(FIRST)) W @IOF
14 W !?48,">>>>PATIENT ASSESSMENT INSTRUMENT<<<<",!!,"NAME: ",$P(^DPT(+DGI,0),U),?92,"PRINTED: ",DGNOW,!," 1.",$J("SSN: ",32),$P(DGI,U,3)
15 W ?86,$J("RUG-II GROUP: ",15),$P(DGG,U,2),!," 2.",$J("SEX: ",32),$P(DGI,U,4),?86,$J("ADL SUM: ",15),$P(DGG,U,3)
16 W !," 3.",$J("YEAR OF BIRTH: ",32),$P(DGI,U,5),?86,$J("CATEGORY: ",15),DGCAT,!," 4.",$J("ASSESSMENT DATE: ",32),$$FMTE^XLFDT($P(DGI,U,2),"5DZ")
17 W ?86,$J("RUG-II WWUs: ",15) I $P(DGG,U,2) W $S($D(^DG(45.91,+$P(DGG,U,2),"FY",DGFY,0)):$P(^(0),U,2),1:"")
18 W !," 5.",$J("ASSESSMENT PURPOSE: ",32),$S($P(DGI,U,6)=1:"1 ADMISSION/TRANSFER",$P(DGI,U,6)=2:"2 SEMI-ANNUAL CENSUS",1:"3 CONTRACT NURSING HOME")
19 W !," 6.",$J("DATE OF ADMISSION/TRANSFER IN: ",32),$$FMTE^XLFDT($P(DGI,U,7),"5DZ")
20 W ?86,$J("RECORD STATUS: ",15),$S($P(DGS,U)]"":$P(DGS,U),1:"INCOMPLETE")," " W:$P(DGS,U)]"" $P($P(^DD(45.9,80,0),$P(DGS,U)_":",2),";",1)
21 W !," 7.",$J("MEDICAL CENTER CODE: ",32),$P(DGI,U,8),!," 8.",$J("BED SECTION: ",32),$P(DGI,U,9),$S($P(DGI,U,9)="I":"-INTERMEDIATE MED.",$P(DGI,U,9)="N":"-NURSING HOME CARE",1:"")
22 I $P(DGI,"^",6)'=3 W ?86,$J("WARD: ",15) I +DGG,$D(^DIC(42,+DGG,0)) W $P(^(0),U,1)
23 I $P(DGI,"^",6)=3 W ?86,$J("CNH LOCATION: ",15) I +DGG,$D(^FBAAV(+DGG,0)) W $P(^(0),U)
24PRT K Y W !!?24,"MEDICAL TREATMENTS",?91,"SELECTED DIAGNOSIS",! S $P(Y,"-",19)="" W ?24,Y S $P(Y,"-",18)="" W ?91,Y K Y
25 F E=10:1:16 W ! D MT I E<14 S E=E+22 W ?66 D MT S E=E-22
26 W ?87,"ACTIVITIES OF DAILY LIVING" S E=17,$P(Y,"-",27)="" W ! D MT W ?87,Y
27 F E=18:1:21 W ! X:E<21 "D MT W ?66 D ADL" I E=21 S E=-1 D ADL S E=21 W ?66 D ADL
28 W !!?26,"MEDICAL EVENTS",?95,"BEHAVIORS",! K Y S $P(Y,"-",15)="" W ?26,Y K Y S $P(Y,"-",10)="",X1=47 W ?95,Y F E=23:1:28 W ! D MT W ?66 X:E=26 "S E=E+21 D MT S E=E-21" I E<26 S E=E-1 D ADL S E=E+1
29 W !!?56,"SPECIALIZED SERVICES" K Y S $P(Y,"-",21)="" W !?56,Y,!?17,"REHABILITATION MEDICINE THERAPIES",?86,"CHRONIC RESPIRATORY SUPPORT",! S $P(Y,"-",34)="" W ?17,Y K Y S $P(Y,"-",28)="" W ?86,Y
30 S E(2)=51 F E=47:1:51 W ! D LEV^DGRUGPP S E(2)=E(2)+1 W ?66 D:E<50 ADL2 W ! D THER^DGRUGPP S E(2)=E(2)+1 I E<49 W ?66 D ADL2
31 S %=IOSL-6 F I=$Y:1:% W !
32 W !?26,"*QUESTIONS 21,28,29,30,35,36,37 AND 38 ARE RESERVED FIELDS AND ARE NOT DISPLAYED",! Q
33MT W $J(E-1,2),".",$J($P(^DD(45.9,E,0),U),30),": ",$P(DGI,U,E),$S(E'=23&(E'=47):$S($P(DGI,U,E)=1:"> NO",$P(DGI,U,E)=2:"> YES",1:""),$P(DGI,U,E)']"":"",1:"> "_$E($P($P(^DD(45.9,E,0),$P(DGI,U,E)_":",2),";",1),1,24)) Q
34ADL W E+21,".",$J($P(^DD(45.9,(E+22),0),U),30),": " W:$P(DGI,U,(E+22))]"" $E($P($P(^DD(45.9,(E+22),0),$P(DGI,U,(E+22))_":",2),";",1),1,27)
35 Q
36ADL1 W ?66,E+36,".",$J($P(^DD(45.9,(E+32),0),U),30),": " Q:$P(DGI,U,(E+32))']"" W:E>26 $E($P($P(^DD(45.9,(E+32),0),$P(DGI,U,(E+32))_":",2),";",1),1,27) I E=26 W $P(DGI,U,E+32),"> ",$S($P(DGI,U,E+32)=1:"NO",1:"YES")
37 Q
38ADL2 W E(2),".",$J($P(^DD(45.9,(E(2)+6),0),U),30),": " Q:$P(DGI,U,(E(2)+6))']"" W:E>47!(E(2)=53) $E($P($P(^DD(45.9,(E(2)+6),0),$P(DGI,U,(E(2)+6))_":",2),";",1),1,27) I E=47&(E(2)'=53) W $P(DGI,U,E(2)+6),"> ",$S($P(DGI,U,E(2)+6)=1:"NO",1:"YES")
39 Q
Note: See TracBrowser for help on using the repository browser.