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

SD53P491.m

Go to the documentation of this file. 
  1. SD53P491 ;ALB/ESW - SD*5.3*491 POST INIT; Oct 04, 2006 ; 10/23/06 5:40pm  ; Compiled June 17, 2008 10:41:32
  1.  ;;5.3;SCHEDULING;**491**;AUG 13, 1993;Build 53
  1.  ;Remove trigger - field .01 in the SD WL CLINIC LOCATION file (# 409.32)
  1.  ;Verify setup of Billable Appointment type: ein=11 - SC
  1.  ;Update encounters with Appointment Type matching the SC set up on the encounter level
  1.  ;Update file 409.32 and 409.3 with proper institution set up
  1.  ;Retransmission of updated encounters has been disabled
  1.  Q
  1.  ;
  1. POST ;
  1.  N SDA
  1.  S SDA(1)="",SDA(2)="    SD*5.3*491 Post-Install .....",SDA(3)="" D ATADDQ
  1.  N SDA
  1.  S SDA(1)="",SDA(2)=" Deleting cross-reference definition - trigger of the CLINIC field"
  1.  S SDA(3)=" in the SD WL CLINIC LOCATION file (# 409.32)",SDA(4)=""
  1.  D DELIX^DDMOD(409.32,.01,2,"K") D ATADDQ
  1.  ;
  1.  D ATADD ; Verify Billable Appointment Type: ien=11
  1.  ;  ^IBE(352.1,11,0)=11^11^2880101^0^1^1
  1.  S SDA(1)="",SDA(2)="  SD*5.3*491 SC Billable Appointment Type error checking is complete",SDA(3)="" D ATADDQ
  1.  N SDA
  1.  S SDA(1)="",SDA(2)="Starting Appointment Type verification for Outpatient Encounter file entries",SDA(3)="with encounter-level Service Connection for encounter entries created",SDA(4)="Jan 20, 2006 or later",SDA(5)="" D ATADDQ
  1.  ;
  1.  D CHKSC
  1.  N SDA
  1.  S SDA(1)="",SDA(2)="Appointment Type correction to file 409.68 and to sub-file 2.98 finished.",SDA(3)="" D ATADDQ
  1.  ;
  1.  N SDA
  1.  S SDA(1)="",SDA(2)="Checking file 409.32 and 409.3 for valid national institutions, and pointers",SDA(3)="that don't match institutions of the Medical Center Division of their related",SDA(4)="Hospital Location",SDA(5)="" D ATADDQ
  1.  N INERROR,SDWLSC,SDX,CNT S INERROR=""
  1.  S SDX(1)="Checking file 409.32 and 409.3 for valid national institutions, and pointers"
  1.  S SDX(2)="that don't match institutions of the Medical Center Division of their related"
  1.  S SDX(3)="Hospital Location"
  1.  S SDX(4)="",CNT=4 S SDWLSC=0 F  S SDWLSC=$O(^SDWL(409.32,SDWLSC)) Q:'SDWLSC  D UPDINS(SDWLSC,.CNT,.INERROR)
  1.  D MSGG(.SDX)
  1.  Q:INERROR
  1.  N DIK S DIK="SDWL(409.32," D IXALL^DIK
  1.  N SDA
  1.  S SDA(1)="",SDA(2)="Verification and update of files 409.32 and 409.3",SDA(3)=" with proper institution finished.",SDA(4)="",SDA(5)="   SD*5.3*491 Post-Install finished...."
  1.  D ATADDQ
  1.  Q
  1.  ;
  1. ATADD ; New Billable Appointment Type (352.1) to correspond to the New 'SERVICE CONNECTED' Appointment Type (409.1)
  1.  N DD,DO,DLAYGO,DINUM,DIC,DIE,DA,DR,X,Y,SDA,IBFOUND,SDATFN,IBNUM,SDAT,IBFN
  1.  S SDA(1)="      >> Verifying 'Service Connected' Billable Appointment Type (#352.1)"
  1.  S (SDATFN,IBNUM)=11,SDAT="SERVICE CONNECTED"
  1.  S IBFOUND=$G(^IBE(352.1,SDATFN,0)) ; new IA confirmed to be created
  1.  I IBFOUND="11^11^2880101^0^1^1" D  D ATADDQ Q
  1.  .D MSG("    Done.  Billable Appointment Type Service Connected is set up properly")
  1.  D MSG(" "),MSG("* ERROR IN CONFIGURATION OF ENTRY IEN=11 IN FILE 352.1 *")
  1.  D MSG("IT IS MANDATORY THAT YOU CREATE AN INTEGRATED BILLING REMEDY TICKET"),MSG("Entry 11 should be configured for the SERVICE CONNECTED appointment type.")
  1.  D MSG(" --------------------------") D ATADDQ
  1.  Q 
  1. ATADDQ D MES^XPDUTL(.SDA) K SDA
  1.  Q
  1. CHKSC ;Match SC encounter value with proper Appointment Type.
  1.  ; look for encounters only
  1.  N SCE,CNT,CNTA S CNT=0,CNTA=0
  1.  ;SCE - EIN of Outpatient Encounter
  1.  K ^XTMP("SD53P491-"_$J),^XTMP("SD53P491AP-"_$J)
  1.  S ^XTMP("SD53P491-"_$J,0)=$$FMADD^XLFDT(""_DT_"",7)_U_DT
  1.  S ^XTMP("SD53P491AP-"_$J,0)=$$FMADD^XLFDT(""_DT_"",7)_U_DT
  1.  S SCE=0
  1.  F  S SCE=$O(^SCE(SCE)) Q:SCE'>0  I $P($G(^SCE(SCE,"USER")),U,4)>3060120  D
  1.  .N STR,SDSCV,SDT,SDVST,DFN,SDAPDF,SDVSCL S STR=$G(^SCE(SCE,0))
  1.  .S DFN=$P(STR,U,2),SDT=+STR,SDVSCL=$P(STR,U,4)
  1.  .S SDVST=$P($G(STR),U,5)
  1.  .Q:'SDVST  Q:'$D(^AUPNVSIT(SDVST,800))
  1.  .S SDSCV=$$GET1^DIQ(9000010,SDVST_",",80001,"I") ;SC flag in Visit file
  1.  .Q:SDSCV=""  ;do not proceed if SC not determined
  1.  .S SDAPDF=$$GET1^DIQ(44,SDVSCL_",",2507,"I") ;default appt type
  1.  .I SDAPDF'="" S SDAPDPT=SDAPDF ; set to default if exists for this clinic
  1.  .E  S SDAPDPT=9 ; set to regular
  1.  .N UPDAP I SDSCV S UPDAP=11
  1.  .E  S UPDAP=SDAPDPT
  1.  .N SDR D APPT(DFN,SDT,SCE,UPDAP,.SDR)
  1.  .I $P(^SCE(SCE,0),U,10)=11 D  ; change only if original appt type was SC
  1.  ..Q:SDSCV
  1.  ..M ^XTMP("SD53P491-"_$J,DFN,SDT,SCE)=^SCE(SCE,0) S CNT=CNT+1
  1.  ..S $P(^SCE(SCE,0),U,10)=SDAPDPT
  1.  ..;I 'SDR D RETR(SCE)
  1.  .E  D
  1.  ..Q:'SDSCV
  1.  ..; change only if original appt type was SC
  1.  ..M ^XTMP("SD53P491-"_$J,DFN,SDT,SCE)=^SCE(SCE,0) S CNT=CNT+1
  1.  ..S $P(^SCE(SCE,0),U,10)=11
  1.  ..;I 'SDR D RETR(SCE)
  1.  .D CRST(SDVST,SDSCV,SDAPDPT,.CNT)
  1.  N SDA
  1.  S SDA(1)="",SDA(2)="  "_CNT_" OUTPATIENT ENCOUNTER entry(ies) updated with an Appointment Type."
  1.  S SDA(3)="  "_CNTA_" APPOINTMENT Multiple entry(ies) in the PATIENT file updated"
  1.  S SDA(4)="       "_"with an Appointment Type."
  1.  S SDA(5)=""
  1.  D ATADDQ
  1.  Q
  1. APPT(DFN,SDT,SCE,UPDAP,SDR) ;update appointment multiple in Patient file
  1.  N STR S STR=$G(^DPT(DFN,"S",SDT,0))
  1.  S SDR=0
  1.  I $P(STR,U,20)'=SCE Q
  1.  I $P(STR,U,16)'=UPDAP D
  1.  .M ^XTMP("SD53P491AP-"_$J,DFN,SDT,SCE)=STR
  1.  .S $P(^DPT(DFN,"S",SDT,0),U,16)=UPDAP
  1.  .S CNTA=CNTA+1,SDR=1
  1.  .;I SDR D RETR(SCE)
  1.  Q
  1. RETR(SCE) ; mark encounter for retransmission
  1.  N SDXM
  1.  S SDXM=$$FINDXMIT^SCDXFU01(SCE)
  1.  D STREEVNT^SCDXFU01(SDXM,2)
  1.  D XMITFLAG^SCDXFU01(SDXM)
  1.  Q
  1. MSG(X) ;
  1.  N SDX S SDX=$O(SDA(999999),-1) S:'SDX SDX=1 S SDX=SDX+1
  1.  S SDA(SDX)=$G(X)
  1.  Q
  1. CRST(SDVST,SDSCV,SDAPDPT,CNT) ;check for credit stop encounter for each scanned encounter
  1.  N SDVSTS,SDE S SDE="" S SDVSTS=$O(^AUPNVSIT("AD",SDVST,"")) ; only one child visit
  1.  I SDVSTS>0 S SDE=$O(^SCE("AVSIT",SDVSTS,""))
  1.  Q:'SDE
  1.  I SDSCV D
  1.  .I $P(^SCE(SDE,0),U,10)'=11 D
  1.  ..M ^XTMP("SD53P491-"_$J,DFN,SDT,SDE,1)=^SCE(SDE,0) S CNT=CNT+1
  1.  ..S $P(^SCE(SDE,0),U,10)=11
  1.  ..;D RETR(SDE)
  1.  I 'SDSCV D
  1.  .I $P(^SCE(SDE,0),U,10)=11 D
  1.  ..M ^XTMP("SD53P491-"_$J,DFN,SDT,SDE,1)=^SCE(SDE,0) S CNT=CNT+1
  1.  ..S $P(^SCE(SDE,0),U,10)=SDAPDPT
  1.  ..;D RETR(SDE)
  1.  Q
  1. UPDINS(SDWLSC,CNT,INERROR) ; update 409.32 and the related entries in 409.3
  1.  N SDWLINS S SDWLINS=$$GET1^DIQ(409.32,SDWLSC_",",.02,"I") ; current set up IN 409.32
  1.  ;check set up in file 44
  1.  ;get clinic
  1.  N CL,CLN S CL=$$GET1^DIQ(409.32,SDWLSC_",",.01,"I"),CLN=$$GET1^DIQ(44,CL_",",.01)
  1.  N STR,SDWMES S SDWMES="",STR=$$CLIN^SDWLPE(CL)
  1.  S SDWMES=SDWMES_$P(STR,U,6)
  1.  I $P(STR,U,5)="L" S CNT=CNT+1 S (SDWMES,SDX(CNT))=SDWMES_" - Local Institution assigned to clinic. "
  1.  I SDWMES'="" D  Q
  1.  .S CNT=CNT+1,SDX(CNT)=" ** Invalid configuration of Clinic "_CLN_" ("_CL_")"_": **"
  1.  .W !!,SDX(CNT)
  1.  .S CNT=CNT+1,SDX(CNT)=SDWMES
  1.  .W !,SDX(CNT)
  1.  .S CNT=CNT+1,SDX(CNT)="YOU MUST UPDATE THIS FILE 44 ENTRY'S DIVISION OR ITS MEDICAL CENTER DIVISION'S"
  1.  .W !,SDX(CNT)
  1.  .S CNT=CNT+1,SDX(CNT)="INSTITUTION FILE POINTER."
  1.  .W !,SDX(CNT)
  1.  .S CNT=CNT+1,SDX(CNT)=""
  1.  .S:INERROR="" INERROR=1 Q
  1.  I +STR'=SDWLINS D
  1.  .S CNT=CNT+1,SDX(CNT)="The Medical Center Division for file 44 Clinic "_CLN_" ("_CL_")"
  1.  .W !!,SDX(CNT)
  1.  .S CNT=CNT+1,SDX(CNT)="has a different Institution  than the file 409.32 entry for EWL."
  1.  .W !,SDX(CNT)
  1.  .N SDI,SDI1 S SDI=$$GET1^DIQ(4,SDWLINS_",",.01),SDI1=$$GET1^DIQ(4,SDWLINS_",",99)
  1.  .S CNT=CNT+1,SDX(CNT)="EWL Clinic INSTITUTION: "_SDI_" - "_SDI1
  1.  .W !,SDX(CNT)
  1.  .S CNT=CNT+1,SDX(CNT)="Clinic INSTITUTION: "_$P(STR,U,3)_" - "_$P(STR,U,2)
  1.  .W !,SDX(CNT)
  1.  .N DIE,DR,DA S DR=".02////^S X=+STR",DIE="^SDWL(409.32,",DA=SDWLSC
  1.  .L +^SDWL(409.32,DA):0 I '$T S CNT=CNT+1,SDX(CNT)="Entry locked; Run SD WAIT LIST CLEANUP later" W !?5,SDX(CNT) Q
  1.  .D ^DIE L -^SDWL(409.32,DA)
  1.  .S CNT=CNT+1,SDX(CNT)="Updated EWL Clinic to match."
  1.  .W !,SDX(CNT),!
  1.  .S CNT=CNT+1,SDX(CNT)=""
  1.  .;loop to update EWL entries in FILE 409.3 if any
  1.  .N SCL,DA,DR,CNT1 S SCL="",CNT1=0 F  S SCL=$O(^SDWL(409.3,"SC",CL,SCL)) Q:SCL'>0  D
  1.  ..I '$D(^SDWL(409.3,SCL,0)) K ^SDWL(409.3,"SC",CL,SCL) Q
  1.  ..S DR="2////^S X=+STR",DIE="^SDWL(409.3,",DA=SCL
  1.  ..L +^SDWL(409.3,SCL):0 I '$T S CNT=CNT+1,SDX(CNT)="Entry locked; Run SD WAIT LIST CLEANUP later" W !?5,SDX(CNT),! Q
  1.  ..D ^DIE L -^SDWL(409.3,SCL) S CNT1=CNT1+1
  1.  .I CNT1>0 W !,CNT1_" wait list entry(ies) for "_CLN_" clinic updated in SD WAIT LIST file #409.3." S CNT=CNT+1,SDX(CNT)=""
  1.  N DA I $$GET1^DIQ(409.32,SDWLSC_",",3,"I")="" I $$GET1^DIQ(409.32,SDWLSC_",",1,"I")'>0 D
  1.  .S DA=SDWLSC L +^SDWL(409.32,SDWLSC):0 I '$T S CNT=CNT+1,SDX(CNT)="Entry locked; Run SD WAIT LIST CLEANUP later" W !?5,SDX(CNT) Q
  1.  .S DR="1////^S X=DT;2////^S X=DUZ",DIE="^SDWL(409.32," ;enter activation date and user
  1.  .D ^DIE L -^SDWL(409.32,SDWLSC)
  1.  .S CNT=CNT+1,SDX(CNT)="EWL Clinic entry for "_CLN_" updated with today's activation date."
  1.  .W !,SDX(CNT)
  1.  .S CNT=CNT+1,SDX(CNT)=""
  1.  Q
  1. MSGG(SDX) ;send message
  1.  N SDAMX,XMSUB,XMY,XMTEXT,XMDUZ,DIFROM
  1.  S XMSUB="PATCH SD*5.3*491 POST-INSTALL: UPDATE FILES 409.3 and 409.32"
  1.  S XMY("G.SD EWL BACKGROUND UPDATE")=""
  1.  S XMY(DUZ)=""
  1.  S XMTEXT="SDX("
  1.  S CNT=$O(SDX(""),-1)
  1.  S CNT=CNT+1,SDX(CNT)=""
  1.  S CNT=CNT+1,SDX(CNT)="SD WL CLINIC LOCATION file update is finished."
  1.  W !!,SDX(CNT)
  1.  S CNT=CNT+1,SDX(CNT)="Open EWL entries in the SD WAIT LIST file have also been updated."
  1.  W !,SDX(CNT)
  1.  S CNT=CNT+1,SDX(CNT)="If invalid/local Institution pointers were indicated above for"
  1.  W !!,SDX(CNT)
  1.  S CNT=CNT+1,SDX(CNT)="Hospital Location file #44, correct the DIVISION on those clinics"
  1.  W !,SDX(CNT)
  1.  S CNT=CNT+1,SDX(CNT)="and/or the INSTITUTION FILE POINTER of the Medical Center Division"
  1.  W !,SDX(CNT)
  1.  S CNT=CNT+1,SDX(CNT)="that the clinic points to, then run option SD WAIT LIST CLEANUP"
  1.  W !,SDX(CNT)
  1.  S CNT=CNT+1,SDX(CNT)="which will update institutions in EWL files 409.32 and 409.3."
  1.  W !,SDX(CNT)
  1.  S CNT=CNT+1,SDX(CNT)=""
  1.  W !,SDX(CNT)
  1.  S CNT=CNT+1,SDX(CNT)="NOTE: SD WAIT LIST CLEANUP must be run any time corrections are made to"
  1.  W !,SDX(CNT)
  1.  S CNT=CNT+1,SDX(CNT)="a Hospital Location file #44 entry's DIVISION or to an INSTITUTION FILE POINTER"
  1.  W !,SDX(CNT)
  1.  S CNT=CNT+1,SDX(CNT)="in the Medical Center division file #40.8."
  1.  W !,SDX(CNT)
  1.  D ^XMD