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

SDWLBACC.m

Go to the documentation of this file.
  1. SDWLBACC ;;IOFO BAY PINES/OG - BATCH CHANGE EWL CLINIC ; Compiled August 14, 2007 11:20:57
  1. ;;5.3;scheduling;**446**;AUG 13 1993;Build 77
  1. ;
  1. ; ******************************************************************
  1. ; CHANGE LOG
  1. ;
  1. ; DATE PATCH DESCRIPTION
  1. ; ---- ----- -----------
  1. ;
  1. ;
  1. N SDWLERR,SDWLOPT,SDWLSCL,SDWLHD,SDWLIN1,SDWLIN2,SDWLCL0,SDWLCL1,SDWLCL2,SDWLCSC1,SDWLCSC2,SDWLCM
  1. S SDWLHD="Scheduling/PCMM Batch Change EWL Clinic"
  1. W:$D(IOF) @IOF W !?80-$L(SDWLHD)\2,SDWLHD,!
  1. S SDWLERR=0,SDWLOPT=1,(SDWLIN2,SDWLCL1,SDWLCL2,SDWLCM)="",SDWLIN1=+$$SITE^VASITE()
  1. F D @("P"_SDWLOPT) Q:'SDWLOPT
  1. Q
  1. P1 ; Source Institution
  1. S DIR(0)="PAO^DIC(4,:EMNZ"
  1. S DIR("A")="Select Source Institution: "
  1. I SDWLIN1'="" S DIR("B")=$$GET1^DIQ(4,SDWLIN1,.01)
  1. S DIR("S")="I $E($$GET1^DIQ(4,+Y,99),1,3)=$E(+$P($$SITE^VASITE(),U,3),1,3)"
  1. D ^DIR
  1. I Y<1 S SDWLOPT=0 Q
  1. S (SDWLIN1,SDWLIN2)=+Y,SDWLOPT=SDWLOPT+1
  1. Q
  1. P2 ; Source Clinic
  1. N DIR,SDWLSC
  1. S DIR(0)="PAO^SDWL(409.32,:EMNZ"
  1. S DIR("A")="Select Source Clinic: "
  1. I SDWLCL1'="" S DIR("B")=$$GET1^DIQ(409.32,SDWLCL1,.01)
  1. S DIR("S")="S X=$$GET1^DIQ(409.32,+Y,.01,""I"") I $P($$CLIN^SDWLBACC(X),U)=SDWLIN1"
  1. D ^DIR
  1. I Y="^" S SDWLOPT=0 Q
  1. I Y<1 S SDWLOPT=SDWLOPT-1 Q
  1. S SDWLCL0=+Y ; Wait list specific clinic
  1. S SDWLCL1=$P(Y,U,2) ; pointer to HOSPITAL LOCATION file
  1. S SDWLCSC1=$$GET1^DIQ(44,SDWLCL1,8,"I")_U_$$GET1^DIQ(44,SDWLCL1,8) ; Clinic stop code
  1. S SDWLOPT=SDWLOPT+1
  1. Q
  1. P3 ; Destination Institution
  1. S DIR(0)="PAO^DIC(4,:EMNZ"
  1. S DIR("A")="Select Destination Institution: "
  1. I SDWLIN1'="" S DIR("B")=$$GET1^DIQ(4,SDWLIN2,.01)
  1. S DIR("S")="I $E($$GET1^DIQ(4,+Y,99),1,3)=$E(+$P($$SITE^VASITE(),U,3),1,3)"
  1. D ^DIR
  1. I Y="^" S SDWLOPT=0 Q
  1. I Y<1 S SDWLOPT=SDWLOPT-1 Q
  1. S SDWLIN2=+Y,SDWLOPT=SDWLOPT+1
  1. Q
  1. P4 ; Destination Clinic
  1. N DIR,SDWLSC,SDWLY
  1. S DIR(0)="PAO^SDWL(409.32,:EMNZ"
  1. S DIR("A")="Select Destination Clinic: "
  1. I SDWLCL2'="" S DIR("B")=$$GET1^DIQ(409.32,SDWLCL2,.01)
  1. S DIR("S")="S X=$$GET1^DIQ(409.32,+Y,.01,""I"") I $P($$CLIN^SDWLBACC(X),U)=SDWLIN2,+Y'=SDWLCL0"
  1. D ^DIR
  1. I Y="^" S SDWLOPT=0 Q
  1. I Y<1 S SDWLOPT=SDWLOPT-1 Q
  1. S SDWLY=+Y,SDWLSC=$P(Y,U,2) ; pointer to HOSPITAL LOCATION file
  1. ; get clinic's stop code. warn if different.
  1. S SDWLCSC2=$$GET1^DIQ(44,SDWLSC,8,"I")_U_$$GET1^DIQ(44,SDWLSC,8) ; Clinic's stop code
  1. I +SDWLCSC1'=+SDWLCSC2 D Q:'Y
  1. .S DIR(0)="Y"
  1. .S DIR("A")="The clinics' stop codes are different, continue"
  1. .S DIR("A",1)=$$GET1^DIQ(409.32,SDWLCL1,.01)_": "_$P(SDWLCSC1,U,2)_" ("_+SDWLCSC1_")"
  1. .S DIR("A",2)=$$GET1^DIQ(409.32,+Y,.01)_": "_$P(SDWLCSC2,U,2)_" ("_+SDWLCSC2_")"
  1. .S DIR("B")="YES"
  1. .D ^DIR
  1. .S:Y="^" SDWLOPT=0
  1. .Q
  1. S SDWLSCL=SDWLY,SDWLOPT=SDWLOPT+1
  1. Q
  1. P5 ; Comment
  1. D P4^SDWLE6
  1. Q
  1. P6 ; Confirmation and processing
  1. N DIR,Y
  1. S DIR(0)="Y"
  1. S DIR("A")="Proceed with batch clinic change"
  1. S DIR("B")="YES"
  1. D ^DIR
  1. D:Y CHNGCL
  1. S SDWLOPT=0
  1. Q
  1. CHNGCL ;
  1. N DIR,SDWLDA,SDWLCNT
  1. S SDWLDA="",SDWLCNT=0
  1. F S SDWLDA=$O(^SDWL(409.3,"SC",SDWLCL1,SDWLDA)) Q:'SDWLDA D
  1. .N DA,DIE,DIR,DR,SDWLDFN,SDWLIN,SDWLTMP,SDWLORDT,SDWLSCPG,SDWLSCPR,SDWLCL1,SDWLDDT,SDWLEEST,Y
  1. .D GETS^DIQ(409.3,SDWLDA_",","1;14;15;22;23;27","I","SDWLTMP")
  1. .Q:SDWLTMP(409.3,SDWLDA_",",23,"I")="C" ; Only open entries.
  1. .S SDWLDFN=$$GET1^DIQ(409.3,SDWLDA,.01,"I")
  1. .S SDWLORDT=SDWLTMP(409.3,SDWLDA_",",1,"I")
  1. .S SDWLSCPG=SDWLTMP(409.3,SDWLDA_",",14,"I")
  1. .S SDWLSCPR=SDWLTMP(409.3,SDWLDA_",",15,"I")
  1. .S SDWLDDT=SDWLTMP(409.3,SDWLDA_",",22,"I")
  1. .S SDWLEEST=SDWLTMP(409.3,SDWLDA_",",27,"I")
  1. .Q:'$$UPDATE^SDWLE7(SDWLDFN,SDWLORDT,SDWLIN2,SDWLSCL,SDWLSCPG,SDWLSCPR,SDWLDDT,SDWLCM,SDWLEEST,SDWLDA)
  1. .; disposition old entry
  1. .S DIE="^SDWL(409.3,",DA=SDWLDA,DR="19////^S X=DT;20////^S X=DUZ;21////^S X=""CL"";23////^S X=""C"""
  1. .D ^DIE
  1. .S SDWLCNT=SDWLCNT+1
  1. .Q
  1. W ! W:SDWLCNT "Clinics changed. " W SDWLCNT," entries processed."
  1. S DIR(0)="E" D ^DIR
  1. Q
  1. CLIN(CL) ;identify clinic institution through DIVISON ----> INSTITUTION path.
  1. ; function to return:
  1. ; - Institution pointer to ^DIC(4 _U_ STATION number (# 99) _U_ Inst Name _U_ Div Pointer to ^DG(40.8 _U_N/L_U_Message
  1. ; ( INST^STA NUM^SNAM^DIV^N/L^MESS )
  1. ; N/L - N -National/L -Local
  1. ; with Message:
  1. ; - if STA="" INST^^SNAM^DIV^^N/L^' - No Station Number on file'
  1. ; or
  1. ; - 0^^^DIV^^' - No Institution has been identified'
  1. ; - 0^^^-1^^' - no Division has been identified'
  1. ; - -1 no clinic on file'
  1. I '$D(^SC(+CL)) Q -1_"^^^^^no clinic on file"
  1. N SDWMES,STN,DIV,INS,SNL,STR,SNAM S SDWMES="",STN=""
  1. S DIV=+$$GET1^DIQ(44,CL_",",3.5,"I")
  1. I DIV=0 S SDWMES="no Division has been identified" Q 0_"^^^"_-1_"^^"_SDWMES
  1. S INS=+$$GET1^DIQ(40.8,DIV_",",.07,"I")
  1. I INS=0 S SDWMES="No Institution has been identified" Q 0_"^^^"_DIV_"^"_SDWMES
  1. E S STR=$$NS^XUAF4(INS),STN=$P(STR,U,2),SNAM=$P(STR,U) ;station number and name
  1. I STN="" S SDWMES="No Station Number on file"
  1. I '$$TF^XUAF4(INS) S SDWMES="Inactive treating medical facility"
  1. S SNL=$$GET1^DIQ(4,INS_",",11,"I")
  1. Q INS_U_STN_U_SNAM_U_DIV_U_SNL_U_SDWMES