SD5377PT.m

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 ---SD5377PT   1200     printed  Apr 09, 2024@21:59:44                                                                                                                                                                                                    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