| 1 | SOWKHIRH ;B'HAM ISC/SAB-Routine to print patients by RCH, all homes or a single home ; 17 Mar 94 / 9:45 AM
|
|---|
| 2 | ;;3.0; Social Work ;**27**;27 Apr 93
|
|---|
| 3 | K ^TMP($J),ZTSK
|
|---|
| 4 | ASK W !!,"1. ALL HOMES",!,"2. A SINGLE HOME ?",!! R "ENTER 1 or 2 1// ",SWA:DTIME,! S:SWA="" SWA=1 G:"^"[$E(SWA)!('$T) CLO I "12"'[$E(SWA) D HP G ASK
|
|---|
| 5 | I SWA=1 G LP Q
|
|---|
| 6 | SEA W ! S DIC="^SOWK(652,",DIC(0)="AQEM",DIC("A")="ENTER RCH: " D ^DIC G:"^"[X CLO G SEA:Y<0 S DA=+Y,A=^SOWK(652,DA,0) K DIC D DEV I $D(ZTSK)!($D(OUT))!(POP) K ZTSK G CLO
|
|---|
| 7 | ENQ U IO W:$Y @IOF W !?25,"RESIDENTIAL CARE HOME REPORT" D SW
|
|---|
| 8 | CLO W ! W:$E(IOST)'["C" @IOF D ^%ZISC K SWXX,SWX,H,^TMP($J),B,DA,I,POP,S,STA,SWA,SWN,SWW,X,Y,A,C,G,DA,DIC,HM,WRK,J,OUT D:$D(ZTSK) KILL^%ZTLOAD
|
|---|
| 9 | Q
|
|---|
| 10 | LP D DEV I $D(ZTSK)!($D(OUT))!(POP) K ZTSK G CLO
|
|---|
| 11 | ENQ1 U IO W:$Y @IOF W !?25,"RESIDENTIAL CARE HOME REPORT" S HM="" F B=0:0 S HM=$O(^SOWK(652,"B",HM)) Q:HM="" F DA=0:0 S DA=$O(^SOWK(652,"B",HM,DA)) Q:'DA S A=^SOWK(652,DA,0) D SW I $G(SWXX) Q
|
|---|
| 12 | G CLO Q
|
|---|
| 13 | PRI S I="" F J=0:0 S I=$O(^TMP($J,I)) Q:I="" S H=^TMP($J,I) D PR1 I $G(SWXX) Q
|
|---|
| 14 | Q
|
|---|
| 15 | DEV K OUT,%ZIS,IOP,ZTSK S SOWKION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S IOP=SOWKION D ^%ZIS K IOP,SOWKION S POP=1 Q
|
|---|
| 16 | K SOWKION I $D(IO("Q")) S ZTDESC="RESIDENTIAL CARE HOME REPORT",ZTRTN=$S(SWA=2:"ENQ^SOWKHIRH",1:"ENQ1^SOWKHIRH") F G="DA","A" S:$D(@G) ZTSAVE(G)=""
|
|---|
| 17 | I K IO("Q") D ^%ZTLOAD I '$D(ZTSK) S OUT=1 K G,SWA,DIC,B,A,DA Q
|
|---|
| 18 | I $D(ZTSK) W !!,"Task Queued to Print",! W:$E(IOST)'["C" @IOF D ^%ZISC K G,SWA,DIC,B,A,DA
|
|---|
| 19 | Q
|
|---|
| 20 | SW S SWN=$P(A,"^"),SWW=$P(^VA(200,$P(A,"^",4),0),"^"),STA=$P(^DIC(5,$P(A,"^",7),0),"^") I $G(SWXX) Q
|
|---|
| 21 | U IO I $E(IOST)["C",$Y+5>IOSL R !!,"PRESS RETURN TO CONTINUE or '^' TO EXIT: ",SWX:DTIME I SWX["^"!'$T S SWXX=1 Q
|
|---|
| 22 | U IO W:$Y+5>IOSL @IOF W !!!!,"SOCIAL WORKER: ",SWW,!,"HOME: ",SWN,!,"ADDRESS: ",$P(A,"^",5) W:$P(A,"^",14)]"" !,"ADDRESS 2: "_$P(A,"^",14)
|
|---|
| 23 | W !,$P(A,"^",6)_", "_STA_" "_$P(A,"^",8),?$X+5,"PHONE: "_$P(A,"^",9),!!!
|
|---|
| 24 | F S=0:0 S S=$O(^SOWK(655,S)) Q:'S I $P(^SOWK(655,S,0),"^",2) F C=0:0 S C=$O(^SOWK(655,S,4,C)) Q:'C D
|
|---|
| 25 | .I $P(^SOWK(655,S,4,C,0),"^")=DA,$P(^(0),"^",5),$P(^(0),"^",3)'=1,'$P(^(0),"^",6) S WRK=$P(^SOWK(650,$P(^SOWK(655,S,4,C,0),"^",5),0),"^",3),DFN=S D PID^VADPT6,SETUP
|
|---|
| 26 | D PRI K ^TMP($J) I $G(SWXX) Q
|
|---|
| 27 | Q
|
|---|
| 28 | SETUP S ^TMP($J,$P(^DPT(S,0),"^"))=$P(^DPT(S,0),"^")_"^"_VA("PID")_"^"_$P(^VA(200,WRK,0),"^")
|
|---|
| 29 | Q
|
|---|
| 30 | HP W !!,"Enter the number one (1) if all homes are to print, else enter the number",!,"two (2) for an individual home.",! Q
|
|---|
| 31 | PR1 U IO 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 !,$P(H,"^"),?30,$P(H,"^",2),?45,$P(H,"^",3)
|
|---|
| 33 | Q
|
|---|
