Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SD5396PT

SD5396PT.m

Go to the documentation of this file. 
  1. SD5396PT ;ALB/JRP - CORRECT REJECTED ENCOUNTERS WITH BAD DATE/TIME;06-MAR-1997
  1.  ;;5.3;Scheduling;**96**;Aug 13, 1993
  1.  ;
  1. TASK ;Entry point to schedule correction for NOW
  1.  ;
  1.  ;Declare variables
  1.  N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,TXT
  1.  ;Set up call to TaskMan
  1.  S ZTRTN="EN^SD5396PT"
  1.  S ZTDESC="ACRP correction of rejected encounters with bad date/time"
  1.  S ZTDTH=$$NOW^XLFDT()
  1.  S ZTIO=""
  1.  ;Schedule task
  1.  S TXT="Correction of rejected encounters with bad date/time"
  1.  D MES^XPDUTL(TXT)
  1.  S TXT="will be scheduled to run on "_$$FMTE^XLFDT(ZTDTH)
  1.  D MES^XPDUTL(TXT)
  1.  D ^%ZTLOAD
  1.  S:(+$G(ZTSK)) TXT="Scheduled as task number "_ZTSK
  1.  S:('$G(ZTSK)) TXT="** Unable to schedule correction **"
  1.  D BMES^XPDUTL(TXT)
  1.  ;Done
  1.  Q
  1.  ;
  1. EN ;Main entry point
  1.  ;
  1.  ;Declare variables
  1.  N CODE420,CODE421,ERRPTR,ERRNODE,XMITPTR,TMP,TIMESTRT,FIXED
  1.  N MSGTEXT,XMTEXT,XMSUB,XMY,XMCHAN,XMZ,XMDUZ
  1.  ;Get pointer to error codes 420 & 421
  1.  S CODE420=+$O(^SD(409.76,"B",420,0))
  1.  Q:('CODE420)
  1.  S CODE421=+$O(^SD(409.76,"B",421,0))
  1.  Q:('CODE421)
  1.  ;Remember starting time
  1.  S TIMESTRT=$$FMTE^XLFDT($$NOW^XLFDT(),1)
  1.  ;Loop through rejected encounters
  1.  S FIXED=0
  1.  S ERRPTR=0
  1.  F  S ERRPTR=+$O(^SD(409.75,ERRPTR)) Q:('ERRPTR)  D  Q:(+$G(ZTSTOP))
  1.  .I ($$S^%ZTLOAD) S ZTSTOP=1 Q
  1.  .;Get zero node
  1.  .S ERRNODE=$G(^SD(409.75,ERRPTR,0))
  1.  .;Check error code
  1.  .S TMP=+$P(ERRNODE,"^",2)
  1.  .Q:((TMP'=CODE420)&(TMP'=CODE421))
  1.  .;Get pointer to Transmitted Outpatient Encounter file (#409.73)
  1.  .S XMITPTR=+$G(^SD(409.75,ERRPTR,0))
  1.  .Q:('$D(^SD(409.73,XMITPTR,0)))
  1.  .;Fix date/time of entry in Transmitted Outpatient Encounter file
  1.  .D FIXDATE(XMITPTR)
  1.  .;Mark entry in Transmitted Outpatient Encounter file for retransmission
  1.  .D STREEVNT^SCDXFU01(XMITPTR)
  1.  .D XMITFLAG^SCDXFU01(XMITPTR)
  1.  .;Increment count of fixed encounters
  1.  .S FIXED=FIXED+1
  1.  ;Build completion bulletin
  1.  S MSGTEXT(1)=" "
  1.  S MSGTEXT(2)="Correction was started on "_TIMESTRT
  1.  S MSGTEXT(3)="Correction ended on "_$$FMTE^XLFDT($$NOW^XLFDT(),1)
  1.  S MSGTEXT(4)=FIXED_" Outpatient Encounters were corrected"
  1.  S MSGTEXT(5)=" "
  1.  ;Send completion bulletin to current user
  1.  S XMSUB="ACRP correction of rejected encounters with bad date/time completed"
  1.  S XMTEXT="MSGTEXT("
  1.  S XMY(DUZ)=""
  1.  S XMCHAN=1
  1.  S XMDUZ="ACRP - SD*5.3*96"
  1.  D ^XMD
  1.  ;Done
  1.  Q
  1.  ;
  1. FIXDATE(XMITPTR) ;Fix encounter date/time for entry in 409.73
  1.  ;
  1.  ;Input  : XMITPTR - Pointer to entry in TRANSMITTED OUTPATIENT
  1.  ;                   ENCOUNTER file (#409.73)
  1.  ;Output : None
  1.  ;
  1.  ;Check input
  1.  S XMITPTR=+$G(XMITPTR)
  1.  Q:('$D(^SD(409.73,XMITPTR,0)))
  1.  ;Declare variables
  1.  N XMITNODE,ENCPTR,DELPTR,VSITPTR,VSITDATE
  1.  ;Get zero node of entry in Transmitted Outpatient Encounter
  1.  S XMITNODE=$G(^SD(409.73,XMITPTR,0))
  1.  ;Get pointer to Outpatient Encounter file (#409.68)
  1.  S ENCPTR=+$P(XMITNODE,"^",2)
  1.  ;Get pointer to Deleted Outpatient Encounter file (#409.74)
  1.  S DELPTR=+$P(XMITNODE,"^",3)
  1.  Q:(('ENCPTR)&('DELPTR))
  1.  I (ENCPTR) Q:('$D(^SCE(ENCPTR,0)))
  1.  I (DELPTR) Q:('$D(^SD(409.74,DELPTR,1)))
  1.  ;Determine correct date/time of encounter
  1.  I (ENCPTR) D
  1.  .;Get pointer to Visit file (#9000010)
  1.  .S VSITPTR=+$P($G(^SCE(ENCPTR,0)),"^",5)
  1.  .;Get date/time of visit
  1.  .S VSITDATE=+$G(^AUPNVSIT(VSITPTR,0))
  1.  ;Determine correct date/time of deleted encounter
  1.  I (DELPTR) D
  1.  .;New date/time is validated version of currently stored date/time
  1.  .S VSITDATE=+$G(^SD(409.74,DELPTR,1))
  1.  .S VSITDATE=+$$DATECHCK^SDVSIT(VSITDATE)
  1.  ;Update date/time of encounter and mark for retransmission
  1.  D NEWDATE(ENCPTR,DELPTR,VSITDATE)
  1.  ;Done
  1.  Q
  1.  ;
  1. NEWDATE(ENCPTR,DELPTR,NEWDATE) ;Store new encounter date/time
  1.  ;
  1.  ;Input  : ENCPTR - Pointer to entry in OUTPATIENT ENCOUNTER file
  1.  ;                  (#409.68)
  1.  ;         DELENC - Pointer to entry in DELETED OUTPATIENT ENCOUNTER
  1.  ;                  file (#409.74)
  1.  ;         NEWDATE - New date/time (FileMan format)
  1.  ;Output : None
  1.  ;Notes  : If NEWDATE is not passed, the date/time currently on file
  1.  ;         will be validated and used as the new date/time
  1.  ;
  1.  ;Check input
  1.  S ENCPTR=+$G(ENCPTR)
  1.  I (ENCPTR) Q:('$D(^SCE(ENCPTR,0)))
  1.  S DELPTR=+$G(DELPTR)
  1.  I (DELPTR) Q:(('$D(^SD(409.74,DELPTR,0)))!('$D(^SD(409.74,DELPTR,1))))
  1.  Q:(('ENCPTR)&('DELPTR))
  1.  S NEWDATE=+$G(NEWDATE)
  1.  I ('NEWDATE) S:(ENCPTR) NEWDATE=+^SCE(ENCPTR,0) S:(DELPTR) NEWDATE=+^SD(409.74,DELPTR,1)
  1.  S NEWDATE=+$$DATECHCK^SDVSIT(NEWDATE)
  1.  ;Declare variables
  1.  N SDINARR,SDOUTARR,DELNODE1,IENS
  1.  ;Set up FDA array for updating Outpatient Encounter
  1.  I (ENCPTR) D
  1.  .S IENS=ENCPTR_","
  1.  .S SDINARR(409.68,IENS,.01)=NEWDATE
  1.  ;Set up FDA array for updating Deleted Outpatient Encounter
  1.  I (DELPTR) D
  1.  .S IENS=DELPTR_","
  1.  .S SDINARR(409.74,IENS,.01)=NEWDATE
  1.  .S DELNODE1=^SD(409.74,DELPTR,1)
  1.  .S $P(DELNODE1,"^",1)=NEWDATE
  1.  .S SDINARR(409.74,IENS,11)=DELNODE1
  1.  ;Store new encounter date/time
  1.  D FILE^DIE("","SDINARR","SDOUTARR")
  1.  ;Done
  1.  Q