1 | SDWLCU3 ;IOFO BAY PINES/DMR - EWL FILE 409.3 CLEANUP ;2/4/03
|
---|
2 | ;;5.3;scheduling;**280,491**;AUG 13 1993;Build 53
|
---|
3 | ;
|
---|
4 | ;modify update of 409.32 and related 409.3 with a proper institution set up in file 44
|
---|
5 | ;through the division path
|
---|
6 | ;
|
---|
7 | 3 ;service specialty edit
|
---|
8 | S SDWLSS="",SDWLINS="",SDWLERR=""
|
---|
9 | F S SDWLINS=$O(^TMP($J,"SDWLCU1",SDWLTY,SDWLINS)) Q:SDWLINS="" D Q:SDWLERR=1
|
---|
10 | .F S SDWLSS=$O(^TMP($J,"SDWLCU1",SDWLTY,SDWLINS,SDWLSS)) Q:SDWLSS="" D Q:SDWLERR=1
|
---|
11 | ..I '$D(SDWLSSV) S SDWLSSV=SDWLSS
|
---|
12 | ..S NAME=$$GET1^DIQ(4,SDWLINS_",",.01)
|
---|
13 | ..S SDWLSSN=$P(^SDWL(409.31,SDWLSS,0),U,1)
|
---|
14 | ..W !,"SERVICE SPECIALTY: ",$$GET1^DIQ(40.7,SDWLSSN_",",.01)," INSTITUTION: ",NAME
|
---|
15 | ..S SDWLSSX=$O(^SDWL(409.31,SDWLSS,"I","B",SDWLINS,0)) D:SDWLSSX'="" SEL
|
---|
16 | S WLTC3=""
|
---|
17 | Q
|
---|
18 | SEL ;select new Insitition
|
---|
19 | N DIR
|
---|
20 | S DIR("A")="Select Institution: "
|
---|
21 | S DIR(0)="PAO^4:EMZ",DIR("S")="I $P(^DIC(4,+Y,0),U,11)=""N"",$$TF^XUAF4(+Y)" D ^DIR
|
---|
22 | I X["^" S SDWLERR=1 Q
|
---|
23 | I Y<1 W *7,"Invalid Entry" G SEL
|
---|
24 | S SDWLINSN=+Y
|
---|
25 | D C3,C31 K DIC,D0,D1
|
---|
26 | Q
|
---|
27 | C3 ;
|
---|
28 | ;check entry to see if it already exist
|
---|
29 | S DA=SDWLSSX,DA(1)=SDWLSS
|
---|
30 | I $O(^SDWL(409.31,SDWLSS,"I","B",SDWLINSN,0)) D
|
---|
31 | . W !,"Institution already exists for this Specialty...deleting."
|
---|
32 | . S DIK="^SDWL(409.31,"_DA(1)_","_"""I"""_"," D ^DIK
|
---|
33 | E D
|
---|
34 | . W ! S DR=".01////^S X=SDWLINSN",DIE="^SDWL(409.31,"_DA(1)_","_"""I"""_"," D ^DIE
|
---|
35 | K DA,DA(1),DR,DIE,DIK
|
---|
36 | Q
|
---|
37 | C31 ;update SD WAIT LIST PATIENT file 409.3
|
---|
38 | S SDWLDA="" F S SDWLDA=$O(^TMP($J,"SDWLCU1",SDWLTY,SDWLINS,SDWLSSV,SDWLDA)) Q:SDWLDA="" D
|
---|
39 | .S DR="2////^S X=SDWLINSN",DIE="^SDWL(409.3,",DA=SDWLDA D ^DIE
|
---|
40 | .K DR,DIE,DA
|
---|
41 | .K ^TMP($J,"SDWLCU1",SDWLTY,SDWLINS,SDWLSSV,SDWLDA),^TMP($J,"EWL",$J,SDWLDA)
|
---|
42 | Q
|
---|
43 | 4 ;specific clinic edit
|
---|
44 | N SDWLERR,SDWLSC,SDWLINS S SDWLSC="",SDWLINS="",SDWLERR=""
|
---|
45 | F S SDWLINS=$O(^TMP($J,"SDWLCU1",SDWLTY,SDWLINS)) Q:SDWLINS="" D
|
---|
46 | .F S SDWLSC=$O(^TMP($J,"SDWLCU1",SDWLTY,SDWLINS,SDWLSC)) Q:SDWLSC="" D UPDINS^SDWLCU5(SDWLSC,.SDWLERR)
|
---|
47 | Q:SDWLERR
|
---|
48 | S WLTC4=""
|
---|
49 | K ^SDWL(409.32,"ACT") S DIK="^SDWL(409.32," D IXALL^DIK
|
---|
50 | Q
|
---|
51 | C41 ;update wait list file
|
---|
52 | S SDWLDA="" F S SDWLDA=$O(^TMP($J,"SDWLCU1",SDWLTY,SDWLINS,SDWLSC,SDWLDA)) Q:SDWLDA="" D
|
---|
53 | .S SDWLIN(409.3,SDWLDA_",",2)=SDWLINSN D UPDATE^DIE("","SDWLIN","SDWLMSG")
|
---|
54 | .K ^TMP($J,"SDWLCU1",SDWLTY,SDWLINS,SDWLSC,SDWLDA),^TMP($J,"EWL",$J,SDWLDA),SDWLIN
|
---|
55 | Q
|
---|
56 | SEL1 ;select valid institution
|
---|
57 | N DIR
|
---|
58 | W !!,"Invalid Institution. Please select a National Institution.",!
|
---|
59 | W "CLINIC: ",CLNAM," INSTITUTION:",$$GET1^DIQ(4,SDWLINS_",",.01)
|
---|
60 | S DIR("A")="Select Institution: "
|
---|
61 | S DIR(0)="PAO^4:EMZ",DIR("S")="I $P(^DIC(4,+Y,0),U,11)=""N"",$$TF^XUAF4(+Y)" D ^DIR
|
---|
62 | I X["^" S SDWLERR=1 Q
|
---|
63 | I Y<1 W *7,"Invalid Entry" G SEL1
|
---|
64 | S SDWLINSN=+Y
|
---|
65 | Q
|
---|