SD5377PT ;ALB/MLI - Routine to inactivate entries in file 409.45 ; 10/6/95
;;5.3;Scheduling;**77,85**,Aug 13, 1993
;
; (based from routine SD5363PT)
;
; This routine will add a 10/1/96 inactivate date for the following
; code so classification questions will be asked.
;
; 165 BEREAVEMENT COUNSELING
;
EN ; entry point to inactivate stop codes in file 409.45
N DA,MSG,SDYQSTOP,STOPIEN,X,Y
D BMES^XPDUTL(">>>Inactivating the following entry:")
S SDYQSTOP=165 D
. S MSG=" Stop code "_SDYQSTOP
. S DA=$O(^SD(409.45,"B",SDYQSTOP,0))
. I 'DA D MES^XPDUTL(MSG_" could not be found in exemption file...nothing updated") Q
. S STOPIEN=$O(^DIC(40.7,"C",SDYQSTOP,0))
. I STOPIEN,$$EX^SDCOU2(STOPIEN) D Q
. . D STORE(DA,0)
. . D MES^XPDUTL(MSG_" no longer exempt from classification questions")
. D MES^XPDUTL(MSG_" already exempt")
Q
;
;
STORE(DA,ONOFF) ; create entry for act/inact
; Input: DA as IEN of 409.45
; ONOFF as 1 for act; 0 for inact
;
N DIC,DLAYGO,X,Y
S DIC="^SD(409.45,"_DA_",""E"",",DIC("P")=$P(^DD(409.45,75,0),"^",2)
S DA(1)=DA,DIC(0)="L"
S X="2961001",DIC("DR")=".02///^S X=ONOFF"
K DD,DO
D FILE^DICN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD5377PT 1200 printed Nov 22, 2024@17:55:28 Page 2
SD5377PT ;ALB/MLI - Routine to inactivate entries in file 409.45 ; 10/6/95
+1 ;;5.3;Scheduling;**77,85**,Aug 13, 1993
+2 ;
+3 ; (based from routine SD5363PT)
+4 ;
+5 ; This routine will add a 10/1/96 inactivate date for the following
+6 ; code so classification questions will be asked.
+7 ;
+8 ; 165 BEREAVEMENT COUNSELING
+9 ;
EN ; entry point to inactivate stop codes in file 409.45
+1 NEW DA,MSG,SDYQSTOP,STOPIEN,X,Y
+2 DO BMES^XPDUTL(">>>Inactivating the following entry:")
+3 SET SDYQSTOP=165
Begin DoDot:1
+4 SET MSG=" Stop code "_SDYQSTOP
+5 SET DA=$ORDER(^SD(409.45,"B",SDYQSTOP,0))
+6 IF 'DA
DO MES^XPDUTL(MSG_" could not be found in exemption file...nothing updated")
QUIT
+7 SET STOPIEN=$ORDER(^DIC(40.7,"C",SDYQSTOP,0))
+8 IF STOPIEN
IF $$EX^SDCOU2(STOPIEN)
Begin DoDot:2
+9 DO STORE(DA,0)
+10 DO MES^XPDUTL(MSG_" no longer exempt from classification questions")
End DoDot:2
QUIT
+11 DO MES^XPDUTL(MSG_" already exempt")
End DoDot:1
+12 QUIT
+13 ;
+14 ;
STORE(DA,ONOFF) ; create entry for act/inact
+1 ; Input: DA as IEN of 409.45
+2 ; ONOFF as 1 for act; 0 for inact
+3 ;
+4 NEW DIC,DLAYGO,X,Y
+5 SET DIC="^SD(409.45,"_DA_",""E"","
SET DIC("P")=$PIECE(^DD(409.45,75,0),"^",2)
+6 SET DA(1)=DA
SET DIC(0)="L"
+7 SET X="2961001"
SET DIC("DR")=".02///^S X=ONOFF"
+8 KILL DD,DO
+9 DO FILE^DICN
+10 QUIT
