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 ---[H[J[2J[HPSS172PO 2155 printed Nov 22, 2024@17:39:18 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
