source: WorldVistAEHR/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKRKD.m@ 700

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

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1SOWKRKD ;B'HAM ISC/SAB-Routine to delete social worker from SW-Position file ; 16 Dec 93 / 2:34 PM [ 08/05/94 8:02 AM ]
2 ;;3.0; Social Work ;**17,31,35**;27 Apr 93
3 S DIC("S")="I $D(^VA(200,+Y,654)),$P(^VA(200,+Y,654),""^"")"
4 S DIC="^VA(200,",DIC("A")="WHAT WORKER TO DELETE ? ",DIC(0)="AQEM" D ^DIC G:"^"[X Q S DA=+Y K DIC
5 D WAIT^DICD I $D(^SOWK(650,"W",DA)) W *7,!,"WORKER HAS CASES ASSIGNED, MUST REPLACE WITH ANOTHER WORKER BEFORE DELETING !",! G Q
6 I $D(^VA(200,"ASWC",DA)) W *7,!,"WORKER IS IDENTIFIED AS SUPERVISOR, PLEASE REPLACE WITH ANOTHER SUPERVISOR !",! G Q
7OC F Q=0:0 W !,"ARE YOU SURE YOU WANT TO DELETE THIS WORKER" S %=2 D YN^DICN Q:% I %Y["?" D YN^SOWKHELP
8 G:%=2!(%=-1) Q D DEL^SOWKNEW W *7," <WORKER DELETED> "
9Q K %,%Y,Q,DIC,X,DA,Y,I,SW,DR,DIK
10 Q
11PRI ;LIST OF SOCIAL WORKERS
12DEV ;
13 K ^TMP($J),%ZIS,IOP,ZTSK S SOWKION=ION,%ZIS="QM",%ZIS("B")="" D ^%ZIS K %ZIS I POP S IOP=SOWKION D ^%ZIS K IOP,SOWKION G CLO
14 K SOWKION I $D(IO("Q")) S ZTDESC="LIST OF SOCIAL WORKERS",ZTRTN="EN^SOWKRKD" K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"LIST TO PRINT AT SELECTED TIME" K ZTSK G CLO
15EN S PG=0,OUT=0,%H=$H D YX^%DTC S TD=$P(Y,"@")_" "_$P(Y,"@",2)
16 F I=0:0 S I=$O(^VA(200,"ASWB",I)) Q:'I I $P(^VA(200,I,654),"^"),$P(^(654),"^",2),+$P(^(654),"^",3),$P(^(654),"^",5) D OK
17 D HDR F I=0:0 S I=$O(^TMP($J,I)) Q:'I!(OUT=1) U IO D CHK Q:OUT=1 W !,$J($P(^TMP($J,I,0),"^",3),3),?8,$P(^(0),"^"),?40,$P(^(0),"^",2)
18CLO I $E(IOST)["C",('$G(OUT)) R !,"Press <RETURN> to continue: ",SWXX:DTIME K SWXX W @IOF
19 W ! W:$E(IOST)'["C" @IOF D ^%ZISC K IOP,POP,OUT,II,%H,TD,I,L,Q,^TMP($J),PG D:$D(ZTSK) KILL^%ZTLOAD
20 Q
21HDR Q:OUT=1
22 U IO S PG=PG+1 W:$Y!(PG>1) @IOF W "WORKERS LIST",?30,TD,?70,"PAGE: "_PG,!,"NUMBER",?8,"SOCIAL WORKER",?40,"IMMEDIATE SUPERVISOR",! F II=1:1:IOM-1 W "_"
23 Q
24OK S ^TMP($J,+$P(^VA(200,I,654),"^",3),0)=$P(^VA(200,I,0),"^")_"^"_$P(^VA(200,$P(^VA(200,I,654),"^",2),0),"^")_"^"_$P(^VA(200,I,654),"^",3)
25 Q
26CHK ;checks for end of page
27 Q:($Y+5)'>IOSL
28 N SWXX
29 I $E(IOST)["C" R !,"Press <RETURN> to continue: ",SWXX:DTIME I SWXX["^" S OUT=1 W @IOF Q
30 D HDR Q
Note: See TracBrowser for help on using the repository browser.