| 1 | SOWKBCD ;BHAM ISC/DLR-DELETE INCOMPLETE CASE OPENING INFO ; 21 Mar 94 / 12:36 PM
|
|---|
| 2 | ;;3.0; Social Work ;**21**;27 Apr 93
|
|---|
| 3 | ;
|
|---|
| 4 | BEG W @IOF
|
|---|
| 5 | W !,"This routine will delete any incomplete or incorrect case data in the Social",!,"Work files (650)(655)(655.2). After correcting the data, file (650)",!,"will be reindexed.",!!
|
|---|
| 6 | S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you wish to continue",DIR("?")="Enter ""YES"" to delete the data, associated with incomplete cases, from the Case (650), RCH (655), and ASSESSMENT (655.2) files." D ^DIR K DIR,X Q:Y'>0
|
|---|
| 7 | DEV K %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 END
|
|---|
| 8 | I $E(IOST)["C" W *7,!,"PRINTOUT MUST BE SENT TO PRINTER !!",! G DEV
|
|---|
| 9 | K SOWKION I $D(IO("Q")) S ZTDESC="SOCIAL WORK CASE CORRECTION",ZTRTN="ENQ^SOWKBCD"
|
|---|
| 10 | I K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !!,"Task Queued to Print",! K ZTSK,G G END
|
|---|
| 11 | ENQ S REC=0 F CS=0:0 S CS=$O(^SOWK(650,CS)) Q:CS'>0 D
|
|---|
| 12 | .S SWPT=$P(^SOWK(650,CS,0),"^",8) I '$P(^SOWK(650,CS,0),"^")!('$D(SWPT)) S REC=REC+1 D:REC=1 REC1 D CK K ^SOWK(650,CS) Q
|
|---|
| 13 | .I $P(^SOWK(650,CS,0),"^",13)=74 D RCH
|
|---|
| 14 | F X="AC","ACD","AD","AE","B","BS5","CP","O","P","W" K ^SOWK(650,X)
|
|---|
| 15 | S DIK="^SOWK(650," D IXALL^DIK
|
|---|
| 16 | D:REC=0 REC0
|
|---|
| 17 | END ;kills all the variables
|
|---|
| 18 | W:$E(IOST)'["C" @IOF D ^%ZISC K X,X2,SWPT,REC,SOWKFLAG,DFN Q
|
|---|
| 19 | RCH ;check RCH file (655) for entries with CS as the case #
|
|---|
| 20 | S SOWKFLAG=0
|
|---|
| 21 | I '$O(^SOWK(655,SWPT,4,0)) S REC=REC+1 D:REC=1 REC1 S DA=SWPT,DIK="^SOWK(655," D ^DIK
|
|---|
| 22 | I $O(^SOWK(655,SWPT,4,0)) F X2=0:0 S X2=$O(^SOWK(655,SWPT,4,X2)) Q:X2'>0 D
|
|---|
| 23 | .I $D(^SOWK(655,SWPT,4,X2,0)),$P($G(^SOWK(655,SWPT,4,X2,0)),"^",5)="" D DEL
|
|---|
| 24 | .I $P($G(^SOWK(655,SWPT,4,X2,0)),"^",5)=CS S SOWKFLAG=1
|
|---|
| 25 | I 'SOWKFLAG D CK S REC=REC+1 D:REC=1 REC1 S DA=CS,DIK="^SOWK(650," D ^DIK D DIS
|
|---|
| 26 | Q
|
|---|
| 27 | DEL ;deletes home entries without the pointers back to the case file (650)
|
|---|
| 28 | S REC=REC+1 D:REC=1 REC1 S DA=X2,DA(1)=SWPT,DIK="^SOWK(655,"_DA(1)_",4," D ^DIK W !,*7,"<RECORD DELETED>" K DIK
|
|---|
| 29 | I '$O(^SOWK(655,SWPT,4,0)) S REC=REC+1 D:REC=1 REC1 S DA=SWPT,DIK="^SOWK(655," D ^DIK
|
|---|
| 30 | Q
|
|---|
| 31 | REC1 ;
|
|---|
| 32 | U IO W !!!,"These patients were associated with incomplete case openings.",!,"The incomplete records were probably a direct result of exiting, ""^"",",!,"out of the Open Case option at the RCH prompts.",!! Q
|
|---|
| 33 | REC0 ;
|
|---|
| 34 | U IO W !,"There were no incomplete cases located within your case file (650).",!! Q
|
|---|
| 35 | DIS ;displays the Case # and the patients name being deleted from the file
|
|---|
| 36 | U IO S DFN=SWPT D DEM^VADPT W !,*7,"Case #"_$G(CS)_" "_$G(VADM(1))_" was deleted." K DIK,DA D KVA^VADPT K X2 Q
|
|---|
| 37 | CK ;checks to see if there is an Assessment Associated with this case
|
|---|
| 38 | I $P($G(^SOWK(655.2,SWPT,0)),"^",12)=CS S DA=SWPT,DIK="^SOWK(655.2," D ^DIK K DIK Q
|
|---|
| 39 | Q
|
|---|
