| 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
|
|---|
