Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDWLPE

SDWLPE.m

Go to the documentation of this file.
SDWLPE ;IOFO BAY PINES/TEH - WAIT LIST - PARAMETER WAIT LIST ENTER/EDIT ;20 Aug 2002  ; Compiled April 22, 2008 14:13:00
 ;;5.3;scheduling;**263,280,288,397,491,1015**;AUG 13 1993;Build 21
 ;
 ;SD/491 - identify clinic institution through DIVISION ---> INSTITUTION path
EN ;
 ;OPTION HEADER
 ;
 D HD
 ;
 ;SELECT FILE TO EDIT
 ;
EN1 D SEL G END:X["^",END:X=""
 ;
 ;EDIT PARAMETER FILE
 ;
 D EDIT G EN:'$D(Y)
 G END
 Q
 ;
SEL ;SELECT PARAMETER FILE
 S DIR(0)="SO^1:Wait List Service/Specialty File;2:Wait List Clinic Location"
 S DIR("L",1)="Select one of the following:"
 S DIR("L",2)=""
 S DIR("L",3)="    1. Wait List Service/Specialty (409.31)"
 S DIR("L")="    2. Wait List Clinic Location (409.32)"
 D ^DIR S SDWLF=X
 K DIR,DILN,DINDEX
 Q
EDIT ;EDIT FILE PARAMETERS
 I SDWLF=1 D SB1 Q:$D(DUOUT)
 I SDWLF=2 D SB2 Q:$D(DUOUT)
 Q
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)"
 D ^DIC
 I X["^" I $D(DA),'$D(^SDWL(409.31,DA,"I")) S DIK="^SDWL(409.31," D ^DIK S DUOUT=1 Q
 Q:Y<0  Q:$D(DUOUT)  S SDWLDSS=+Y
 I '$D(^SDWL(409.31,"B",SDWLDSS)) D
 .S DIC(0)="LX",X=SDWLDSS,DIC="^SDWL(409.31," K DO D FILE^DICN
 S DA=$O(^SDWL(409.31,"B",SDWLDSS,""))
SB1A S DIR(0)="PAO^4:EMZ" D ^DIR
 I X="" W *7," Required" G SB1A
 I X["^" D:'$D(^SDWL(409.31,DA,"I"))  S DUOUT=1 Q
 .S DIK="^SDWL(409.31," D ^DIK
 S X=$$GET1^DIQ(4,+Y_",",11)
 I X'["N"!'$$TF^XUAF4(+Y) W !,*7,"Invalid Entry. Must be 'National' Institution." G SB1A
 I '$D(^SDWL(409.31,DA,"I","B",+Y)) D
 .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
 I $D(^SDWL(409.31,DA,"I","B",+Y)) S DA(1)=DA,DA=$O(^(+Y,0))
 K DIC,DIE,DIR,DR
 W ! S DR="1;3",DIE="^SDWL(409.31,"_DA(1)_","_"""I"""_"," D ^DIE
 I $P(^SDWL(409.31,DA(1),"I",DA,0),U,2)="" D
 .W *7,!,"This ENTRY requires an ACTIVATION DATE. ENTRY deleted."
 .S DIK="^SDWL(409.31,"_DA(1)_","_"""I"""_"," D ^DIK I '$P(^SDWL(409.31,DA(1),"I",0),U,3) D
 ..S DIK="^SDWL(409.31,",DA=DA(1) D ^DIK
 K DA,DA(1),SDWLDSS,DIC,DR,DIE,DI,DIEDA,DIG,DIH,DIIENS,DIR,DIU,DIV
 Q
SB2 N STR,INST,DIC,SDWLSC,SDWLSTOP S SDWLSTOP=0
 W ! S DIC(0)="AEMNZ",DIC("A")="Select Clinic: ",DIC=44
 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)"
 S DIC("W")="S STR=$$CLIN^SDWLPE(+Y) I STR W ?50,""- "",$E($P(STR,U,3),1,25),""("",$P(STR,U,2),"")"""
 D ^DIC I Y<1 K DIC,DA Q
 Q:$D(DUOUT)  S SDWLSC=+Y S INST=+STR  ;$$CLIN(SDWLSC)
 I $P(STR,U,6)'="" W !,*7,$P(STR,U,6) G SB2
 N SDANEW S SDANEW=""
 I '$D(^SDWL(409.32,"B",SDWLSC)) D
 .S DIC(0)="LX",X=SDWLSC,DIC="^SDWL(409.32," D FILE^DICN
 .N DA S DA=$O(^SDWL(409.32,"B",SDWLSC,"")) S SDANEW=DA
 .S DIE="^SDWL(409.32,",DR=".02////^S X=INST" D ^DIE
 N DA,SDA S DA=$O(^SDWL(409.32,"B",SDWLSC,"")),SDA=DA
 S DR="1",DIE="^SDWL(409.32," D ^DIE
 I SDANEW,'X D  D ESB2 H 1 G SB2
 .W *7,!!,"This ENTRY requires an ACTIVATION DATE. ENTRY deleted."
 .S DA=SDANEW S DIK="^SDWL(409.32," D ^DIK
 I X S DR="2////^S X=DUZ" D ^DIE
 N DIC
 S SDWLSCN=$P($G(^SDWL(409.32,SDA,0)),U,1) D  Q:SDWLSTOP
 .I $D(^SDWL(409.3,"SC",SDWLSCN)) D
 ..S SDWLN="",SDWLCNT=0 F  S SDWLN=$O(^SDWL(409.3,"SC",SDWLSCN,SDWLN)) Q:SDWLN=""  D
 ...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
 ..I SDWLSTOP W !,"This Clinic has Patients on the Wait List and can not be inactivated."  H 2 Q
 .S DR="4////^S X=DUZ" D ^DIE
 S DR="3",DIE="^SDWL(409.32," D ^DIE
ESB2 ;
 K DR,DIE,DIC,Y,X,SDWLY,DIC(0),DO,DA,DI,DIW,SDWLX,SDWLSCN,SDWLF
 Q
SWT ;SWITCH FOR INACTIVATION OF PARAMETER FILE
 Q
HD ;HEADER
 W:$D(IOF) @IOF W !!,?80-$L("Wait List Parameter Enter/Edit")\2,"Wait List Parameter Enter/Edit",!
 W !,?80-$L("------------------------------")\2,"------------------------------",!
END K SDWLSTOP,DIR,DIC,DR,DIK,SDWLX,SDWLSCN,SDWLF,SDWLY,SDWLSC,SDWLN,SDWLCNT,SDWLDSS,DUOUT,X,Y
 Q
CLIN(CL) ;identify clinic institution through DIVISON ----> INSTITUTION path.
 ; function to return:
 ;                     1                        2                     3               4                    5       6        7
 ; - 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
 ;           ( INST^STA NUM^SNAM^DIV^N/L^MESS^TYPE )
 ;           N/L - N -National/L -Local
 ;           TYPE - type of entry in file # 44 (field #2)
 ;                 C:CLINIC
 ;                 M:MODULE
 ;                 W:WARD
 ;                 Z:OTHER LOCATION
 ;                 N:NON-CLINIC STOP
 ;                 F:FILE AREA
 ;                 I:IMAGING
 ;                OR:OPERATING ROOM
 ;           
 ;        with optional Message:
 ;        
 ;        if STA=""
 ;        -  INST^^SNAM^DIV^N/L^' - No Station Number on file' ^ TYPE
 ;          or
 ;        -  0^^^DIV^^' - No Institution has been identified '^ TYPE
 ;        -  0^^^-1^^'  - No Division has been identified' ^ TYPE
 ;        
 ;        if entry is inactivated:
 ;        
 ;        -  INST^^SNAM^DIV^N/L^' - Inactive treating medical facility' ^ TYPE
 ;        -  -1^^^^^' -  No clinic on file' ^
 ;        
 I +CL=0!'$D(^SC(+CL)) Q -1_"^^^^^ - No clinic on file^"
 N SDWMES,STN,DIV,INS,SNL,STR,SNAM S SDWMES="",STN=""
 N TYPE S TYPE=$$GET1^DIQ(44,CL_",",2,"E")
 S DIV=+$$GET1^DIQ(44,CL_",",3.5,"I")
 I DIV=0 S SDWMES=" - No Division has been identified" Q 0_"^^^"_-1_"^^"_SDWMES_U_TYPE
 S INS=+$$GET1^DIQ(40.8,DIV_",",.07,"I")
 I INS=0 S SDWMES=" - No Institution has been identified" Q 0_"^^^"_DIV_"^^"_SDWMES_U_TYPE
 E  S STR=$$NS^XUAF4(INS),STN=$P(STR,U,2),SNAM=$P(STR,U) ;station number and name
 I STN="" S SDWMES=" - No Station Number on file"
 I '$$TF^XUAF4(INS) S SDWMES=SDWMES_" - Inactive treating medical facility"
 S SNL=$$GET1^DIQ(4,INS_",",11,"I")
 Q INS_U_STN_U_SNAM_U_DIV_U_SNL_U_SDWMES_U_TYPE