source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSDGDEM0.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1YSDGDEM0 ;ALB/ASF,ALB/XAK-Patient Demographic Lookup (cont.) ;4/4/90 08:34 ;08/12/93 15:33
2 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
3 ;
4 ; Called by routine YSDGDEM
5A ;
6 S DFN=YSDFN D IN5^VADPT,INP^VADPT W !!,"Inpatient Status: " I VAIP(1)="" W "Not admitted" G SA
7LOSS ;
8 S (YSADM,YSADM(0),L,YSTRN,YSTRN(0),DIS)=0,YSNOW=$P($H,",",2)\60,YSNOW=YSNOW\60*100+(YSNOW#60)+1/10000+DT
9YSADM ;
10 S YSADM=VAIN(1),YSADMDT=$P(VAIN(7),U) G INP:YSADM'>0 S (YSTRN,YSTRN(0),DIS)=0
11 G YSADM:YSADMDT>YSNOW!(YSADMDT<YSADM(0)) S YSADM(0)=^DGPM(YSADM,0)
12L I VAIN(4)]"" S L=$P(VAIN(4),U)
13YSTRN ;
14 S YSTRN=VAIP(1),YSTRNDT=$P(VAIP(4),U) G YSADM:YSTRN="",YSTRN:YSTRNDT<YSTRN(0)!(YSTRNDT)>YSNOW S YSTRN(0)=^DGPM(YSTRN,0) I VAIP(5)]"" S L=$P(VAIP(5),U)
15INP ;
16 G DIS:'L W "Active",!,"Admitted: ",$P(VAIN(7),U,2),?30,"Ward: ",$P(VAIN(4),U,2)," -"
17 I $P(YSTRN(0),U,2)<6!($P(YSTRN(0),U,2)>9) W "On ward Bed: ",$P(VAIP(6),U,2)
18 E W "Absent Due: " W:VAIP(11)]"" $P(VAIP(11),U,2)
19 I $D(^DPT("AS","S",YSDFN)) W !?26,"Seriously Ill"
20 G SA
21DIS ;
22 S X1=$P(VAIP(17,1),U),X2=$P(VAIP(13),U) D ^%DTC
23 W "Inactive",?28,"Discharged: ",$P(VAIP(17,1),U,2)," Type: ",$P(VAIP(17,4),U,2),?72,"LOS: ",X
24SA ;
25 I $D(^DIC(42,"ARSV",YSDFN)) S X=$O(^(YSDFN,0)) I X,$D(^DIC(42,X,"RSV",YSDFN,0)),$P(^(0),U,2)'<DT S L=$P(^(0),U,2) W !?18,"Scheduled Admission on ward ",$P(^DIC(42,X,0),U)," on ",$E(L,4,5),"/",$E(L,6,7),"/",$E(L,2,3)
26CL ;
27 G YSFA:'$O(^DPT(YSDFN,"DE",0)) W !!,"Currently enrolled in " S I=0 F S I=$O(^DPT(YSDFN,"DE",I)) Q:'I I $D(^(I,0)),$P(^(0),U,2)'="I" W:$X>60 !?22 W $S($D(^SC(+^(0),0)):$P(^(0),U)_", ",1:"")
28 ;
29YSFA ;
30 S YSCT=0 W !!,"Future Appointments: " I '$O(^DPT(YSDFN,"S",DT)) W "NONE" G RMK
31 W ?22,"Date",?34,"Time",?42,"Clinic",!?22 F I=22:1:75 W "="
32 F YSFA=DT:0 S YSFA=$O(^DPT(YSDFN,"S",YSFA)) G RMK:'YSFA S L=^(YSFA,0),C=+L I $P(L,U,2)'["C" D YSCOV,YSCOV1 Q:YSCT>5
33 I $O(^DPT(YSDFN,"S",YSFA)) W !,"See Scheduling options for additional appointments."
34RMK ;
35 W !!,"Remarks: ",$P(PTI(0),U,10) I $D(^DPT(YSDFN,.35)),^(.35)]"" W " PATIENT HAS DIED."
36 K Y,YSADM,YSTRN,DIS,YSSSN,YSFA,C,L,YSCOV,YSNOW,YSCT,PTI D WAIT^YSUTL Q
37YSCOV ;
38 S YSCOV=$S($P(L,U,7)=7:" (Collateral) ",1:""),YSCT=YSCT+1 Q
39YSCOV1 ;
40 S YSFDT=$$FMTE^XLFDT(YSFA,"5P")
41 W !?22,$P(YSFDT," "),?34,$P(YSFDT," ",2),?42,$P($S($D(^SC(C,0)):^(0),1:""),U)," ",YSCOV Q
Note: See TracBrowser for help on using the repository browser.