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

SD53P664.m

Go to the documentation of this file. 
  1. SD53P664 ;ALB/TXH - UPDATE FILE 409.45;07/03/17
  1.  ;;5.3;Scheduling;**664**;AUG 13, 1993;Build 5
  1.  ;
  1.  ; This patch updates the OUTPATIENT CLASSIFICATION STOP CODE EXCEPTION 
  1.  ; file (#409.45).
  1.  ; There are 16 active stop codes will need to remain on the file and 
  1.  ; all the other stop codes will be inactivated effective 10/15/2017.
  1.  ;
  1.  Q
  1.  ;
  1. POST ; Post installation processes
  1.  ;
  1.  D BMES^XPDUTL("SD*5.3*664 Post-Install starts...")
  1.  D MES^XPDUTL("")
  1.  D LOADSC         ; Load stop codes
  1.  D UPDCODES       ; Update 409.45 to "gold" standard
  1.  D ADD            ; Add code if not exist in 409.45
  1.  D BMES^XPDUTL("SD*5.3*664 Post-Install is complete.")
  1.  D MES^XPDUTL("")
  1.  Q
  1.  ;
  1. LOADSC ; Load stop codes
  1.  ;
  1.  K ^XTMP("SDSTOP")
  1.  N SDX,SDXX
  1.  ; Set auto-delete date from XTMP global
  1.  S ^XTMP("SDSTOP",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^Patch SD*5.3*664 Gold Stop Codes"
  1.  F SDX=1:1 S SDXX=$P($T(CODE+SDX),";;",2) Q:SDXX="QUIT"  D
  1.  . S ^XTMP("SDSTOP",$J,SDXX)=""
  1.  Q
  1.  ;
  1. UPDCODES ; Compare existing entries in 409.45 with "gold" entries
  1.  ;
  1.  N SDSC,SDIEN,SDDA,SDDT,SDIX,SDMSG,SDSCIEN,SDSTA
  1.  S SDSC=0 F  S SDSC=$O(^SD(409.45,"B",SDSC)) Q:SDSC'>0  D
  1.  . S SDIEN=0 F  S SDIEN=$O(^SD(409.45,"B",SDSC,SDIEN)) Q:SDIEN'>0  D
  1.  . . ; if entry is not in Gold list
  1.  . . I '$D(^XTMP("SDSTOP",$J,SDSC)) D  Q  ; entry in 409.45 isn't in Gold list
  1.  . . . S SDMSG="     Stop code "_SDSC
  1.  . . . S DA=$O(^SD(409.45,"B",SDSC,0))
  1.  . . . I 'DA D MES^XPDUTL(SDMSG_" could not be found in exemption file... nothing updated.") Q
  1.  . . . ; Get Stop Code IEN from 40.7
  1.  . . . S SDSCIEN=$O(^DIC(40.7,"C",SDSC,0))
  1.  . . . ; Determine if Clinic Stop Code is Exempt from Outpatient Classifications
  1.  . . . I SDSCIEN,$$EX^SDCOU2(SDSCIEN) D  Q
  1.  . . . . ; Check if status already = 0, then skip
  1.  . . . . S SDDT=9999999 S SDDT=+$O(^SD(409.45,DA,"E","B",SDDT),-1) Q:'SDDT  D
  1.  . . . . . S SDIX=999 S SDIX=+$O(^SD(409.45,DA,"E","B",SDDT,SDIX),-1) Q:'SDIX  D
  1.  . . . . . . S SDSTA=$P($G(^SD(409.45,DA,"E",SDIX,0)),U,2)
  1.  . . . . . . Q:SDSTA=0
  1.  . . . . ; add new EFFECTIVE DATE and ACTIVE = 0 no matter what current status is
  1.  . . . . I SDSTA=1 D INACT(DA,0)
  1.  . . . . D MES^XPDUTL(SDMSG_" no longer exempt from classification questions.")
  1.  . . . I 'SDSCIEN D MES^XPDUTL(SDMSG_" already exempt.")
  1.  . . ; if entry exists in Gold list
  1.  . . I $D(^XTMP("SDSTOP",$J,SDSC)) D  Q    ; entry in Gold list
  1.  . . . S DA=$O(^SD(409.45,"B",SDSC,0))
  1.  . . . ; Check ACTIVE status from last entry
  1.  . . . S SDDT=9999999 S SDDT=+$O(^SD(409.45,DA,"E","B",SDDT),-1) Q:'SDDT  D
  1.  . . . . S SDIX=999 S SDIX=+$O(^SD(409.45,DA,"E","B",SDDT,SDIX),-1) Q:'SDIX  D
  1.  . . . . . S SDSTA=$P($G(^SD(409.45,DA,"E",SDIX,0)),U,2)
  1.  . . . . . ; if active, quit
  1.  . . . . . Q:SDSTA=1
  1.  . . . . . ; if inactive, change to active with new EFFECTIVE DATE
  1.  . . . . . I SDSTA'=1 D INACT(DA,1) Q
  1.  Q
  1.  ;
  1. ADD ; Add new entry if not exist in 409.45
  1.  ;
  1.     N DA,DIC,DLAYGO,MSG,SDYQERR,SDYQSTOP,STOPIEN,X,Y
  1.     S SDYQERR=0
  1.     ; Read each code from Gold list, if not exist in 409.45, add it.
  1.     S SDYQSTOP=0 F  S SDYQSTOP=$O(^XTMP("SDSTOP",$J,SDYQSTOP)) Q:SDYQSTOP'>0  D
  1.  . I '$D(^SD(409.45,"B",SDYQSTOP)) D
  1.  . . S MSG="     Stop code "_SDYQSTOP
  1.     . . S DA=$O(^SD(409.45,"B",SDYQSTOP,0))
  1.     . . I 'DA D  Q:SDYQERR
  1.     . . . K DD,DO
  1.     . . . S X=SDYQSTOP,DIC="^SD(409.45,",DIC(0)="L",DLAYGO=409.45
  1.     . . . D FILE^DICN S DA=+Y
  1.     . . . I Y<0 S SDYQERR=1 D MES^XPDUTL(MSG_" could not be added...try again later.")
  1.     . . . I Y>0 D MES^XPDUTL(MSG_" added to file as of 10/15/17")
  1.     . . I $O(^SD(409.45,DA,"E","B",2960901,0)) D MES^XPDUTL(MSG_"...already in file.") Q
  1.     . . D INACT(DA,1)
  1.  Q
  1.  ;
  1. INACT(DA,ONOFF) ; Create entry for active/inactive
  1.  ; Input: DA as IEN of 409.45
  1.  ;        ONOFF as 1 for active; 0 for inactive
  1.  ;
  1.  N DIC,DLAYGO,X,Y
  1.  S DIC="^SD(409.45,"_DA_",""E"","
  1.  S DIC("P")=$P(^DD(409.45,75,0),"^",2)
  1.  S DA(1)=DA
  1.  S DIC(0)="L"
  1.  S X="3171015"
  1.  S DIC("DR")=".02///^S X=ONOFF"
  1.  K DD,D0
  1.  D FILE^DICN
  1.  Q
  1.  ;
  1. CODE ; Stop codes that need to remain on the file.
  1.  ;;104
  1.  ;;105
  1.  ;;106
  1.  ;;107
  1.  ;;108
  1.  ;;109
  1.  ;;115
  1.  ;;128
  1.  ;;144
  1.  ;;145
  1.  ;;149
  1.  ;;150
  1.  ;;151
  1.  ;;153
  1.  ;;421
  1.  ;;703
  1.  ;;QUIT