SD5384NC ;ALB/MLI - Non-count encounter cleanup ; January 13, 1996
;;5.3;Scheduling;**84,1015**;AUG 13, 1993;Build 21
;
; This routine will update encounters to be non-count for locations
; selected. It was written to correct problems caused when clinics
; were changed to non-count after 10/1/96. It will also delete any
; related entries from the Transmitted Outpatient Encounter file.
;
; To run, call the routine from the top (D ^SD5384NC). You will be
; asked for one or more hospital location entries which are set-up
; as non-count. You will be asked for a date range where you can
; select beginning 10/1/96 and ending today's date. It is STRONGLY
; recommended that you select the range where the problem actually
; occurred to reduce the amount of processing this routine will
; have to do. For example, if you changed the locations to non-count
; on 11/4/96, enter 11/4/96 as your end date.
;
EN ; ask questions, queue process
N DIROUT,DIRUT,DTOUT,DUOUT,RANGE,SDBEG,SDEND,SDLOC
D GETLOC(.SDLOC) I '$O(SDLOC(0)) G ENQ
W ! S RANGE=$$GETDTRNG^SCDXUTL1(2961001,$P($$NOW^XLFDT(),".",1)) I RANGE<0 G ENQ
S SDBEG=$P(RANGE,"^"),SDEND=$P(RANGE,"^",2)
D QUEUE ; to queue process
;D DQ ; for testing
ENQ Q
;
;
GETLOC(ARRAY) ; get list of location(s)
S DIC="^SC(",DIC("S")="I $P(^(0),""^"",17)=""Y"""
S VAUTSTR="clinic",VAUTNI=2,VAUTVB="ARRAY",VAUTNALL=1
D FIRST^VAUTOMA
Q
;
;
QUEUE ; queue job
N I,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
S ZTIO="",ZTDESC="Reset non-count encounters",ZTRTN="DQ^SD5384NC"
F I="SDLOC(","SDBEG","SDEND" S ZTSAVE(I)=""
D ^%ZTLOAD
I $G(ZTSK) W !,"Task queued: #",ZTSK
Q
;
;
DQ ; dequeue point...collect results and generate message.
N SDCOUNT,SDSTART
S SDSTART=$$NOW^XLFDT()
S SDCOUNT=0
D COLLECT
D RESULTS
Q
;
;
COLLECT ; collect data
N OK,SDI,SDJ,SDX
F SDI=SDBEG:0 S SDI=$O(^SCE("B",SDI)) Q:'SDI!(SDI>(SDEND+.9)) D
. F SDJ=0:0 S SDJ=$O(^SCE("B",SDI,SDJ)) Q:'SDJ D
. . ;
. . S SDX=$G(^SCE(SDJ,0)) I 'SDX Q ; no 0 node
. . S SDLOC=+$P(SDX,"^",4) ; location of encounter
. . I '$D(SDLOC(SDLOC)) Q ; not for a selected location
. . I $P(SDX,"^",6) Q ; child encounter
. . I $P(SDX,"^",12)=12 Q ; not non-count
. . ;
. . D FILE("^SCE(",SDJ,".12////12") ; file as non-count
. . D EN^SDCOM(SDJ,0,,.ERROR) ; call to update check-out
. . S OK=$$DELXMIT^SCDXFU03(SDJ,1) ; delete trans outpt enc entry
. . ;
. . S $P(SDLOC(SDLOC),"^",2)=$P(SDLOC(SDLOC),"^",2)+1 ; increment counter by location
Q
;
;
FILE(DIE,DA,DR) ; update entry defined in DA in file DIE with DR string
N X,Y
D ^DIE
Q
;
;
RESULTS ; generate an e-mail bulletin when done
N DIFROM,I,LINE,X
S SDCOUNT=0
D LINE("The Non-count Encounter cleanup has run to completion."),LINE("")
D LINE(" Start Time: "_$$FMTE^XLFDT(SDSTART))
D LINE(" End Time: "_$$FMTE^XLFDT($$NOW^XLFDT())),LINE("")
F I=0:0 S I=$O(SDLOC(I)) Q:'I D
. S X=+$P(SDLOC(I),"^",2)
. I X=1 S LINE="1 entry"
. I X=0 S LINE="No entries"
. I X>1 S LINE=X_" entries"
. S LINE=LINE_" updated to be non-count for "_$P(SDLOC(I),"^",1)_" clinic (IEN #"_I_")"
. D LINE(LINE)
S XMSUB="Non-count Encounter Cleanup is Complete",XMN=0
S XMTEXT="SDTEXT("
S XMDUZ=.5,XMY(DUZ)=""
D ^XMD
K SDCOUNT,SDTEXT,XMDUZ,XMN,XMSUB,XMTEXT,XMY
Q
;
;
LINE(TEXT) ; add text to mail message
S SDCOUNT=SDCOUNT+1,SDTEXT(SDCOUNT)=TEXT
Q
SD5384NC ;ALB/MLI - Non-count encounter cleanup ; January 13, 1996
+1 ;;5.3;Scheduling;**84,1015**;AUG 13, 1993;Build 21
+2 ;
+3 ; This routine will update encounters to be non-count for locations
+4 ; selected. It was written to correct problems caused when clinics
+5 ; were changed to non-count after 10/1/96. It will also delete any
+6 ; related entries from the Transmitted Outpatient Encounter file.
+7 ;
+8 ; To run, call the routine from the top (D ^SD5384NC). You will be
+9 ; asked for one or more hospital location entries which are set-up
+10 ; as non-count. You will be asked for a date range where you can
+11 ; select beginning 10/1/96 and ending today's date. It is STRONGLY
+12 ; recommended that you select the range where the problem actually
+13 ; occurred to reduce the amount of processing this routine will
+14 ; have to do. For example, if you changed the locations to non-count
+15 ; on 11/4/96, enter 11/4/96 as your end date.
+16 ;
EN ; ask questions, queue process
+1 NEW DIROUT,DIRUT,DTOUT,DUOUT,RANGE,SDBEG,SDEND,SDLOC
+2 DO GETLOC(.SDLOC)
IF '$ORDER(SDLOC(0))
GOTO ENQ
+3 WRITE !
SET RANGE=$$GETDTRNG^SCDXUTL1(2961001,$PIECE($$NOW^XLFDT(),".",1))
IF RANGE<0
GOTO ENQ
+4 SET SDBEG=$PIECE(RANGE,"^")
SET SDEND=$PIECE(RANGE,"^",2)
+5 ; to queue process
DO QUEUE
+6 ;D DQ ; for testing
ENQ QUIT
+1 ;
+2 ;
GETLOC(ARRAY) ; get list of location(s)
+1 SET DIC="^SC("
SET DIC("S")="I $P(^(0),""^"",17)=""Y"""
+2 SET VAUTSTR="clinic"
SET VAUTNI=2
SET VAUTVB="ARRAY"
SET VAUTNALL=1
+3 DO FIRST^VAUTOMA
+4 QUIT
+5 ;
+6 ;
QUEUE ; queue job
+1 NEW I,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
+2 SET ZTIO=""
SET ZTDESC="Reset non-count encounters"
SET ZTRTN="DQ^SD5384NC"
+3 FOR I="SDLOC(","SDBEG","SDEND"
SET ZTSAVE(I)=""
+4 DO ^%ZTLOAD
+5 IF $GET(ZTSK)
WRITE !,"Task queued: #",ZTSK
+6 QUIT
+7 ;
+8 ;
DQ ; dequeue point...collect results and generate message.
+1 NEW SDCOUNT,SDSTART
+2 SET SDSTART=$$NOW^XLFDT()
+3 SET SDCOUNT=0
+4 DO COLLECT
+5 DO RESULTS
+6 QUIT
+7 ;
+8 ;
COLLECT ; collect data
+1 NEW OK,SDI,SDJ,SDX
+2 FOR SDI=SDBEG:0
SET SDI=$ORDER(^SCE("B",SDI))
IF 'SDI!(SDI>(SDEND+.9))
QUIT
Begin DoDot:1
+3 FOR SDJ=0:0
SET SDJ=$ORDER(^SCE("B",SDI,SDJ))
IF 'SDJ
QUIT
Begin DoDot:2
+4 ;
+5 ; no 0 node
SET SDX=$GET(^SCE(SDJ,0))
IF 'SDX
QUIT
+6 ; location of encounter
SET SDLOC=+$PIECE(SDX,"^",4)
+7 ; not for a selected location
IF '$DATA(SDLOC(SDLOC))
QUIT
+8 ; child encounter
IF $PIECE(SDX,"^",6)
QUIT
+9 ; not non-count
IF $PIECE(SDX,"^",12)=12
QUIT
+10 ;
+11 ; file as non-count
DO FILE("^SCE(",SDJ,".12////12")
+12 ; call to update check-out
DO EN^SDCOM(SDJ,0,,.ERROR)
+13 ; delete trans outpt enc entry
SET OK=$$DELXMIT^SCDXFU03(SDJ,1)
+14 ;
+15 ; increment counter by location
SET $PIECE(SDLOC(SDLOC),"^",2)=$PIECE(SDLOC(SDLOC),"^",2)+1
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
+18 ;
FILE(DIE,DA,DR) ; update entry defined in DA in file DIE with DR string
+1 NEW X,Y
+2 DO ^DIE
+3 QUIT
+4 ;
+5 ;
RESULTS ; generate an e-mail bulletin when done
+1 NEW DIFROM,I,LINE,X
+2 SET SDCOUNT=0
+3 DO LINE("The Non-count Encounter cleanup has run to completion.")
DO LINE("")
+4 DO LINE(" Start Time: "_$$FMTE^XLFDT(SDSTART))
+5 DO LINE(" End Time: "_$$FMTE^XLFDT($$NOW^XLFDT()))
DO LINE("")
+6 FOR I=0:0
SET I=$ORDER(SDLOC(I))
IF 'I
QUIT
Begin DoDot:1
+7 SET X=+$PIECE(SDLOC(I),"^",2)
+8 IF X=1
SET LINE="1 entry"
+9 IF X=0
SET LINE="No entries"
+10 IF X>1
SET LINE=X_" entries"
+11 SET LINE=LINE_" updated to be non-count for "_$PIECE(SDLOC(I),"^",1)_" clinic (IEN #"_I_")"
+12 DO LINE(LINE)
End DoDot:1
+13 SET XMSUB="Non-count Encounter Cleanup is Complete"
SET XMN=0
+14 SET XMTEXT="SDTEXT("
+15 SET XMDUZ=.5
SET XMY(DUZ)=""
+16 DO ^XMD
+17 KILL SDCOUNT,SDTEXT,XMDUZ,XMN,XMSUB,XMTEXT,XMY
+18 QUIT
+19 ;
+20 ;
LINE(TEXT) ; add text to mail message
+1 SET SDCOUNT=SDCOUNT+1
SET SDTEXT(SDCOUNT)=TEXT
+2 QUIT
