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

SD5384PT.m

Go to the documentation of this file. 
  1. SD5384PT ;ALB/MLI - clean-up routine to remove credit stop code encounters ; 12 Dec 96 @ 10:02
  1.  ;;5.3;Scheduling;**84,1015**;AUG 13, 1993;Build 21
  1.  ;
  1.  ; This routine will loop through the Outpatient Encounter file for a date range and
  1.  ; look for credit stop codes which are:
  1.  ; 
  1.  ;    a.  associated with location where the stop code is the same as the
  1.  ;        credit stop code.
  1.  ;
  1.  ;    b.  associated with a non-count clinic.
  1.  ;
  1.  ; Credit stop code encounters (originating process = 4) found which meet one of
  1.  ; the above criteria will be deleted.
  1.  ;
  1.  ; The variables SDBEGDT and SDENDDT can be set prior to calling EN if a date range
  1.  ; other than 10/1/96 through the present is desired.  The process will be queued
  1.  ; and a mail message of findings will be sent.
  1.  ;
  1.  ; If SDNODEL is defined, no data will be deleted.
  1.  ;
  1.  ;
  1. EN ; process task
  1.  N SDCOUNT,SDSTART
  1.  S SDSTART=$$NOW^XLFDT()
  1.  D LOOP ; loop through entries and delete
  1.  D MAIL ; build mail message of results
  1.  Q
  1.  ; 
  1.  ;
  1. LOOP ; loop through encounter file and delete bogus credit stop entries
  1.  ;
  1.  ; Input Variables (all optional):
  1.  ; SDBEGDT  = Beginning date of encounter search (default 2961001)
  1.  ; SDENDDT  = Ending date of encounter search (default DT)
  1.  ; SDCLINIC = array of specific locations to look at (otherwise all)
  1.  ; SDNODEL  = 1 if data should not be deleted during run
  1.  ;   
  1.  ; Variables used:
  1.  ; SDALL    = 1 if all clinics searched...otherwise 0
  1.  ; SDDATE   = loop counter for encounter date                        
  1.  ; SDENC    = loop counter for IEN of outpt encounter file
  1.  ; SDNODE   = 0 node of ^SCE
  1.  ; SDCRED   = credit stop code pointer
  1.  ; SDCOUNT  = counter, subscripted by location IEN, of deleted credit
  1.  ;            stop code encounters
  1.  ;
  1.  N SDALL,SDCRED,SDDATE,SDENC,SDNODE,SDPAR
  1.  S SDBEGDT=$G(SDBEGDT,2961001),SDENDDT=$G(SDENDDT,DT)+.9
  1.  S SDALL='$O(SDCLINIC(0)),SDDATE=SDBEGDT-.1
  1.  F  S SDDATE=$O(^SCE("B",SDDATE)) Q:'SDDATE!(SDDATE>SDENDDT)  D
  1.  .  S SDENC=""
  1.  .  F  S SDENC=$O(^SCE("B",SDDATE,SDENC)) Q:'SDENC  D
  1.  .  .  S SDNODE=$G(^SCE(SDENC,0))
  1.  .  .  I $P(SDNODE,"^",8)'=4 Q                                            ; not a credit stop encounter
  1.  .  .  I 'SDALL D  Q                                                      ; if only select clinics chosen
  1.  .  .  .  I $D(SDCLINIC(+$P(SDNODE,"^",4))) D DEL(SDENC)                  ; delete credit associated with location
  1.  .  .  S SDCRED=$P(SDNODE,"^",3)
  1.  .  .  S SDPAR=$G(^SCE(+$P(SDNODE,"^",6),0))                              ; get parent encounter
  1.  .  .  I $P(SDPAR,"^",12)=12 D DEL(SDENC) Q                               ; delete credit for non-counts
  1.  .  .  I SDCRED=$P(SDPAR,"^",3) D DEL(SDENC) Q                            ; delete if credit stop = stop
  1. LOOPQ Q
  1.  ;
  1.  ;
  1. DEL(IEN) ; delete encounter and increment counter by location
  1.  ;
  1.  ; Input - IEN of Outpatient Encounter file
  1.  ;
  1.  N DA,DIK,LOC
  1.  S LOC=$P($G(^SCE(IEN,0)),"^",4)
  1.  S SDCOUNT(LOC)=$G(SDCOUNT(LOC))+1
  1.  S DIK="^SCE("
  1.  S DA=IEN
  1.  I '$G(SDNODEL) D ^DIK
  1.  Q
  1.  ;
  1.  ;
  1. MAIL ; send bulletin of results
  1.  N DIFROM,SDTEXT
  1.  S SDCOUNT=0
  1.  D LINE("The Credit Stop Code Encounter clean-up has run to completion at "_$P($$SITE^VASITE(),"^",2)_"."),LINE("")
  1.  D LINE("    Start Time:         "_$$FMTE^XLFDT(SDSTART))
  1.  D LINE("    End Time:           "_$$FMTE^XLFDT($$NOW^XLFDT())),LINE("")
  1.  I '$O(SDCLINIC(0)) D
  1.  . D LINE("Credit stop code encounters for all clinics were deleted IF either:")
  1.  . D LINE("    a.  the credit stop code associated with the clinic was equal")
  1.  . D LINE("        to the stop code associated with the clinic.")
  1.  . D LINE("    b.  the clinic was set up as NON-COUNT.")
  1.  . D LINE("")
  1.  . D LINE("The following is a list of clinics for which credit stop code")
  1.  . D LINE("encounters were deleted:")
  1.  . F I=0:0 S I=$O(SDCOUNT(I)) Q:'I  D LINE("   #"_I_" - "_$P($G(^SC(I,0)),"^",1)_"..."_+SDCOUNT(I)_" encounters deleted")
  1.  . I '$O(SDCOUNT(0)) D LINE("   No credit stop code encounters were found meeting the above criteria.")
  1.  E  D
  1.  . D LINE("Credit stop code encounters were deleted for the following")
  1.  . D LINE("Hospital Locations:")
  1.  . F I=0:0 S I=$O(SDCLINIC(I)) Q:'I  D LINE("   #"_I_" - "_$P($G(^SC(I,0)),"^",1)_"..."_+$G(SDCOUNT(I))_" encounters deleted")
  1.  S XMSUB="Credit Stop Code Encounter Clean-up is Complete",XMN=0
  1.  S XMTEXT="SDTEXT("
  1.  S XMDUZ=.5,XMY(DUZ)=""
  1.  D ^XMD
  1.  K 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
  1.  ;
  1.  ;
  1. CLINIC ; entry point if a site wants to delete ALL credit stop encounters associated with one (or more) hospital location(s)
  1.  ;
  1.  ; do not use without consulting customer support or development first...
  1.  ;
  1.  N SDCLINIC
  1.  S VAUTVB="SDCLINIC",VAUTSTR="clinic",VAUTNALL=1,VAUTNI=2
  1.  S DIC="^SC(",DIC("S")="I $P(^(0),U,3)=""C"""
  1.  D FIRST^VAUTOMA
  1.  I Y'<0 W !!,"Queuing credit stop encounter cleanup:" D QUEUE
  1.  D RETRAN
  1.  Q
  1.  ;
  1.  ;
  1. QUEUE ; queue process to run
  1.  N I
  1.  S ZTDESC="Credit stop code encounter clean-up process"
  1.  S ZTIO=""
  1.  F I="SDBEGDT","SDENDDT","SDCLINIC","SDNODEL" S ZTSAVE(I)=""
  1.  S ZTRTN="EN^SD5384PT"
  1.  D ^%ZTLOAD
  1.  I $D(ZTSK) W !,"Task number = ",ZTSK
  1.  K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  Q
  1.  ;
  1.  ;
  1. RETRAN ; flag errors of one type to retransmit
  1.  N DTOUT,DIROUT,DIRUT,DUOUT,ERROR,X,Y,DIR,SDLOOP
  1.  S DIR(0)="P^409.76:AQEMZ"
  1.  D ^DIR
  1.  I Y'>0 Q
  1.  S ERROR=+Y,SDLOOP=0
  1.  F  S SDLOOP=$O(^SD(409.75,SDLOOP)) Q:'SDLOOP  S X=$G(^(SDLOOP,0)) D
  1.  .  I $P(X,"^",2)=ERROR D XMITFLAG^SCDXFU01(+X,0)
  1.  Q