source: FOIAVistA/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKTC.m@ 1169

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

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1SOWKTC ;B'HAM ISC/SAB-Routine to print RCH Patient Registry for all open cases for a supervisor ; 08 Apr 93 / 9:04 AM
2 ;;3.0; Social Work ;;27 Apr 93
3 K ^TMP($J)
4 S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter Supervisor's last name: ",D="B",DIC("S")="I $D(^VA(200,""ASWC"",+Y)),'$P(^VA(200,+Y,0),""^"",11)!($P(^(0),""^"",11)'<DT)"
5 D IX^DIC G:"^"[X CLO G:Y'>0 SOWKTC S DA=+Y K DIC
6 K %ZIS,IOP,ZTSK S SOWKION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S IOP=SOWKION D ^%ZIS K IOP,SOWKION G CLO
7 K SOWKION I $D(IO("Q")) S ZTDESC="RCH REGISTRY FOR ALL OPEN CASES FOR A SUPERVISOR",ZTRTN=$S($G(COM):"ENQ^SOWKTC",1:"SUM^SOWKTC") F G="COM","DA" S:$D(@G) ZTSAVE(G)=""
8 I K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !!,"Task Queued to Print",! K G,DA,ZTSK G CLO Q
9 I '$G(COM) G SUM
10ENQ U IO W:$Y @IOF W "RCH PATIENT REGISTRY",!,"SUPERVISOR: "_$P(^VA(200,DA,0),"^"),!,"COMPLETE: OPEN CASES",!
11SEA F S=0:0 S S=$O(^SOWK(650,S)) Q:'S S A=^SOWK(650,S,0),W=$P(A,"^",3) I $P(^SOWK(651,$P(A,"^",13),0),"^",6)="R",'$P(A,"^",18),$P(^VA(200,W,654),"^",2)=DA,$D(^DPT($P(A,"^",8),0)) D CHK
12 D PRI
13CLO W ! W:$E(IOST)'["C" @IOF D ^%ZISC K ^TMP($J),SWX,SWXX,A,CS,D,DA,DIC,I,POP,LP,LP1,MS,P,S,SC,T,W,X,Y,J,Q,E,HM,PL,R,Z,COM D KVAR^VADPT,KVA^VADPT D:$D(ZTSK) KILL^%ZTLOAD Q
14PRI S I="" F J=0:0 S I=$O(^TMP($J,I)) Q:I="" D PR1 I $G(SWXX) Q
15 Q
16PR1 F E=0:0 S E=$O(^TMP($J,I,E)) Q:'E S A=^SOWK(650,E,0),W=$P(A,"^",3),P=$P(A,"^",8) S DFN=P D PID^VADPT6 D @$S($G(COM):"OUT",1:"OUT1") I $G(SWXX) Q
17 Q
18OUT U IO F Z=0:0 S Z=$O(^SOWK(655,P,4,Z)) Q:'Z I $P(^SOWK(655,P,4,Z,0),"^",5)=E S HM=$P(^SOWK(655,P,4,Z,0),"^"),PL=$P(^(0),"^",2),R=Z
19 I $E(IOST)["C",$Y+9>IOSL R !!,"PRESS RETURN TO CONTINUE or '^' TO EXIT: ",SWX:DTIME I SWX["^"!'$T S SWXX=1 Q
20 W:$Y+9>IOSL @IOF W !,"NAME: ",$E($P(^DPT(P,0),"^"),1,20),?$X+5,"HOME: "_$E($P(^SOWK(652,HM,0),"^"),1,20) S Y=PL X ^DD("DD") W " PLACED: "_Y,!,"ID#: ",VA("PID"),!,"DOB: " S Y=$P(^DPT(P,0),"^",3) X ^DD("DD") W Y,?$X+5
21 W ?$X+5,"SOCIAL WORKER: "_$P(^VA(200,W,0),"^") S X=$P(A,"^",7),MS=$S(X="1":"MEDICAL/SURGICAL",X="2":"PSYCHOSIS",X="3":"ORGANIC & SENILE",X="4":"SUBSTANCE ABUSE",X="5":"ALL OTHER",1:"")
22 W !,"MS: ",MS,?$X+5,"PRIOR LIVING: " S LP1=$P(^DD(650,10,0),"^",3),LP=$P(A,"^",11),LP=$P(LP1,";",LP) W $P(LP,":",2)
23 W !,"LEVEL OF CARE: "_$S($P(A,"^",23)=1:"LIGHT",$P(A,"^",23)=2:"MODERATE",1:"HEAVY")
24 W !,"RATE: " F Q=0:0 S Q=$O(^SOWK(655,P,4,R,1,Q)) Q:'Q S Y=$P(^SOWK(655,P,4,R,1,Q,0),"^",2) X ^DD("DD") W $P(^SOWK(655,P,4,R,1,Q,0),"^"),?$X+5,"DATE: "_Y,!,?$X+6
25 Q
26SUM U IO W:$Y @IOF W "RCH PATIENT REGISTRY",!,"SUPERVISOR: "_$P(^VA(200,DA,0),"^"),!,"SUMMARY: OPEN CASES",!
27 W !!!!,"PATIENT NAME",?20,"ID#",?37,"HOME NAME",?59,"SOCIAL WORKER",!
28 D SEA
29 Q
30OUT1 U IO F Z=0:0 S Z=$O(^SOWK(655,P,4,Z)) Q:'Z I $P(^SOWK(655,P,4,Z,0),"^",5)=E S HM=$P(^(0),"^")
31 I $E(IOST)["C",$Y+5>IOSL R !!,"PRESS RETURN TO CONTINUE or '^' TO EXIT: ",SWX:DTIME I SWX["^"!'$T S SWXX=1 Q
32 W:$Y+5>IOSL @IOF W !,$E($P(^DPT(P,0),"^"),1,15),?20,VA("PID"),?37,$E($P(^SOWK(652,HM,0),"^"),1,20),?59,$P(^VA(200,W,0),"^")
33 Q
34CHK S ^TMP($J,$P(^DPT($P(A,"^",8),0),"^"),$P(A,"^"))=$P(A,"^")
35 Q
Note: See TracBrowser for help on using the repository browser.