source: FOIAVistA/tag/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKHR.m@ 628

SOWKHR ;B'HAM ISC/SAB-ROUTINE TO CHECK HIGH RISK SCREENING PROFILES ; 20 Apr 93 / 3:04 PM
 ;;3.0; Social Work ;;27 Apr 93
 Q:'$D(^SOWK(650.1,1,0))
 S (MON,SR,DP,J,SC,HB,AA,OI,C,B,T,INC,MP,SI,PE)=0,X="T-1",%DT="" D ^%DT G:Y<1 CLOS S SDATE=Y,WDZ=-1 W !
 S SWSITE=^SOWK(650.1,1,0),AGE=$P(SWSITE,"^",4),TI=$P(SWSITE,"^",5)
WDZ D KVA^VADPT S WDZ=$O(^DPT("CN",WDZ)) G:WDZ="" CLOS
 F DFN=0:0 S DFN=$O(^DPT("CN",WDZ,DFN)) G:'DFN WDZ D INP^VADPT I $E(VAIN(7),1,7)=SDATE S J=J+1,(DD,G)=VAIN(1) D CHK S (INC,MP,SI,PE,HB,OI,AA,SC,DP,SR,MON)=0 K SPS
CLOS U IO W:J'>0 @IOF,"There were no possible High-Risk patients found for SOCIAL WORK SERVICE !",!
 W:$E(IOST)'["C" @IOF D ^%ZISC K SPS,OD,CD,ADM,HR,SK,DAT,DTY,IN,SWSITE,PRV,H,K,L,IC,J,HB,OI,OR,R,DD,SC,B,C,CL,%DT,G,A,DS,E,EE,DFN,INC,IOP,POP,%ZIS,MP,P,PE,Q,SI,T,W,TI,X,X1,X2,Y,SDATE,Z,F,AGE,D,S,AA,Z,WDZ,DP,SR,N,MON D KVA^VADPT Q
CHK D ALL^VADPT I $P(SWSITE,"^",20) S:VADM(4)'<AGE T=T+1,T(T)="AGE "_AGE_" or OLDER - "
 S SK=0 G:'$P(SWSITE,"^",8) FM
 I '+VAEL(3),$O(^DPT(DFN,.312,0)) F L=0:0 S L=$O(^DPT(DFN,.312,L)) Q:'L  I '$P(^DPT(DFN,.312,L,0),"^",4)!($P(^(0),"^",4)'<DT) D  I SK S T=T+1,T(T)="NSC INSURANCE COVERAGE - "
 .S IC=$P(^DPT(DFN,.312,L,0),"^") I $D(^DIC(36,IC,0)),$E($P(^DIC(36,IC,0),"^"),1,5)'="MEDIC" S SK=SK+1,IC(SK)=$P(^DIC(36,IC,0),"^")
FM I $P(SWSITE,"^",9) S:$P(VADM(5),"^")="F" T=T+1,T(T)="FEMALE - "
 G:'$P(SWSITE,"^",10) ADD F W=0:0 S W=$O(^UTILITY("VAEN",$J,W)) Q:'W  I $P(^UTILITY("VAEN",$J,W,"I"),"^",3)="O" S C=C+1
 I C'<2,VADM(4)'<70 S T=T+1,T(T)="AGE 70 or greater and 2 or more OPT clinics - "
ADD I $P(SWSITE,"^",11) S:VAPA(1)="GENERAL DELIVERY" T=T+1,T(T)="GENERAL DELIVERY ADDRESS - "
 I $P(SWSITE,"^",12) S:VAPA(1)']"" T=T+1,T(T)="NO ADDRESS - "
 I $P(SWSITE,"^",13),+VAPA(9)'<SDATE,+VAPA(10)'>SDATE,VAPA(1)']"" S T=T+1,T(T)="NO TEMPORARY ADDRESS - "
 I $P(SWSITE,"^",7) F F=0:0 S F=$O(^SOWK(650.1,1,1,F)) Q:'F  I ^SOWK(650.1,1,1,F,0)=$P(VAIN(4),"^") S T=T+1,T(T)="HIGH-RISK WARD - "
 G:'$P(SWSITE,"^",15) RADM S D=9999999.9999999-(VAIN(7)),DD=+$O(^DGPM("ATID3",DFN,D)) G:'DD RADM S IN=$O(^(DD,0)),DAT=^DGPM(IN,0),DD=+$P(DAT,"^"),DTY=$P(DAT,"^",4)
 S X1=$E(+VAIN(7),1,7),X2=$E($P(DAT,"^"),1,7) D ^%DTC I $P(^DG(405.3,$P(DAT,"^",2),0),"^")="DISCHARGE",$E($P(^DG(405.1,$P(DAT,"^",4),0),"^"),1,3)="IRR",X'>180 S T=T+1,T(T)="IRREGULAR DISCHARGE - "
RADM G:'$P(SWSITE,"^",16) RCH
 S D=9999999.9999999-(+VAIN(7)),DD=+$O(^DGPM("ATID1",DFN,D)) G:'DD RCH S IN=$O(^(DD,0)),DAT=^DGPM(IN,0),ADM=$P(DAT,"^") S X1=+VAIN(7),X2=$P(DAT,"^") D ^%DTC I X'>30 S T=T+1,T(T)="READMITTED WITHIN ONE MONTH - "
RCH G:'$P(SWSITE,"^",17) ADA I $D(^SOWK(650,"P",DFN)) D HR
ADA I $O(^SOWK(650,"P",DFN,0)) F P=0:0 S P=$O(^SOWK(650,"P",DFN,P)) Q:'P  D
 .I $P(^SOWK(650,P,0),"^",14),'$G(SPS) S T=T+1,T(T)="PREVIOUS SPECIAL POPULATION PATIENT - ",SPS=1
 .S:$P(^SOWK(651,$P(^SOWK(650,P,0),"^",13),0),"^",4)="5111.00" T=T+1,T(T)="HOME DIALYSIS - "
 .S:$P(^SOWK(651,$P(^SOWK(650,P,0),"^",13),0),"^",4)="5110.00" T=T+1,T(T)="HBHC - "
 .S:$P(^SOWK(651,$P(^SOWK(650,P,0),"^",13),0),"^",4)="5112.00" T=T+1,T(T)="SCI HOME CARE - "
 .S:$P(^SOWK(651,$P(^SOWK(650,P,0),"^",13),0),"^",4)="5114.00" T=T+1,T(T)="OTHER HOME BASED PROGRAMS - "
 I $P(SWSITE,"^",18) F D=0:0 S D=$O(^DPT(DFN,"DIS",D)) Q:'D  I $E($P(^DPT(DFN,"DIS",D,0),"^"),1,7)=SDATE,$D(^DPT(DFN,"DIS",D,2)),$P(^DPT(DFN,"DIS",D,2),"^",4)="Y" S T=T+1,T(T)="ADMISSION DUE TO ACCIDENT - "
 K H I $P(SWSITE,"^",14) D OPD^VADPT I +VAPD(7),35[$E($P(VAPD(7),"^")) D
INC .D MB^VADPT,INC1 S AA=$S(+VAMB(1):$P(VAMB(1),"^",2),1:0),HB=$S(+VAMB(2):$P(VAMB(2),"^",2),1:0),SC=$S(+VAINC(8):VAINC(8),1:0)
 .S PE=$S(+VAMB(4):$P(VAMB(4),"^",2),1:0),MP=$S(+VAINC(11):VAINC(11),1:0),SI=$S(+VAMB(6):$P(VAMB(6),"^",2),1:0)
 .S DP=$S(+VAMB(7):$P(VAMB(7),"^",2),1:0),OI=$S(+VAINC(13):VAINC(13),1:0),YR=VAINC(1),CS=VAINC(9),RR=VAINC(10),UC=VAINC(12),IE=VAINC(14)
 .S II=VAINC(15),WC=VAINC(16),AOI=VAINC(17),MON=1,INC=(DP+OI+HB+AA+PE+MP+SI+SC+CS+RR+UC+IE+II+WC+AOI) I INC<TI S T=T+1,T(T)="INCOME LESS THAN LOCAL AMOUNT"
 I T'>0 S (B,T,C)=0 K S Q
 D OAD^VADPT,PID^VADPT,^SOWKHR1
 Q
 ;
INC1 D ALL^DGMTU21(DFN,"V",DT,"I") S VAX=$G(^DGMT(408.21,+$G(DGINC("V")),0)),VAINC(1)=+VAX F I=8:1:17 S VAINC(I)=+$P(VAX,U,I)
 Q
HR S HR=0 F P=0:0 S P=$O(^SOWK(650,"P",DFN,P)) Q:'P  S H=^SOWK(650,P,0) I '$D(S($P(H,U,3))) S S($P(H,U,3))=$P(H,U,3) D  I ($P(^SOWK(651,$P(H,U,13),0),U,6)="R"!($P(H,U,13)=42)),'HR S T=T+1,T(T)="SEEN BY SOCIAL WORK & LOCATION RCH or CNH - ",HR=1
 .S OD="OPENED: "_$E($P(H,"^",2),4,5)_"/"_$E($P(H,"^",2),6,7)_"/"_$E($P(H,"^",2),2,3),CD=$S($P(H,"^",18):"CLOSED: "_$E($P(H,"^",18),4,5)_"/"_$E($P(H,"^",18),6,7)_"/"_$E($P(H,"^",18),2,3),1:"")
 .S S($P(H,"^",3))=$P(H,"^",3)_"^"_OD_"^"_CD