source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLPE.m@ 619

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

initial load of WorldVistAEHR
File size: 5.7 KB
Line 
1SDWLPE ;IOFO BAY PINES/TEH - WAIT LIST - PARAMETER WAIT LIST ENTER/EDIT ;20 Aug 2002 ; Compiled April 22, 2008 14:13:00
2 ;;5.3;scheduling;**263,280,288,397,491**;AUG 13 1993;Build 53
3 ;
4 ;SD/491 - identify clinic institution through DIVISION ---> INSTITUTION path
5EN ;
6 ;OPTION HEADER
7 ;
8 D HD
9 ;
10 ;SELECT FILE TO EDIT
11 ;
12EN1 D SEL G END:X["^",END:X=""
13 ;
14 ;EDIT PARAMETER FILE
15 ;
16 D EDIT G EN:'$D(Y)
17 G END
18 Q
19 ;
20SEL ;SELECT PARAMETER FILE
21 S DIR(0)="SO^1:Wait List Service/Specialty File;2:Wait List Clinic Location"
22 S DIR("L",1)="Select one of the following:"
23 S DIR("L",2)=""
24 S DIR("L",3)=" 1. Wait List Service/Specialty (409.31)"
25 S DIR("L")=" 2. Wait List Clinic Location (409.32)"
26 D ^DIR S SDWLF=X
27 K DIR,DILN,DINDEX
28 Q
29EDIT ;EDIT FILE PARAMETERS
30 I SDWLF=1 D SB1 Q:$D(DUOUT)
31 I SDWLF=2 D SB2 Q:$D(DUOUT)
32 Q
33SB1 S DIC(0)="AEQMZ",DIC("A")="Select DSS ID: ",DIC="^DIC(40.7,",DIC("S")="I '$P(^DIC(40.7,+Y,0),U,3)"
34 D ^DIC
35 I X["^" I $D(DA),'$D(^SDWL(409.31,DA,"I")) S DIK="^SDWL(409.31," D ^DIK S DUOUT=1 Q
36 Q:Y<0 Q:$D(DUOUT) S SDWLDSS=+Y
37 I '$D(^SDWL(409.31,"B",SDWLDSS)) D
38 .S DIC(0)="LX",X=SDWLDSS,DIC="^SDWL(409.31," K DO D FILE^DICN
39 S DA=$O(^SDWL(409.31,"B",SDWLDSS,""))
40SB1A S DIR(0)="PAO^4:EMZ" D ^DIR
41 I X="" W *7," Required" G SB1A
42 I X["^" D:'$D(^SDWL(409.31,DA,"I")) S DUOUT=1 Q
43 .S DIK="^SDWL(409.31," D ^DIK
44 S X=$$GET1^DIQ(4,+Y_",",11)
45 I X'["N"!'$$TF^XUAF4(+Y) W !,*7,"Invalid Entry. Must be 'National' Institution." G SB1A
46 I '$D(^SDWL(409.31,DA,"I","B",+Y)) D
47 .S DA(1)=DA,DIC="^SDWL(409.31,"_DA(1)_","_"""I"""_",",DIC("P")=409.311,X=+Y K D0 D FILE^DICN I +Y S DA=+Y
48 I $D(^SDWL(409.31,DA,"I","B",+Y)) S DA(1)=DA,DA=$O(^(+Y,0))
49 K DIC,DIE,DIR,DR
50 W ! S DR="1;3",DIE="^SDWL(409.31,"_DA(1)_","_"""I"""_"," D ^DIE
51 I $P(^SDWL(409.31,DA(1),"I",DA,0),U,2)="" D
52 .W *7,!,"This ENTRY requires an ACTIVATION DATE. ENTRY deleted."
53 .S DIK="^SDWL(409.31,"_DA(1)_","_"""I"""_"," D ^DIK I '$P(^SDWL(409.31,DA(1),"I",0),U,3) D
54 ..S DIK="^SDWL(409.31,",DA=DA(1) D ^DIK
55 K DA,DA(1),SDWLDSS,DIC,DR,DIE,DI,DIEDA,DIG,DIH,DIIENS,DIR,DIU,DIV
56 Q
57SB2 N STR,INST,DIC,SDWLSC,SDWLSTOP S SDWLSTOP=0
58 W ! S DIC(0)="AEMNZ",DIC("A")="Select Clinic: ",DIC=44
59 S DIC("S")="S SDWLX=$G(^SC(+Y,0)),SDWLY=$G(^(""I"")) I $P(SDWLX,U,3)=""C"",$P(SDWLY,U,1)'>$P(SDWLY,U,2)"
60 S DIC("W")="S STR=$$CLIN^SDWLPE(+Y) I STR W ?50,""- "",$E($P(STR,U,3),1,25),""("",$P(STR,U,2),"")"""
61 D ^DIC I Y<1 K DIC,DA Q
62 Q:$D(DUOUT) S SDWLSC=+Y S INST=+STR ;$$CLIN(SDWLSC)
63 I $P(STR,U,6)'="" W !,*7,$P(STR,U,6) G SB2
64 N SDANEW S SDANEW=""
65 I '$D(^SDWL(409.32,"B",SDWLSC)) D
66 .S DIC(0)="LX",X=SDWLSC,DIC="^SDWL(409.32," D FILE^DICN
67 .N DA S DA=$O(^SDWL(409.32,"B",SDWLSC,"")) S SDANEW=DA
68 .S DIE="^SDWL(409.32,",DR=".02////^S X=INST" D ^DIE
69 N DA,SDA S DA=$O(^SDWL(409.32,"B",SDWLSC,"")),SDA=DA
70 S DR="1",DIE="^SDWL(409.32," D ^DIE
71 I SDANEW,'X D D ESB2 H 1 G SB2
72 .W *7,!!,"This ENTRY requires an ACTIVATION DATE. ENTRY deleted."
73 .S DA=SDANEW S DIK="^SDWL(409.32," D ^DIK
74 I X S DR="2////^S X=DUZ" D ^DIE
75 N DIC
76 S SDWLSCN=$P($G(^SDWL(409.32,SDA,0)),U,1) D Q:SDWLSTOP
77 .I $D(^SDWL(409.3,"SC",SDWLSCN)) D
78 ..S SDWLN="",SDWLCNT=0 F S SDWLN=$O(^SDWL(409.3,"SC",SDWLSCN,SDWLN)) Q:SDWLN="" D
79 ...S X=$G(^SDWL(409.3,SDWLN,0)) I '$D(^SDWL(409.3,SDWLN,"DIS")) S SDWLCNT=SDWLCNT+1,^TMP("SDWLPE",$J,"DIS",SDWLN,SDWLCNT)=X,SDWLSTOP=1
80 ..I SDWLSTOP W !,"This Clinic has Patients on the Wait List and can not be inactivated." H 2 Q
81 .S DR="4////^S X=DUZ" D ^DIE
82 S DR="3",DIE="^SDWL(409.32," D ^DIE
83ESB2 ;
84 K DR,DIE,DIC,Y,X,SDWLY,DIC(0),DO,DA,DI,DIW,SDWLX,SDWLSCN,SDWLF
85 Q
86SWT ;SWITCH FOR INACTIVATION OF PARAMETER FILE
87 Q
88HD ;HEADER
89 W:$D(IOF) @IOF W !!,?80-$L("Wait List Parameter Enter/Edit")\2,"Wait List Parameter Enter/Edit",!
90 W !,?80-$L("------------------------------")\2,"------------------------------",!
91END K SDWLSTOP,DIR,DIC,DR,DIK,SDWLX,SDWLSCN,SDWLF,SDWLY,SDWLSC,SDWLN,SDWLCNT,SDWLDSS,DUOUT,X,Y
92 Q
93CLIN(CL) ;identify clinic institution through DIVISON ----> INSTITUTION path.
94 ; function to return:
95 ; 1 2 3 4 5 6 7
96 ; - Institution pointer to ^DIC(4 _U_ STATION number (# 99) _U_ INST Name _U_ DIV Pointer to ^DG(40.8 _U_N/L_U_Message_U_TYPE
97 ; ( INST^STA NUM^SNAM^DIV^N/L^MESS^TYPE )
98 ; N/L - N -National/L -Local
99 ; TYPE - type of entry in file # 44 (field #2)
100 ; C:CLINIC
101 ; M:MODULE
102 ; W:WARD
103 ; Z:OTHER LOCATION
104 ; N:NON-CLINIC STOP
105 ; F:FILE AREA
106 ; I:IMAGING
107 ; OR:OPERATING ROOM
108 ;
109 ; with optional Message:
110 ;
111 ; if STA=""
112 ; - INST^^SNAM^DIV^N/L^' - No Station Number on file' ^ TYPE
113 ; or
114 ; - 0^^^DIV^^' - No Institution has been identified '^ TYPE
115 ; - 0^^^-1^^' - No Division has been identified' ^ TYPE
116 ;
117 ; if entry is inactivated:
118 ;
119 ; - INST^^SNAM^DIV^N/L^' - Inactive treating medical facility' ^ TYPE
120 ; - -1^^^^^' - No clinic on file' ^
121 ;
122 I +CL=0!'$D(^SC(+CL)) Q -1_"^^^^^ - No clinic on file^"
123 N SDWMES,STN,DIV,INS,SNL,STR,SNAM S SDWMES="",STN=""
124 N TYPE S TYPE=$$GET1^DIQ(44,CL_",",2,"E")
125 S DIV=+$$GET1^DIQ(44,CL_",",3.5,"I")
126 I DIV=0 S SDWMES=" - No Division has been identified" Q 0_"^^^"_-1_"^^"_SDWMES_U_TYPE
127 S INS=+$$GET1^DIQ(40.8,DIV_",",.07,"I")
128 I INS=0 S SDWMES=" - No Institution has been identified" Q 0_"^^^"_DIV_"^^"_SDWMES_U_TYPE
129 E S STR=$$NS^XUAF4(INS),STN=$P(STR,U,2),SNAM=$P(STR,U) ;station number and name
130 I STN="" S SDWMES=" - No Station Number on file"
131 I '$$TF^XUAF4(INS) S SDWMES=SDWMES_" - Inactive treating medical facility"
132 S SNL=$$GET1^DIQ(4,INS_",",11,"I")
133 Q INS_U_STN_U_SNAM_U_DIV_U_SNL_U_SDWMES_U_TYPE
Note: See TracBrowser for help on using the repository browser.