SD5384PT ;ALB/MLI - clean-up routine to remove credit stop code encounters ; 12 Dec 96 @ 10:02
;;5.3;Scheduling;**84**;AUG 13, 1993
;
; This routine will loop through the Outpatient Encounter file for a date range and
; look for credit stop codes which are:
;
; a. associated with location where the stop code is the same as the
; credit stop code.
;
; b. associated with a non-count clinic.
;
; Credit stop code encounters (originating process = 4) found which meet one of
; the above criteria will be deleted.
;
; The variables SDBEGDT and SDENDDT can be set prior to calling EN if a date range
; other than 10/1/96 through the present is desired. The process will be queued
; and a mail message of findings will be sent.
;
; If SDNODEL is defined, no data will be deleted.
;
;
EN ; process task
N SDCOUNT,SDSTART
S SDSTART=$$NOW^XLFDT()
D LOOP ; loop through entries and delete
D MAIL ; build mail message of results
Q
;
;
LOOP ; loop through encounter file and delete bogus credit stop entries
;
; Input Variables (all optional):
; SDBEGDT = Beginning date of encounter search (default 2961001)
; SDENDDT = Ending date of encounter search (default DT)
; SDCLINIC = array of specific locations to look at (otherwise all)
; SDNODEL = 1 if data should not be deleted during run
;
; Variables used:
; SDALL = 1 if all clinics searched...otherwise 0
; SDDATE = loop counter for encounter date
; SDENC = loop counter for IEN of outpt encounter file
; SDNODE = 0 node of ^SCE
; SDCRED = credit stop code pointer
; SDCOUNT = counter, subscripted by location IEN, of deleted credit
; stop code encounters
;
N SDALL,SDCRED,SDDATE,SDENC,SDNODE,SDPAR
S SDBEGDT=$G(SDBEGDT,2961001),SDENDDT=$G(SDENDDT,DT)+.9
S SDALL='$O(SDCLINIC(0)),SDDATE=SDBEGDT-.1
F S SDDATE=$O(^SCE("B",SDDATE)) Q:'SDDATE!(SDDATE>SDENDDT) D
. S SDENC=""
. F S SDENC=$O(^SCE("B",SDDATE,SDENC)) Q:'SDENC D
. . S SDNODE=$G(^SCE(SDENC,0))
. . I $P(SDNODE,"^",8)'=4 Q ; not a credit stop encounter
. . I 'SDALL D Q ; if only select clinics chosen
. . . I $D(SDCLINIC(+$P(SDNODE,"^",4))) D DEL(SDENC) ; delete credit associated with location
. . S SDCRED=$P(SDNODE,"^",3)
. . S SDPAR=$G(^SCE(+$P(SDNODE,"^",6),0)) ; get parent encounter
. . I $P(SDPAR,"^",12)=12 D DEL(SDENC) Q ; delete credit for non-counts
. . I SDCRED=$P(SDPAR,"^",3) D DEL(SDENC) Q ; delete if credit stop = stop
LOOPQ Q
;
;
DEL(IEN) ; delete encounter and increment counter by location
;
; Input - IEN of Outpatient Encounter file
;
N DA,DIK,LOC
S LOC=$P($G(^SCE(IEN,0)),"^",4)
S SDCOUNT(LOC)=$G(SDCOUNT(LOC))+1
S DIK="^SCE("
S DA=IEN
I '$G(SDNODEL) D ^DIK
Q
;
;
MAIL ; send bulletin of results
N DIFROM,SDTEXT
S SDCOUNT=0
D LINE("The Credit Stop Code Encounter clean-up has run to completion at "_$P($$SITE^VASITE(),"^",2)_"."),LINE("")
D LINE(" Start Time: "_$$FMTE^XLFDT(SDSTART))
D LINE(" End Time: "_$$FMTE^XLFDT($$NOW^XLFDT())),LINE("")
I '$O(SDCLINIC(0)) D
. D LINE("Credit stop code encounters for all clinics were deleted IF either:")
. D LINE(" a. the credit stop code associated with the clinic was equal")
. D LINE(" to the stop code associated with the clinic.")
. D LINE(" b. the clinic was set up as NON-COUNT.")
. D LINE("")
. D LINE("The following is a list of clinics for which credit stop code")
. D LINE("encounters were deleted:")
. F I=0:0 S I=$O(SDCOUNT(I)) Q:'I D LINE(" #"_I_" - "_$P($G(^SC(I,0)),"^",1)_"..."_+SDCOUNT(I)_" encounters deleted")
. I '$O(SDCOUNT(0)) D LINE(" No credit stop code encounters were found meeting the above criteria.")
E D
. D LINE("Credit stop code encounters were deleted for the following")
. D LINE("Hospital Locations:")
. F I=0:0 S I=$O(SDCLINIC(I)) Q:'I D LINE(" #"_I_" - "_$P($G(^SC(I,0)),"^",1)_"..."_+$G(SDCOUNT(I))_" encounters deleted")
S XMSUB="Credit Stop Code Encounter Clean-up is Complete",XMN=0
S XMTEXT="SDTEXT("
S XMDUZ=.5,XMY(DUZ)=""
D ^XMD
K XMDUZ,XMN,XMSUB,XMTEXT,XMY
Q
;
;
LINE(TEXT) ; add text to mail message
S SDCOUNT=SDCOUNT+1,SDTEXT(SDCOUNT)=TEXT
Q
;
;
CLINIC ; entry point if a site wants to delete ALL credit stop encounters associated with one (or more) hospital location(s)
;
; do not use without consulting customer support or development first...
;
N SDCLINIC
S VAUTVB="SDCLINIC",VAUTSTR="clinic",VAUTNALL=1,VAUTNI=2
S DIC="^SC(",DIC("S")="I $P(^(0),U,3)=""C"""
D FIRST^VAUTOMA
I Y'<0 W !!,"Queuing credit stop encounter cleanup:" D QUEUE
D RETRAN
Q
;
;
QUEUE ; queue process to run
N I
S ZTDESC="Credit stop code encounter clean-up process"
S ZTIO=""
F I="SDBEGDT","SDENDDT","SDCLINIC","SDNODEL" S ZTSAVE(I)=""
S ZTRTN="EN^SD5384PT"
D ^%ZTLOAD
I $D(ZTSK) W !,"Task number = ",ZTSK
K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
Q
;
;
RETRAN ; flag errors of one type to retransmit
N DTOUT,DIROUT,DIRUT,DUOUT,ERROR,X,Y,DIR,SDLOOP
S DIR(0)="P^409.76:AQEMZ"
D ^DIR
I Y'>0 Q
S ERROR=+Y,SDLOOP=0
F S SDLOOP=$O(^SD(409.75,SDLOOP)) Q:'SDLOOP S X=$G(^(SDLOOP,0)) D
. I $P(X,"^",2)=ERROR D XMITFLAG^SCDXFU01(+X,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD5384PT 5530 printed Sep 23, 2025@20:21:58 Page 2
SD5384PT ;ALB/MLI - clean-up routine to remove credit stop code encounters ; 12 Dec 96 @ 10:02
+1 ;;5.3;Scheduling;**84**;AUG 13, 1993
+2 ;
+3 ; This routine will loop through the Outpatient Encounter file for a date range and
+4 ; look for credit stop codes which are:
+5 ;
+6 ; a. associated with location where the stop code is the same as the
+7 ; credit stop code.
+8 ;
+9 ; b. associated with a non-count clinic.
+10 ;
+11 ; Credit stop code encounters (originating process = 4) found which meet one of
+12 ; the above criteria will be deleted.
+13 ;
+14 ; The variables SDBEGDT and SDENDDT can be set prior to calling EN if a date range
+15 ; other than 10/1/96 through the present is desired. The process will be queued
+16 ; and a mail message of findings will be sent.
+17 ;
+18 ; If SDNODEL is defined, no data will be deleted.
+19 ;
+20 ;
EN ; process task
+1 NEW SDCOUNT,SDSTART
+2 SET SDSTART=$$NOW^XLFDT()
+3 ; loop through entries and delete
DO LOOP
+4 ; build mail message of results
DO MAIL
+5 QUIT
+6 ;
+7 ;
LOOP ; loop through encounter file and delete bogus credit stop entries
+1 ;
+2 ; Input Variables (all optional):
+3 ; SDBEGDT = Beginning date of encounter search (default 2961001)
+4 ; SDENDDT = Ending date of encounter search (default DT)
+5 ; SDCLINIC = array of specific locations to look at (otherwise all)
+6 ; SDNODEL = 1 if data should not be deleted during run
+7 ;
+8 ; Variables used:
+9 ; SDALL = 1 if all clinics searched...otherwise 0
+10 ; SDDATE = loop counter for encounter date
+11 ; SDENC = loop counter for IEN of outpt encounter file
+12 ; SDNODE = 0 node of ^SCE
+13 ; SDCRED = credit stop code pointer
+14 ; SDCOUNT = counter, subscripted by location IEN, of deleted credit
+15 ; stop code encounters
+16 ;
+17 NEW SDALL,SDCRED,SDDATE,SDENC,SDNODE,SDPAR
+18 SET SDBEGDT=$GET(SDBEGDT,2961001)
SET SDENDDT=$GET(SDENDDT,DT)+.9
+19 SET SDALL='$ORDER(SDCLINIC(0))
SET SDDATE=SDBEGDT-.1
+20 FOR
SET SDDATE=$ORDER(^SCE("B",SDDATE))
if 'SDDATE!(SDDATE>SDENDDT)
QUIT
Begin DoDot:1
+21 SET SDENC=""
+22 FOR
SET SDENC=$ORDER(^SCE("B",SDDATE,SDENC))
if 'SDENC
QUIT
Begin DoDot:2
+23 SET SDNODE=$GET(^SCE(SDENC,0))
+24 ; not a credit stop encounter
IF $PIECE(SDNODE,"^",8)'=4
QUIT
+25 ; if only select clinics chosen
IF 'SDALL
Begin DoDot:3
+26 ; delete credit associated with location
IF $DATA(SDCLINIC(+$PIECE(SDNODE,"^",4)))
DO DEL(SDENC)
End DoDot:3
QUIT
+27 SET SDCRED=$PIECE(SDNODE,"^",3)
+28 ; get parent encounter
SET SDPAR=$GET(^SCE(+$PIECE(SDNODE,"^",6),0))
+29 ; delete credit for non-counts
IF $PIECE(SDPAR,"^",12)=12
DO DEL(SDENC)
QUIT
+30 ; delete if credit stop = stop
IF SDCRED=$PIECE(SDPAR,"^",3)
DO DEL(SDENC)
QUIT
End DoDot:2
End DoDot:1
LOOPQ QUIT
+1 ;
+2 ;
DEL(IEN) ; delete encounter and increment counter by location
+1 ;
+2 ; Input - IEN of Outpatient Encounter file
+3 ;
+4 NEW DA,DIK,LOC
+5 SET LOC=$PIECE($GET(^SCE(IEN,0)),"^",4)
+6 SET SDCOUNT(LOC)=$GET(SDCOUNT(LOC))+1
+7 SET DIK="^SCE("
+8 SET DA=IEN
+9 IF '$GET(SDNODEL)
DO ^DIK
+10 QUIT
+11 ;
+12 ;
MAIL ; send bulletin of results
+1 NEW DIFROM,SDTEXT
+2 SET SDCOUNT=0
+3 DO LINE("The Credit Stop Code Encounter clean-up has run to completion at "_$PIECE($$SITE^VASITE(),"^",2)_".")
DO LINE("")
+4 DO LINE(" Start Time: "_$$FMTE^XLFDT(SDSTART))
+5 DO LINE(" End Time: "_$$FMTE^XLFDT($$NOW^XLFDT()))
DO LINE("")
+6 IF '$ORDER(SDCLINIC(0))
Begin DoDot:1
+7 DO LINE("Credit stop code encounters for all clinics were deleted IF either:")
+8 DO LINE(" a. the credit stop code associated with the clinic was equal")
+9 DO LINE(" to the stop code associated with the clinic.")
+10 DO LINE(" b. the clinic was set up as NON-COUNT.")
+11 DO LINE("")
+12 DO LINE("The following is a list of clinics for which credit stop code")
+13 DO LINE("encounters were deleted:")
+14 FOR I=0:0
SET I=$ORDER(SDCOUNT(I))
if 'I
QUIT
DO LINE(" #"_I_" - "_$PIECE($GET(^SC(I,0)),"^",1)_"..."_+SDCOUNT(I)_" encounters deleted")
+15 IF '$ORDER(SDCOUNT(0))
DO LINE(" No credit stop code encounters were found meeting the above criteria.")
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 DO LINE("Credit stop code encounters were deleted for the following")
+18 DO LINE("Hospital Locations:")
+19 FOR I=0:0
SET I=$ORDER(SDCLINIC(I))
if 'I
QUIT
DO LINE(" #"_I_" - "_$PIECE($GET(^SC(I,0)),"^",1)_"..."_+$GET(SDCOUNT(I))_" encounters deleted")
End DoDot:1
+20 SET XMSUB="Credit Stop Code Encounter Clean-up is Complete"
SET XMN=0
+21 SET XMTEXT="SDTEXT("
+22 SET XMDUZ=.5
SET XMY(DUZ)=""
+23 DO ^XMD
+24 KILL XMDUZ,XMN,XMSUB,XMTEXT,XMY
+25 QUIT
+26 ;
+27 ;
LINE(TEXT) ; add text to mail message
+1 SET SDCOUNT=SDCOUNT+1
SET SDTEXT(SDCOUNT)=TEXT
+2 QUIT
+3 ;
+4 ;
CLINIC ; entry point if a site wants to delete ALL credit stop encounters associated with one (or more) hospital location(s)
+1 ;
+2 ; do not use without consulting customer support or development first...
+3 ;
+4 NEW SDCLINIC
+5 SET VAUTVB="SDCLINIC"
SET VAUTSTR="clinic"
SET VAUTNALL=1
SET VAUTNI=2
+6 SET DIC="^SC("
SET DIC("S")="I $P(^(0),U,3)=""C"""
+7 DO FIRST^VAUTOMA
+8 IF Y'<0
WRITE !!,"Queuing credit stop encounter cleanup:"
DO QUEUE
+9 DO RETRAN
+10 QUIT
+11 ;
+12 ;
QUEUE ; queue process to run
+1 NEW I
+2 SET ZTDESC="Credit stop code encounter clean-up process"
+3 SET ZTIO=""
+4 FOR I="SDBEGDT","SDENDDT","SDCLINIC","SDNODEL"
SET ZTSAVE(I)=""
+5 SET ZTRTN="EN^SD5384PT"
+6 DO ^%ZTLOAD
+7 IF $DATA(ZTSK)
WRITE !,"Task number = ",ZTSK
+8 KILL ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
+9 QUIT
+10 ;
+11 ;
RETRAN ; flag errors of one type to retransmit
+1 NEW DTOUT,DIROUT,DIRUT,DUOUT,ERROR,X,Y,DIR,SDLOOP
+2 SET DIR(0)="P^409.76:AQEMZ"
+3 DO ^DIR
+4 IF Y'>0
QUIT
+5 SET ERROR=+Y
SET SDLOOP=0
+6 FOR
SET SDLOOP=$ORDER(^SD(409.75,SDLOOP))
if 'SDLOOP
QUIT
SET X=$GET(^(SDLOOP,0))
Begin DoDot:1
+7 IF $PIECE(X,"^",2)=ERROR
DO XMITFLAG^SCDXFU01(+X,0)
End DoDot:1
+8 QUIT
