SD53109P.m

SD53109P ;ALB/ABR - ADD NPCDB ERROR CODE; 3/20/97

 ;;5.3;Scheduling;**109**;Aug 13, 1993

 ;

 ;

 ;

EN ;

 N DESC,ERR,DA,DD,DIC,DIE,DO,DR,X,Y

 ;

 ;

 D BMES^XPDUTL(">>> Adding NPCDB error code 303 to file #409.76")

 ;

 S DESC="For DSS Identifier '108' date of death cannot be more than 14 days before admit date."

 S (DIC,DIE)="^SD(409.76,",X=303,DIC(0)="L" K DD,DO D ^DIC K DIC

 I Y'>0 S ERR=1 D ERR Q  ;checks to see if record is created

 S DA=+Y,DR="11////^S X=DESC"

 D ^DIE K DIE,DR,DA

 ;

 D MES^XPDUTL("Done.")

 Q

 ;

ERR ;

 I +ERR D BMES^XPDUTL("Problem with TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE (#409.76) file update.  Call your IRMFO CS.")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SD53109P   676     printed  Apr 09, 2024@21:56:12                                                                                                                                                                                                     Page 2

SD53109P  ;ALB/ABR - ADD NPCDB ERROR CODE; 3/20/97

 +1       ;;5.3;Scheduling;**109**;Aug 13, 1993

 +2       ;

 +3       ;

 +4       ;

EN        ;

 +1        NEW DESC,ERR,DA,DD,DIC,DIE,DO,DR,X,Y

 +2       ;

 +3       ;

 +4        DO BMES^XPDUTL(">>> Adding NPCDB error code 303 to file #409.76")

 +5       ;

 +6        SET DESC="For DSS Identifier '108' date of death cannot be more than 14 days before admit date."

 +7        SET (DIC,DIE)="^SD(409.76,"

           SET X=303

           SET DIC(0)="L"

           KILL DD,DO

           DO ^DIC

           KILL DIC

 +8       ;checks to see if record is created

           IF Y'>0

               SET ERR=1

               DO ERR

               QUIT 

 +9        SET DA=+Y

           SET DR="11////^S X=DESC"

 +10       DO ^DIE

           KILL DIE,DR,DA

 +11      ;

 +12       DO MES^XPDUTL("Done.")

 +13       QUIT 

 +14      ;

ERR       ;

 +1        IF +ERR

               DO BMES^XPDUTL("Problem with TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE (#409.76) file update.  Call your IRMFO CS.")

 +2        QUIT