PSS172PO.m

PSS172PO ;BIR/JCH-Environment check routine for patch PSS*1*172 ;Oct 18, 2012

 ;;1.0;PHARMACY DATA MANAGEMENT;**172**;9/30/97;Build 28

 ;

 Q

 ;

EN ; Add new entries to 9009032.3 (intervention type) and 9009032.5 (intervention recommendation)

 ;

 D AIR

 D AIT

 D SECURITY

 Q

AIR ;Add Intervention recommendation

 ;

 I $$FIND1^DIC(9009032.5,"","X","UNABLE TO ASSESS","B") D AITX(2) D KTM Q

 D BMES^XPDUTL("Adding new Intervention Recommendation")

 I '$$FIND1^DIC(9009032.5,"","X","UNABLE TO ASSESS","B") D ADDIR I '$$FIND1^DIC(9009032.5,"","X","UNABLE TO ASSESS","B") D AITX(1) D KTM Q

 D KTM D BMES^XPDUTL("Intervention Recommendation 'UNABLE TO ASSESS' successfully added.")

 Q

AIT ;Add Intervention type

 ;

 I $$FIND1^DIC(9009032.3,"","X","NO ALLERGY ASSESSMENT","B") D AITX(4) D KTM Q

 D BMES^XPDUTL("Adding new Intervention Recommendation")

 I '$$FIND1^DIC(9009032.3,"","X","NO ALLERGY ASSESSMENT","B") D ADDIT I '$$FIND1^DIC(9009032.3,"","X","NO ALLERGY ASSESSMENT","B") D AITX(3) D KTM Q

 D KTM D BMES^XPDUTL("Intervention Type 'NO ALLERGY ASSESSMENT' successfully added.")

 Q

ADDIR ;Add intervention recommendation

 N PSSMRMPD K PSSMRMPD

 K PSSMRMER S PSSMRMPD(1,9009032.5,"+1,",.01)="UNABLE TO ASSESS" D UPDATE^DIE("","PSSMRMPD(1)",,"PSSMRMER(1)")

 Q

ADDIT ; Add No allergy assessment type

 N PSSMRMPD K PSSMRMPD

 K PSSMRMER S PSSMRMPD(1,9009032.3,"+1,",.01)="NO ALLERGY ASSESSMENT" D UPDATE^DIE("","PSSMRMPD(1)",,"PSSMRMER(1)")

 Q

 ;

AITX(PSSMRMIT) ;

 D BMES^XPDUTL(" ")

 I PSSMRMIT=1 D BMES^XPDUTL("Cannot create 'UNABLE TO ASSESS' intervention recommendation.") Q

 I PSSMRMIT=2 D BMES^XPDUTL("'UNABLE TO ASSESS' intervention recommendation already exists.") Q

 I PSSMRMIT=3 D BMES^XPDUTL("Cannot create 'NO ALLERGY ASSESSMENT' intervention type.") Q

 I PSSMRMIT=4 D BMES^XPDUTL("'NO ALLERGY ASSESSMENT' intervention type already exists.") Q

 Q

KTM ;Kill TMP global

 K ^TMP("DIERR",$J)

 Q

SECURITY ; Set security nodes in DIC(53.47

 N SECURITY S SECURITY("DD")="",SECURITY("AUDIT")="",SECURITY("DEL")="",SECURITY("LAYGO")="",SECURITY("RD")="",SECURITY("WR")=""

 D FILESEC^DDMOD(53.47,.SECURITY)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSS172PO   2155     printed  Apr 09, 2024@21:37:23                                                                                                                                                                                                    Page 2

PSS172PO  ;BIR/JCH-Environment check routine for patch PSS*1*172 ;Oct 18, 2012

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**172**;9/30/97;Build 28

 +2       ;

 +3        QUIT 

 +4       ;

EN        ; Add new entries to 9009032.3 (intervention type) and 9009032.5 (intervention recommendation)

 +1       ;

 +2        DO AIR

 +3        DO AIT

 +4        DO SECURITY

 +5        QUIT 

AIR       ;Add Intervention recommendation

 +1       ;

 +2        IF $$FIND1^DIC(9009032.5,"","X","UNABLE TO ASSESS","B")

               DO AITX(2)

               DO KTM

               QUIT 

 +3        DO BMES^XPDUTL("Adding new Intervention Recommendation")

 +4        IF '$$FIND1^DIC(9009032.5,"","X","UNABLE TO ASSESS","B")

               DO ADDIR

               IF '$$FIND1^DIC(9009032.5,"","X","UNABLE TO ASSESS","B")

                   DO AITX(1)

                   DO KTM

                   QUIT 

 +5        DO KTM

           DO BMES^XPDUTL("Intervention Recommendation 'UNABLE TO ASSESS' successfully added.")

 +6        QUIT 

AIT       ;Add Intervention type

 +1       ;

 +2        IF $$FIND1^DIC(9009032.3,"","X","NO ALLERGY ASSESSMENT","B")

               DO AITX(4)

               DO KTM

               QUIT 

 +3        DO BMES^XPDUTL("Adding new Intervention Recommendation")

 +4        IF '$$FIND1^DIC(9009032.3,"","X","NO ALLERGY ASSESSMENT","B")

               DO ADDIT

               IF '$$FIND1^DIC(9009032.3,"","X","NO ALLERGY ASSESSMENT","B")

                   DO AITX(3)

                   DO KTM

                   QUIT 

 +5        DO KTM

           DO BMES^XPDUTL("Intervention Type 'NO ALLERGY ASSESSMENT' successfully added.")

 +6        QUIT 

ADDIR     ;Add intervention recommendation

 +1        NEW PSSMRMPD

           KILL PSSMRMPD

 +2        KILL PSSMRMER

           SET PSSMRMPD(1,9009032.5,"+1,",.01)="UNABLE TO ASSESS"

           DO UPDATE^DIE("","PSSMRMPD(1)",,"PSSMRMER(1)")

 +3        QUIT 

ADDIT     ; Add No allergy assessment type

 +1        NEW PSSMRMPD

           KILL PSSMRMPD

 +2        KILL PSSMRMER

           SET PSSMRMPD(1,9009032.3,"+1,",.01)="NO ALLERGY ASSESSMENT"

           DO UPDATE^DIE("","PSSMRMPD(1)",,"PSSMRMER(1)")

 +3        QUIT 

 +4       ;

AITX(PSSMRMIT) ;

 +1        DO BMES^XPDUTL(" ")

 +2        IF PSSMRMIT=1

               DO BMES^XPDUTL("Cannot create 'UNABLE TO ASSESS' intervention recommendation.")

               QUIT 

 +3        IF PSSMRMIT=2

               DO BMES^XPDUTL("'UNABLE TO ASSESS' intervention recommendation already exists.")

               QUIT 

 +4        IF PSSMRMIT=3

               DO BMES^XPDUTL("Cannot create 'NO ALLERGY ASSESSMENT' intervention type.")

               QUIT 

 +5        IF PSSMRMIT=4

               DO BMES^XPDUTL("'NO ALLERGY ASSESSMENT' intervention type already exists.")

               QUIT 

 +6        QUIT 

KTM       ;Kill TMP global

 +1        KILL ^TMP("DIERR",$JOB)

 +2        QUIT 

SECURITY  ; Set security nodes in DIC(53.47

 +1        NEW SECURITY

           SET SECURITY("DD")=""

           SET SECURITY("AUDIT")=""

           SET SECURITY("DEL")=""

           SET SECURITY("LAYGO")=""

           SET SECURITY("RD")=""

           SET SECURITY("WR")=""

 +2        DO FILESEC^DDMOD(53.47,.SECURITY)

 +3        QUIT