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