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