SD53227P ;ALB/RBS - Find Encounter/Visit Date/Time 421 error ; 10/11/00 4:59pm
;;5.3;Scheduling;**227,1015**;AUG 13, 1993;Build 21
;
;DBIA Integration Reference # 3211 to update #9000010 VISIT file.
; *** Calling routine is SD53P227 ***
;
;This routine will search for Encounters that have a invalid date
;and time setup causing a 421 error code to be setup.
;
;The ^XTMP global will be used as an audit file for 30 days from
;date of running the Clean Up & Report option.
; ^XTMP("SD53P227",0)=STRING of 10 fields
; STRING = purge date^run date^start dt/time^stop dt/time...
; ^tot errors^tot fixed^tot searched
; ^XTMP("SD53P227",1)=error node of encounters that can't be fixed
; ^XTMP("SD53P227",2)=encounters that can be fixed and re-sent
; ^XTMP("SD53P227",3)=e-mail report sent to user
; ^XTMP("SD53P227,"SENT")=audit trial of all encounters fixed
;
; @SDTEMP@ = ^XTMP("SD53P227")
;
Q
;*;
FIND ; Search file for error pointer (ie...30 = 421)
N CODE421,ENCPTR,ERRPTR,ERRNODE,NEWENDT,OK,OK1,OK2,SCENODE,SCEDATE,SCEDFN,SDDT,SDPNAM
N SDSSN,SDCLN,STRING,TOTALS,VSITDATE,VSITPTR,XMITPTR,XMITNODE,X,Y,Z
S (ERRPTR,EXIT,TOTALS)=0
S CODE421=+$O(^SD(409.76,"B",421,0)) ;get pointer to error codes
I 'CODE421 D Q ;no error's - QUIT process
.D NOFIND^SD53227
.S EXIT=1
S:$D(@SDTEMP@(0)) TOTALS=$P(@SDTEMP@(0),U,8,10)
F S ERRPTR=+$O(^SD(409.75,ERRPTR)) Q:('ERRPTR) D Q:EXIT
.I ($$S^%ZTLOAD) S EXIT=1 Q
.S ERRNODE=$G(^SD(409.75,ERRPTR,0))
.S X=+$P(ERRNODE,U,2)
.Q:(X'=CODE421)
.; Get pointer to Transmitted Outpatient Encounter file (#409.73)
.S XMITPTR=+$G(^SD(409.75,ERRPTR,0))
.Q:('$D(^SD(409.73,XMITPTR,0)))
.S XMITNODE=$G(^SD(409.73,XMITPTR,0))
.; Get pointer to Outpatient Encounter file (#409.68)
.S ENCPTR=+$P(XMITNODE,U,2)
.;
.Q:$D(@SDTEMP@("SENT",ERRPTR,XMITPTR,ENCPTR)) ;already fixed
.;
.; Get pointer to Visit file (#9000010) - ^AUPNVSIT
.S SCENODE=$G(^SCE(ENCPTR,0))
.Q:SCENODE=""
.; date.time - patient DPT( pointer - visit pointer
.S SCEDATE=$P(SCENODE,U),SCEDFN=$P(SCENODE,U,2),VSITPTR=+$P(SCENODE,U,5)
.; get patient name - SSN
.S SDPNAM=$G(^DPT(SCEDFN,0)),SDSSN=$P(SDPNAM,U,9),SDPNAM=$P(SDPNAM,U)
.S SDCLN=$P($G(^SC(+$P(SCENODE,U,4),0)),U) ;hospital location
.S STRING=VSITPTR_U_SDPNAM_U_SCEDFN_U_SDSSN_U_SDCLN_U_SCEDATE
.S $P(TOTALS,U,3)=$P(TOTALS,U,3)+1 ;total records
.;
.; Check Encounter date/time
.S (NEWENDT,OK,OK1,OK2)=0
.D CKDATE(SCEDATE,.OK) ;check date
.I OK D Q ;bad Date
..D ADD(STRING,"* INVALID DATE *",1)
.;
.D CKTIME(SCEDATE,.NEWENDT,.OK) ;check time
.I OK D Q ;can't fix Date/Time
..D ADD(STRING,"* INVALID TIME *",1)
.;
.I NEWENDT=SCEDATE D Q ;date & time OK, nothings wrong
..D ADD(STRING,"* Date/Time OK *",1)
.;
.S OK1=1 ;new encounter date and time reset was OK
.;
.; API - Get #9000010 file - .01 VISIT/ADMIT DATE&TIME field
.;S VSITDATE=$$VISADDAT^PXAAVSIT(VSITPTR)
.S VSITDATE=$P($G(^AUPNVSIT(VSITPTR,0)),"^",1)
.; Check if Visit d/t equals original Encounter d/t...then OK2
.S:VSITDATE=SCEDATE OK2=1
.;
.; Visit d/t different
.I OK1,'OK2 D Q
..D ADD(STRING_U_VSITDATE,"*VISIT D/T Diff.*",1)
.;
.; Everything is OK
.I OK1,OK2 D
..D:FIX FIX(ENCPTR,XMITPTR,VSITPTR,NEWENDT,.OK) ;update files
..Q:OK ;can't fix
..D ADD(STRING,NEWENDT,2) ;OK to update
;
S $P(@SDTEMP@(0),U,8,10)=TOTALS ;add totals string to ^XTMP
Q
;
ADD(STR,X,Z) ; Setup file entry
; Setup either error node(1) or fix node(2) or sent node("SENT")
; STR = string of ien pointers, patient info, original date/time
; X = the new date/time or error message.
; Z = node subscript to setup data
; ERRPTR - IEN for Transmitted Outpatient Encounter error file
; (#409.75)
; XMITPTR - Pointer to Transmitted Outpatient Encounter file
; (#409.73)
; ENCPTR - Pointer to entry in Outpatient Encounter file
; (#409.68)
S @SDTEMP@(Z,ERRPTR,XMITPTR,ENCPTR)=STR_U_X
S @SDTEMP@(Z)=$G(@SDTEMP@(Z))+1
S:+Z $P(TOTALS,U,Z)=$P(TOTALS,U,Z)+1
Q
;
FIX(ENCPTR,XMITPTR,VSITPTR,NEWENDT,ERR) ; Fix #409.68 & #9000010 files
;Input : ENCPTR - Pointer to entry in Outpatient Encounter file
; (#409.68)
; XMITPTR - Pointer to Transmitted Outpatient Encounter file
; (#409.73)
; VSITPTR - Pointer to Visit file
; (#9000010)
; NEWENDT - New date/time (FileMan format)
; ERR - Check for OK or not(0=OK, 1=error)
;
;Output : ERR - 0=OK, 1=error
;
Q:'FIX ;Not time to update records
;
N SCFDA,IENS,SCERR
S IENS=ENCPTR_","
S SCFDA(409.68,IENS,".01")=NEWENDT ;#409.68 - Encounter file
;
L +^SCE(ENCPTR):2
I '$T D Q ;can't lock record
.D ADD(STRING,"* #409.68 Error *",1)
.S OK=1
;
; if nothing is wrong, "SCERR" will be un-defined...
D FILE^DIE("","SCFDA","SCERR")
I $D(SCERR) D Q ;somethings wrong
.D ADD(STRING,"* #409.68 Error* ",1)
.L -^SCE(ENCPTR)
;
; #9000010 API call to PCE for Filing update to .01 Visit/Admit field
S SCERR=0
D FILE(VSITPTR,NEWENDT,.SCERR)
I SCERR D Q ;somethings wrong
.D ADD(STRING,"* #9000010 Error *",1)
.L -^SCE(ENCPTR)
;
; Re-flag encounters for transmission
D STREEVNT^SCDXFU01(XMITPTR) ;Log the event
D XMITFLAG^SCDXFU01(XMITPTR) ;Flag record for transmission
;
L -^SCE(ENCPTR)
;
D ADD(STRING,NEWENDT,"SENT") ;Audit trail - ^XTMP(,"SENT"
Q
;
CKDATE(SDDT,ERR) ; Check Encounter and Visit Date
N CKDATE
S CKDATE=$P(SDDT,"."),ERR=0
S ERR=+$$DATE(CKDATE) ;validate date
Q
;
DATE(DAT) ; Validate FileMan date only
N DATE,X,Y,%DT
S DATE=$P(DAT,"."),X=DATE,%DT="X" D ^%DT
I Y<0 Q 1
Q 0
;
CKTIME(SDDT,NEWENDT,ERR) ; check and validate new date/time
; we are dropping all seconds before trying to validate hour/min
N CKTIME,NEWTIME,X,Y,%DT
S (NEWENDT,NEWTIME,ERR)=0,CKTIME=$P(SDDT,".",2)
I $L(CKTIME)>6 S CKTIME=$E(CKTIME,1,6)
;convert to external d/t first, then validate back to internal d/t
S Y=$P(SDDT,".")_"."_CKTIME
D DD^%DT S X=Y,%DT="ST" D ^%DT
I Y<0 D ;reset time
.S CKTIME=$E(CKTIME_"0000",1,4) ;drop all seconds
.S NEWTIME=+$$TIME(CKTIME) ;try to setup new time
.S NEWENDT=$P(SDDT,".")_NEWTIME ;concatenate date w/new time
.S Y=NEWENDT D DD^%DT S X=Y,%DT="ST" D ^%DT ;re-validate date/time
I Y<0 S ERR=1 Q
S NEWENDT=Y
Q
;
TIME(TIM) ; Break out hours and minutes
N TIME,HR,MIN,SEC
S HR=$E(TIM,1,2),MIN=$E(TIM,3,4),SEC=$E(TIM,5,6)
S:(HR>23) HR=23,MIN=59,SEC=""
S:(MIN>59) MIN=59
S:(SEC>59) SEC=59
S TIME=HR_MIN_SEC
Q:'TIME 0
;Done - return time (trailing zeros removed)
Q +("."_TIME)
;
FILE(IEN,VDT,ERR) ; Update #9000010 VISIT File - .01 Visit/Admit d/t field
; input - IEN = visit internal entry number to ^AUPNVSIT(#)
; - VDT = new date and time (FM internal d/t format)
; - ERR = check for Filing OK
; output - ERR = 0 = Filing complete
; 1 = Filing error
N SDFDA,IENS,SDERR,X,Y
S ERR=0
I '($D(^AUPNVSIT(IEN,0))#2) S ERR=1 Q ;not a valid visit ien
I VDT']"" S ERR=1 Q
L +^AUPNVSIT(IEN):2 I '$T S ERR=1 Q ;can't lock
S IENS=IEN_","
S SDFDA(9000010,IENS,".01")=VDT ;#9000010 - Visit file
D FILE^DIE("","SDFDA","SDERR") ;file new .01 date/time
L -^AUPNVSIT(IEN)
S:$D(SDERR) ERR=1
Q
SD53227P ;ALB/RBS - Find Encounter/Visit Date/Time 421 error ; 10/11/00 4:59pm
+1 ;;5.3;Scheduling;**227,1015**;AUG 13, 1993;Build 21
+2 ;
+3 ;DBIA Integration Reference # 3211 to update #9000010 VISIT file.
+4 ; *** Calling routine is SD53P227 ***
+5 ;
+6 ;This routine will search for Encounters that have a invalid date
+7 ;and time setup causing a 421 error code to be setup.
+8 ;
+9 ;The ^XTMP global will be used as an audit file for 30 days from
+10 ;date of running the Clean Up & Report option.
+11 ; ^XTMP("SD53P227",0)=STRING of 10 fields
+12 ; STRING = purge date^run date^start dt/time^stop dt/time...
+13 ; ^tot errors^tot fixed^tot searched
+14 ; ^XTMP("SD53P227",1)=error node of encounters that can't be fixed
+15 ; ^XTMP("SD53P227",2)=encounters that can be fixed and re-sent
+16 ; ^XTMP("SD53P227",3)=e-mail report sent to user
+17 ; ^XTMP("SD53P227,"SENT")=audit trial of all encounters fixed
+18 ;
+19 ; @SDTEMP@ = ^XTMP("SD53P227")
+20 ;
+21 QUIT
+22 ;*;
FIND ; Search file for error pointer (ie...30 = 421)
+1 NEW CODE421,ENCPTR,ERRPTR,ERRNODE,NEWENDT,OK,OK1,OK2,SCENODE,SCEDATE,SCEDFN,SDDT,SDPNAM
+2 NEW SDSSN,SDCLN,STRING,TOTALS,VSITDATE,VSITPTR,XMITPTR,XMITNODE,X,Y,Z
+3 SET (ERRPTR,EXIT,TOTALS)=0
+4 ;get pointer to error codes
SET CODE421=+$ORDER(^SD(409.76,"B",421,0))
+5 ;no error's - QUIT process
IF 'CODE421
Begin DoDot:1
+6 DO NOFIND^SD53227
+7 SET EXIT=1
End DoDot:1
QUIT
+8 IF $DATA(@SDTEMP@(0))
SET TOTALS=$PIECE(@SDTEMP@(0),U,8,10)
+9 FOR
SET ERRPTR=+$ORDER(^SD(409.75,ERRPTR))
IF ('ERRPTR)
QUIT
Begin DoDot:1
+10 IF ($$S^%ZTLOAD)
SET EXIT=1
QUIT
+11 SET ERRNODE=$GET(^SD(409.75,ERRPTR,0))
+12 SET X=+$PIECE(ERRNODE,U,2)
+13 IF (X'=CODE421)
QUIT
+14 ; Get pointer to Transmitted Outpatient Encounter file (#409.73)
+15 SET XMITPTR=+$GET(^SD(409.75,ERRPTR,0))
+16 IF ('$DATA(^SD(409.73,XMITPTR,0)))
QUIT
+17 SET XMITNODE=$GET(^SD(409.73,XMITPTR,0))
+18 ; Get pointer to Outpatient Encounter file (#409.68)
+19 SET ENCPTR=+$PIECE(XMITNODE,U,2)
+20 ;
+21 ;already fixed
IF $DATA(@SDTEMP@("SENT",ERRPTR,XMITPTR,ENCPTR))
QUIT
+22 ;
+23 ; Get pointer to Visit file (#9000010) - ^AUPNVSIT
+24 SET SCENODE=$GET(^SCE(ENCPTR,0))
+25 IF SCENODE=""
QUIT
+26 ; date.time - patient DPT( pointer - visit pointer
+27 SET SCEDATE=$PIECE(SCENODE,U)
SET SCEDFN=$PIECE(SCENODE,U,2)
SET VSITPTR=+$PIECE(SCENODE,U,5)
+28 ; get patient name - SSN
+29 SET SDPNAM=$GET(^DPT(SCEDFN,0))
SET SDSSN=$PIECE(SDPNAM,U,9)
SET SDPNAM=$PIECE(SDPNAM,U)
+30 ;hospital location
SET SDCLN=$PIECE($GET(^SC(+$PIECE(SCENODE,U,4),0)),U)
+31 SET STRING=VSITPTR_U_SDPNAM_U_SCEDFN_U_SDSSN_U_SDCLN_U_SCEDATE
+32 ;total records
SET $PIECE(TOTALS,U,3)=$PIECE(TOTALS,U,3)+1
+33 ;
+34 ; Check Encounter date/time
+35 SET (NEWENDT,OK,OK1,OK2)=0
+36 ;check date
DO CKDATE(SCEDATE,.OK)
+37 ;bad Date
IF OK
Begin DoDot:2
+38 DO ADD(STRING,"* INVALID DATE *",1)
End DoDot:2
QUIT
+39 ;
+40 ;check time
DO CKTIME(SCEDATE,.NEWENDT,.OK)
+41 ;can't fix Date/Time
IF OK
Begin DoDot:2
+42 DO ADD(STRING,"* INVALID TIME *",1)
End DoDot:2
QUIT
+43 ;
+44 ;date & time OK, nothings wrong
IF NEWENDT=SCEDATE
Begin DoDot:2
+45 DO ADD(STRING,"* Date/Time OK *",1)
End DoDot:2
QUIT
+46 ;
+47 ;new encounter date and time reset was OK
SET OK1=1
+48 ;
+49 ; API - Get #9000010 file - .01 VISIT/ADMIT DATE&TIME field
+50 ;S VSITDATE=$$VISADDAT^PXAAVSIT(VSITPTR)
+51 SET VSITDATE=$PIECE($GET(^AUPNVSIT(VSITPTR,0)),"^",1)
+52 ; Check if Visit d/t equals original Encounter d/t...then OK2
+53 IF VSITDATE=SCEDATE
SET OK2=1
+54 ;
+55 ; Visit d/t different
+56 IF OK1
IF 'OK2
Begin DoDot:2
+57 DO ADD(STRING_U_VSITDATE,"*VISIT D/T Diff.*",1)
End DoDot:2
QUIT
+58 ;
+59 ; Everything is OK
+60 IF OK1
IF OK2
Begin DoDot:2
+61 ;update files
IF FIX
DO FIX(ENCPTR,XMITPTR,VSITPTR,NEWENDT,.OK)
+62 ;can't fix
IF OK
QUIT
+63 ;OK to update
DO ADD(STRING,NEWENDT,2)
End DoDot:2
End DoDot:1
IF EXIT
QUIT
+64 ;
+65 ;add totals string to ^XTMP
SET $PIECE(@SDTEMP@(0),U,8,10)=TOTALS
+66 QUIT
+67 ;
ADD(STR,X,Z) ; Setup file entry
+1 ; Setup either error node(1) or fix node(2) or sent node("SENT")
+2 ; STR = string of ien pointers, patient info, original date/time
+3 ; X = the new date/time or error message.
+4 ; Z = node subscript to setup data
+5 ; ERRPTR - IEN for Transmitted Outpatient Encounter error file
+6 ; (#409.75)
+7 ; XMITPTR - Pointer to Transmitted Outpatient Encounter file
+8 ; (#409.73)
+9 ; ENCPTR - Pointer to entry in Outpatient Encounter file
+10 ; (#409.68)
+11 SET @SDTEMP@(Z,ERRPTR,XMITPTR,ENCPTR)=STR_U_X
+12 SET @SDTEMP@(Z)=$GET(@SDTEMP@(Z))+1
+13 IF +Z
SET $PIECE(TOTALS,U,Z)=$PIECE(TOTALS,U,Z)+1
+14 QUIT
+15 ;
FIX(ENCPTR,XMITPTR,VSITPTR,NEWENDT,ERR) ; Fix #409.68 & #9000010 files
+1 ;Input : ENCPTR - Pointer to entry in Outpatient Encounter file
+2 ; (#409.68)
+3 ; XMITPTR - Pointer to Transmitted Outpatient Encounter file
+4 ; (#409.73)
+5 ; VSITPTR - Pointer to Visit file
+6 ; (#9000010)
+7 ; NEWENDT - New date/time (FileMan format)
+8 ; ERR - Check for OK or not(0=OK, 1=error)
+9 ;
+10 ;Output : ERR - 0=OK, 1=error
+11 ;
+12 ;Not time to update records
IF 'FIX
QUIT
+13 ;
+14 NEW SCFDA,IENS,SCERR
+15 SET IENS=ENCPTR_","
+16 ;#409.68 - Encounter file
SET SCFDA(409.68,IENS,".01")=NEWENDT
+17 ;
+18 LOCK +^SCE(ENCPTR):2
+19 ;can't lock record
IF '$TEST
Begin DoDot:1
+20 DO ADD(STRING,"* #409.68 Error *",1)
+21 SET OK=1
End DoDot:1
QUIT
+22 ;
+23 ; if nothing is wrong, "SCERR" will be un-defined...
+24 DO FILE^DIE("","SCFDA","SCERR")
+25 ;somethings wrong
IF $DATA(SCERR)
Begin DoDot:1
+26 DO ADD(STRING,"* #409.68 Error* ",1)
+27 LOCK -^SCE(ENCPTR)
End DoDot:1
QUIT
+28 ;
+29 ; #9000010 API call to PCE for Filing update to .01 Visit/Admit field
+30 SET SCERR=0
+31 DO FILE(VSITPTR,NEWENDT,.SCERR)
+32 ;somethings wrong
IF SCERR
Begin DoDot:1
+33 DO ADD(STRING,"* #9000010 Error *",1)
+34 LOCK -^SCE(ENCPTR)
End DoDot:1
QUIT
+35 ;
+36 ; Re-flag encounters for transmission
+37 ;Log the event
DO STREEVNT^SCDXFU01(XMITPTR)
+38 ;Flag record for transmission
DO XMITFLAG^SCDXFU01(XMITPTR)
+39 ;
+40 LOCK -^SCE(ENCPTR)
+41 ;
+42 ;Audit trail - ^XTMP(,"SENT"
DO ADD(STRING,NEWENDT,"SENT")
+43 QUIT
+44 ;
CKDATE(SDDT,ERR) ; Check Encounter and Visit Date
+1 NEW CKDATE
+2 SET CKDATE=$PIECE(SDDT,".")
SET ERR=0
+3 ;validate date
SET ERR=+$$DATE(CKDATE)
+4 QUIT
+5 ;
DATE(DAT) ; Validate FileMan date only
+1 NEW DATE,X,Y,%DT
+2 SET DATE=$PIECE(DAT,".")
SET X=DATE
SET %DT="X"
DO ^%DT
+3 IF Y<0
QUIT 1
+4 QUIT 0
+5 ;
CKTIME(SDDT,NEWENDT,ERR) ; check and validate new date/time
+1 ; we are dropping all seconds before trying to validate hour/min
+2 NEW CKTIME,NEWTIME,X,Y,%DT
+3 SET (NEWENDT,NEWTIME,ERR)=0
SET CKTIME=$PIECE(SDDT,".",2)
+4 IF $LENGTH(CKTIME)>6
SET CKTIME=$EXTRACT(CKTIME,1,6)
+5 ;convert to external d/t first, then validate back to internal d/t
+6 SET Y=$PIECE(SDDT,".")_"."_CKTIME
+7 DO DD^%DT
SET X=Y
SET %DT="ST"
DO ^%DT
+8 ;reset time
IF Y<0
Begin DoDot:1
+9 ;drop all seconds
SET CKTIME=$EXTRACT(CKTIME_"0000",1,4)
+10 ;try to setup new time
SET NEWTIME=+$$TIME(CKTIME)
+11 ;concatenate date w/new time
SET NEWENDT=$PIECE(SDDT,".")_NEWTIME
+12 ;re-validate date/time
SET Y=NEWENDT
DO DD^%DT
SET X=Y
SET %DT="ST"
DO ^%DT
End DoDot:1
+13 IF Y<0
SET ERR=1
QUIT
+14 SET NEWENDT=Y
+15 QUIT
+16 ;
TIME(TIM) ; Break out hours and minutes
+1 NEW TIME,HR,MIN,SEC
+2 SET HR=$EXTRACT(TIM,1,2)
SET MIN=$EXTRACT(TIM,3,4)
SET SEC=$EXTRACT(TIM,5,6)
+3 IF (HR>23)
SET HR=23
SET MIN=59
SET SEC=""
+4 IF (MIN>59)
SET MIN=59
+5 IF (SEC>59)
SET SEC=59
+6 SET TIME=HR_MIN_SEC
+7 IF 'TIME
QUIT 0
+8 ;Done - return time (trailing zeros removed)
+9 QUIT +("."_TIME)
+10 ;
FILE(IEN,VDT,ERR) ; Update #9000010 VISIT File - .01 Visit/Admit d/t field
+1 ; input - IEN = visit internal entry number to ^AUPNVSIT(#)
+2 ; - VDT = new date and time (FM internal d/t format)
+3 ; - ERR = check for Filing OK
+4 ; output - ERR = 0 = Filing complete
+5 ; 1 = Filing error
+6 NEW SDFDA,IENS,SDERR,X,Y
+7 SET ERR=0
+8 ;not a valid visit ien
IF '($DATA(^AUPNVSIT(IEN,0))#2)
SET ERR=1
QUIT
+9 IF VDT']""
SET ERR=1
QUIT
+10 ;can't lock
LOCK +^AUPNVSIT(IEN):2
IF '$TEST
SET ERR=1
QUIT
+11 SET IENS=IEN_","
+12 ;#9000010 - Visit file
SET SDFDA(9000010,IENS,".01")=VDT
+13 ;file new .01 date/time
DO FILE^DIE("","SDFDA","SDERR")
+14 LOCK -^AUPNVSIT(IEN)
+15 IF $DATA(SDERR)
SET ERR=1
+16 QUIT
