SD5396PT ;ALB/JRP - CORRECT REJECTED ENCOUNTERS WITH BAD DATE/TIME;06-MAR-1997
;;5.3;Scheduling;**96**;Aug 13, 1993
;
TASK ;Entry point to schedule correction for NOW
;
;Declare variables
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,TXT
;Set up call to TaskMan
S ZTRTN="EN^SD5396PT"
S ZTDESC="ACRP correction of rejected encounters with bad date/time"
S ZTDTH=$$NOW^XLFDT()
S ZTIO=""
;Schedule task
S TXT="Correction of rejected encounters with bad date/time"
D MES^XPDUTL(TXT)
S TXT="will be scheduled to run on "_$$FMTE^XLFDT(ZTDTH)
D MES^XPDUTL(TXT)
D ^%ZTLOAD
S:(+$G(ZTSK)) TXT="Scheduled as task number "_ZTSK
S:('$G(ZTSK)) TXT="** Unable to schedule correction **"
D BMES^XPDUTL(TXT)
;Done
Q
;
EN ;Main entry point
;
;Declare variables
N CODE420,CODE421,ERRPTR,ERRNODE,XMITPTR,TMP,TIMESTRT,FIXED
N MSGTEXT,XMTEXT,XMSUB,XMY,XMCHAN,XMZ,XMDUZ
;Get pointer to error codes 420 & 421
S CODE420=+$O(^SD(409.76,"B",420,0))
Q:('CODE420)
S CODE421=+$O(^SD(409.76,"B",421,0))
Q:('CODE421)
;Remember starting time
S TIMESTRT=$$FMTE^XLFDT($$NOW^XLFDT(),1)
;Loop through rejected encounters
S FIXED=0
S ERRPTR=0
F S ERRPTR=+$O(^SD(409.75,ERRPTR)) Q:('ERRPTR) D Q:(+$G(ZTSTOP))
.I ($$S^%ZTLOAD) S ZTSTOP=1 Q
.;Get zero node
.S ERRNODE=$G(^SD(409.75,ERRPTR,0))
.;Check error code
.S TMP=+$P(ERRNODE,"^",2)
.Q:((TMP'=CODE420)&(TMP'=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)))
.;Fix date/time of entry in Transmitted Outpatient Encounter file
.D FIXDATE(XMITPTR)
.;Mark entry in Transmitted Outpatient Encounter file for retransmission
.D STREEVNT^SCDXFU01(XMITPTR)
.D XMITFLAG^SCDXFU01(XMITPTR)
.;Increment count of fixed encounters
.S FIXED=FIXED+1
;Build completion bulletin
S MSGTEXT(1)=" "
S MSGTEXT(2)="Correction was started on "_TIMESTRT
S MSGTEXT(3)="Correction ended on "_$$FMTE^XLFDT($$NOW^XLFDT(),1)
S MSGTEXT(4)=FIXED_" Outpatient Encounters were corrected"
S MSGTEXT(5)=" "
;Send completion bulletin to current user
S XMSUB="ACRP correction of rejected encounters with bad date/time completed"
S XMTEXT="MSGTEXT("
S XMY(DUZ)=""
S XMCHAN=1
S XMDUZ="ACRP - SD*5.3*96"
D ^XMD
;Done
Q
;
FIXDATE(XMITPTR) ;Fix encounter date/time for entry in 409.73
;
;Input : XMITPTR - Pointer to entry in TRANSMITTED OUTPATIENT
; ENCOUNTER file (#409.73)
;Output : None
;
;Check input
S XMITPTR=+$G(XMITPTR)
Q:('$D(^SD(409.73,XMITPTR,0)))
;Declare variables
N XMITNODE,ENCPTR,DELPTR,VSITPTR,VSITDATE
;Get zero node of entry in Transmitted Outpatient Encounter
S XMITNODE=$G(^SD(409.73,XMITPTR,0))
;Get pointer to Outpatient Encounter file (#409.68)
S ENCPTR=+$P(XMITNODE,"^",2)
;Get pointer to Deleted Outpatient Encounter file (#409.74)
S DELPTR=+$P(XMITNODE,"^",3)
Q:(('ENCPTR)&('DELPTR))
I (ENCPTR) Q:('$D(^SCE(ENCPTR,0)))
I (DELPTR) Q:('$D(^SD(409.74,DELPTR,1)))
;Determine correct date/time of encounter
I (ENCPTR) D
.;Get pointer to Visit file (#9000010)
.S VSITPTR=+$P($G(^SCE(ENCPTR,0)),"^",5)
.;Get date/time of visit
.S VSITDATE=+$G(^AUPNVSIT(VSITPTR,0))
;Determine correct date/time of deleted encounter
I (DELPTR) D
.;New date/time is validated version of currently stored date/time
.S VSITDATE=+$G(^SD(409.74,DELPTR,1))
.S VSITDATE=+$$DATECHCK^SDVSIT(VSITDATE)
;Update date/time of encounter and mark for retransmission
D NEWDATE(ENCPTR,DELPTR,VSITDATE)
;Done
Q
;
NEWDATE(ENCPTR,DELPTR,NEWDATE) ;Store new encounter date/time
;
;Input : ENCPTR - Pointer to entry in OUTPATIENT ENCOUNTER file
; (#409.68)
; DELENC - Pointer to entry in DELETED OUTPATIENT ENCOUNTER
; file (#409.74)
; NEWDATE - New date/time (FileMan format)
;Output : None
;Notes : If NEWDATE is not passed, the date/time currently on file
; will be validated and used as the new date/time
;
;Check input
S ENCPTR=+$G(ENCPTR)
I (ENCPTR) Q:('$D(^SCE(ENCPTR,0)))
S DELPTR=+$G(DELPTR)
I (DELPTR) Q:(('$D(^SD(409.74,DELPTR,0)))!('$D(^SD(409.74,DELPTR,1))))
Q:(('ENCPTR)&('DELPTR))
S NEWDATE=+$G(NEWDATE)
I ('NEWDATE) S:(ENCPTR) NEWDATE=+^SCE(ENCPTR,0) S:(DELPTR) NEWDATE=+^SD(409.74,DELPTR,1)
S NEWDATE=+$$DATECHCK^SDVSIT(NEWDATE)
;Declare variables
N SDINARR,SDOUTARR,DELNODE1,IENS
;Set up FDA array for updating Outpatient Encounter
I (ENCPTR) D
.S IENS=ENCPTR_","
.S SDINARR(409.68,IENS,.01)=NEWDATE
;Set up FDA array for updating Deleted Outpatient Encounter
I (DELPTR) D
.S IENS=DELPTR_","
.S SDINARR(409.74,IENS,.01)=NEWDATE
.S DELNODE1=^SD(409.74,DELPTR,1)
.S $P(DELNODE1,"^",1)=NEWDATE
.S SDINARR(409.74,IENS,11)=DELNODE1
;Store new encounter date/time
D FILE^DIE("","SDINARR","SDOUTARR")
;Done
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD5396PT 4916 printed Oct 16, 2024@18:46:12 Page 2
SD5396PT ;ALB/JRP - CORRECT REJECTED ENCOUNTERS WITH BAD DATE/TIME;06-MAR-1997
+1 ;;5.3;Scheduling;**96**;Aug 13, 1993
+2 ;
TASK ;Entry point to schedule correction for NOW
+1 ;
+2 ;Declare variables
+3 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,TXT
+4 ;Set up call to TaskMan
+5 SET ZTRTN="EN^SD5396PT"
+6 SET ZTDESC="ACRP correction of rejected encounters with bad date/time"
+7 SET ZTDTH=$$NOW^XLFDT()
+8 SET ZTIO=""
+9 ;Schedule task
+10 SET TXT="Correction of rejected encounters with bad date/time"
+11 DO MES^XPDUTL(TXT)
+12 SET TXT="will be scheduled to run on "_$$FMTE^XLFDT(ZTDTH)
+13 DO MES^XPDUTL(TXT)
+14 DO ^%ZTLOAD
+15 if (+$GET(ZTSK))
SET TXT="Scheduled as task number "_ZTSK
+16 if ('$GET(ZTSK))
SET TXT="** Unable to schedule correction **"
+17 DO BMES^XPDUTL(TXT)
+18 ;Done
+19 QUIT
+20 ;
EN ;Main entry point
+1 ;
+2 ;Declare variables
+3 NEW CODE420,CODE421,ERRPTR,ERRNODE,XMITPTR,TMP,TIMESTRT,FIXED
+4 NEW MSGTEXT,XMTEXT,XMSUB,XMY,XMCHAN,XMZ,XMDUZ
+5 ;Get pointer to error codes 420 & 421
+6 SET CODE420=+$ORDER(^SD(409.76,"B",420,0))
+7 if ('CODE420)
QUIT
+8 SET CODE421=+$ORDER(^SD(409.76,"B",421,0))
+9 if ('CODE421)
QUIT
+10 ;Remember starting time
+11 SET TIMESTRT=$$FMTE^XLFDT($$NOW^XLFDT(),1)
+12 ;Loop through rejected encounters
+13 SET FIXED=0
+14 SET ERRPTR=0
+15 FOR
SET ERRPTR=+$ORDER(^SD(409.75,ERRPTR))
if ('ERRPTR)
QUIT
Begin DoDot:1
+16 IF ($$S^%ZTLOAD)
SET ZTSTOP=1
QUIT
+17 ;Get zero node
+18 SET ERRNODE=$GET(^SD(409.75,ERRPTR,0))
+19 ;Check error code
+20 SET TMP=+$PIECE(ERRNODE,"^",2)
+21 if ((TMP'=CODE420)&(TMP'=CODE421))
QUIT
+22 ;Get pointer to Transmitted Outpatient Encounter file (#409.73)
+23 SET XMITPTR=+$GET(^SD(409.75,ERRPTR,0))
+24 if ('$DATA(^SD(409.73,XMITPTR,0)))
QUIT
+25 ;Fix date/time of entry in Transmitted Outpatient Encounter file
+26 DO FIXDATE(XMITPTR)
+27 ;Mark entry in Transmitted Outpatient Encounter file for retransmission
+28 DO STREEVNT^SCDXFU01(XMITPTR)
+29 DO XMITFLAG^SCDXFU01(XMITPTR)
+30 ;Increment count of fixed encounters
+31 SET FIXED=FIXED+1
End DoDot:1
if (+$GET(ZTSTOP))
QUIT
+32 ;Build completion bulletin
+33 SET MSGTEXT(1)=" "
+34 SET MSGTEXT(2)="Correction was started on "_TIMESTRT
+35 SET MSGTEXT(3)="Correction ended on "_$$FMTE^XLFDT($$NOW^XLFDT(),1)
+36 SET MSGTEXT(4)=FIXED_" Outpatient Encounters were corrected"
+37 SET MSGTEXT(5)=" "
+38 ;Send completion bulletin to current user
+39 SET XMSUB="ACRP correction of rejected encounters with bad date/time completed"
+40 SET XMTEXT="MSGTEXT("
+41 SET XMY(DUZ)=""
+42 SET XMCHAN=1
+43 SET XMDUZ="ACRP - SD*5.3*96"
+44 DO ^XMD
+45 ;Done
+46 QUIT
+47 ;
FIXDATE(XMITPTR) ;Fix encounter date/time for entry in 409.73
+1 ;
+2 ;Input : XMITPTR - Pointer to entry in TRANSMITTED OUTPATIENT
+3 ; ENCOUNTER file (#409.73)
+4 ;Output : None
+5 ;
+6 ;Check input
+7 SET XMITPTR=+$GET(XMITPTR)
+8 if ('$DATA(^SD(409.73,XMITPTR,0)))
QUIT
+9 ;Declare variables
+10 NEW XMITNODE,ENCPTR,DELPTR,VSITPTR,VSITDATE
+11 ;Get zero node of entry in Transmitted Outpatient Encounter
+12 SET XMITNODE=$GET(^SD(409.73,XMITPTR,0))
+13 ;Get pointer to Outpatient Encounter file (#409.68)
+14 SET ENCPTR=+$PIECE(XMITNODE,"^",2)
+15 ;Get pointer to Deleted Outpatient Encounter file (#409.74)
+16 SET DELPTR=+$PIECE(XMITNODE,"^",3)
+17 if (('ENCPTR)&('DELPTR))
QUIT
+18 IF (ENCPTR)
if ('$DATA(^SCE(ENCPTR,0)))
QUIT
+19 IF (DELPTR)
if ('$DATA(^SD(409.74,DELPTR,1)))
QUIT
+20 ;Determine correct date/time of encounter
+21 IF (ENCPTR)
Begin DoDot:1
+22 ;Get pointer to Visit file (#9000010)
+23 SET VSITPTR=+$PIECE($GET(^SCE(ENCPTR,0)),"^",5)
+24 ;Get date/time of visit
+25 SET VSITDATE=+$GET(^AUPNVSIT(VSITPTR,0))
End DoDot:1
+26 ;Determine correct date/time of deleted encounter
+27 IF (DELPTR)
Begin DoDot:1
+28 ;New date/time is validated version of currently stored date/time
+29 SET VSITDATE=+$GET(^SD(409.74,DELPTR,1))
+30 SET VSITDATE=+$$DATECHCK^SDVSIT(VSITDATE)
End DoDot:1
+31 ;Update date/time of encounter and mark for retransmission
+32 DO NEWDATE(ENCPTR,DELPTR,VSITDATE)
+33 ;Done
+34 QUIT
+35 ;
NEWDATE(ENCPTR,DELPTR,NEWDATE) ;Store new encounter date/time
+1 ;
+2 ;Input : ENCPTR - Pointer to entry in OUTPATIENT ENCOUNTER file
+3 ; (#409.68)
+4 ; DELENC - Pointer to entry in DELETED OUTPATIENT ENCOUNTER
+5 ; file (#409.74)
+6 ; NEWDATE - New date/time (FileMan format)
+7 ;Output : None
+8 ;Notes : If NEWDATE is not passed, the date/time currently on file
+9 ; will be validated and used as the new date/time
+10 ;
+11 ;Check input
+12 SET ENCPTR=+$GET(ENCPTR)
+13 IF (ENCPTR)
if ('$DATA(^SCE(ENCPTR,0)))
QUIT
+14 SET DELPTR=+$GET(DELPTR)
+15 IF (DELPTR)
if (('$DATA(^SD(409.74,DELPTR,0)))!('$DATA(^SD(409.74,DELPTR,1))))
QUIT
+16 if (('ENCPTR)&('DELPTR))
QUIT
+17 SET NEWDATE=+$GET(NEWDATE)
+18 IF ('NEWDATE)
if (ENCPTR)
SET NEWDATE=+^SCE(ENCPTR,0)
if (DELPTR)
SET NEWDATE=+^SD(409.74,DELPTR,1)
+19 SET NEWDATE=+$$DATECHCK^SDVSIT(NEWDATE)
+20 ;Declare variables
+21 NEW SDINARR,SDOUTARR,DELNODE1,IENS
+22 ;Set up FDA array for updating Outpatient Encounter
+23 IF (ENCPTR)
Begin DoDot:1
+24 SET IENS=ENCPTR_","
+25 SET SDINARR(409.68,IENS,.01)=NEWDATE
End DoDot:1
+26 ;Set up FDA array for updating Deleted Outpatient Encounter
+27 IF (DELPTR)
Begin DoDot:1
+28 SET IENS=DELPTR_","
+29 SET SDINARR(409.74,IENS,.01)=NEWDATE
+30 SET DELNODE1=^SD(409.74,DELPTR,1)
+31 SET $PIECE(DELNODE1,"^",1)=NEWDATE
+32 SET SDINARR(409.74,IENS,11)=DELNODE1
End DoDot:1
+33 ;Store new encounter date/time
+34 DO FILE^DIE("","SDINARR","SDOUTARR")
+35 ;Done
+36 QUIT
