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

SD5384NC.m

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