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