1 | YSDGDEM0 ;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
|
---|
5 | A ;
|
---|
6 | S DFN=YSDFN D IN5^VADPT,INP^VADPT W !!,"Inpatient Status: " I VAIP(1)="" W "Not admitted" G SA
|
---|
7 | LOSS ;
|
---|
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
|
---|
9 | YSADM ;
|
---|
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)
|
---|
12 | L I VAIN(4)]"" S L=$P(VAIN(4),U)
|
---|
13 | YSTRN ;
|
---|
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)
|
---|
15 | INP ;
|
---|
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
|
---|
21 | DIS ;
|
---|
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
|
---|
24 | SA ;
|
---|
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)
|
---|
26 | CL ;
|
---|
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 | ;
|
---|
29 | YSFA ;
|
---|
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."
|
---|
34 | RMK ;
|
---|
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
|
---|
37 | YSCOV ;
|
---|
38 | S YSCOV=$S($P(L,U,7)=7:" (Collateral) ",1:""),YSCT=YSCT+1 Q
|
---|
39 | YSCOV1 ;
|
---|
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
|
---|