Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLPE.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLPE.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLPE.m
r613 r623 1 SDWLPE ;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 5 EN ; 6 ;OPTION HEADER 7 ; 8 D HD 9 ; 10 ;SELECT FILE TO EDIT 11 ; 12 EN1 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 ; 20 SEL ;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 29 EDIT ;EDIT FILE PARAMETERS 30 I SDWLF=1 D SB1 Q:$D(DUOUT) 31 I SDWLF=2 D SB2 Q:$D(DUOUT) 32 Q 33 SB1 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,"")) 40 SB1A 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 57 SB2 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 83 ESB2 ; 84 K DR,DIE,DIC,Y,X,SDWLY,DIC(0),DO,DA,DI,DIW,SDWLX,SDWLSCN,SDWLF 85 Q 86 SWT ;SWITCH FOR INACTIVATION OF PARAMETER FILE 87 Q 88 HD ;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,"------------------------------",! 91 END K SDWLSTOP,DIR,DIC,DR,DIK,SDWLX,SDWLSCN,SDWLF,SDWLY,SDWLSC,SDWLN,SDWLCNT,SDWLDSS,DUOUT,X,Y 92 Q 93 CLIN(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 1 SDWLPE ;IOFO BAY PINES/TEH - WAIT LIST - PARAMETER WAIT LIST ENTER/EDIT ;20 Aug 2002 2 ;;5.3;scheduling;**263,280,288,397**;AUG 13 1993 3 ; 4 ; 5 EN ; 6 ;OPTION HEADER 7 ; 8 D HD 9 ; 10 ;SELECT FILE TO EDIT 11 ; 12 EN1 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 ; 20 SEL ;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 29 EDIT ;EDIT FILE PARAMETERS 30 I SDWLF=1 D SB1 Q:$D(DUOUT) 31 I SDWLF=2 D SB2 Q:$D(DUOUT) 32 Q 33 SB1 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,"")) 40 SB1A 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 57 SB2 S SDWLSTOP=0 58 W ! S DIC(0)="AEQMNZ",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) I $P(^SC(+Y,0),U,4)" 60 S DIC("W")="I $P(^SC(+Y,0),U,4) W ?50,""- "",$E($P(^DIC(4,$P(^SC(+Y,0),U,4),0),U,1),1,25)" 61 D ^DIC Q:Y<1 Q:$D(DUOUT) S SDWLSC=+Y 62 S INST=$$GET1^DIQ(44,+Y,3,"I") 63 S X=$$GET1^DIQ(4,+INST_",",11) I X'["N"!'$$TF^XUAF4(+INST) W !,*7,"Invalid Entry. Must be 'National' Institution." G SB2 64 I '$D(^SDWL(409.32,"B",SDWLSC)) D 65 .S DIC(0)="LX",X=SDWLSC,DIC="^SDWL(409.32," D FILE^DICN 66 S DA=$O(^SDWL(409.32,"B",SDWLSC,"")) 67 K DIC,DIC(0) 68 S SDWLSCN=$P($G(^SDWL(409.32,DA,0)),U,1) D 69 .I $D(^SDWL(409.3,"C",SDWLSCN)) D 70 ..S SDWLN="",SDWLCNT=0 F S SDWLN=$O(^SDWL(409.3,"C",SDWLSCN,SDWLN)) Q:SDWLN="" D 71 ...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 72 W ! I SDWLSTOP W "This Clinic has Patients on the Wait List and can not be inactivated." Q 73 S DR="1",DIE="^SDWL(409.32," D ^DIE I X S DR="2////^S X=DUZ" D ^DIE 74 S DR="3",DIE="^SDWL(409.32," D ^DIE I X S DR="4////^S X=DUZ" D ^DIE 75 K DR,DIE,DIC,Y,X,SDWLY,DIC(0),DO,DA,DI,DIW,SDWLX,SDWLSCN,SDWLF 76 Q 77 SWT ;SWITCH FOR INACTIVIATION OF PARAMETER FILE 78 Q 79 HD ;HEADER 80 W:$D(IOF) @IOF W !!,?80-$L("Wait List Parameter Enter/Edit")\2,"Wait List Parameter Enter/Edit",! 81 W !,?80-$L("------------------------------")\2,"------------------------------",! 82 END K SDWLSTOP,DIR,DIC,DR,DIK,SDWLX,SDWLSCN,SDWLF,SDWLY,SDWLSC,SDWLN,SDWLCNT,SDWLDSS,DUOUT,X,Y 83 Q
Note:
See TracChangeset
for help on using the changeset viewer.
