Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPXRM202

BPXRM202.m

Go to the documentation of this file. 
  1. BPXRM202 ; IHS/MSC/MGH - Version 2.0 Patch 2 post routine. ;19-Aug-2013 16:59;DU
  1.  ;;2.0;CLINICAL REMINDERS;**1002**;Feb 04, 2005;Build 15
  1.  ;
  1. ENV ;EP environment check
  1.  N IN,INSTDA,STAT
  1.  ;Check for the installation of Reminders 2.0
  1.  S IN="CLINICAL REMINDERS 2.0",INSTDA=""
  1.  I '$D(^XPD(9.7,"B",IN)) D  Q
  1.  .W !,"You must first install CLINICAL REMINDERS 2.0 before this patch" S XPDQUIT=2
  1.  S INSTDA=$O(^XPD(9.7,"B",IN,INSTDA),-1)
  1.  S STAT=+$P($G(^XPD(9.7,INSTDA,0)),U,9)
  1.  I STAT'=3 D  Q
  1.  .W !,"CLINICAL REMINDERS 2.0 must be completely installed before installing this patch." S XPDQUIT=2
  1.  S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  ;Check for the installation of other patches
  1.  S PATCH="PXRM*2.0*1001"
  1.  I '$$PATCH(PATCH) D  Q
  1.  . W !,"You must first install "_PATCH_"." S XPDQUIT=2
  1.  Q
  1. PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
  1.  ;copy of code from XPDUTL but modified to handle 4 digit IHS patch numb
  1.  Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N 0
  1.  NEW NUM,I,J
  1.  S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0
  1.  S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
  1.  ;check if patch is just a number
  1.  Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
  1.  S NUM=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
  1.  Q (X=+NUM)
  1.  ;===============================================================
  1. PRE ;EP pre-init
  1.  Q
  1.  ;===============================================================
  1. POST ;Post-install
  1.  D TERMS
  1.  D DIALOG
  1.  D INACT
  1.  D CNAK
  1.  Q
  1.  ;================================================================
  1. TERMS ;Resequence the reminder finding types prompts to use the new prompts
  1.  N MSG,TYP,PARRAY
  1.  D PROMPTS
  1.  S TYP=$$FIND1^DIC(801.45,,,"IM",,,"MSG")
  1.  I $D(MSG) D  Q
  1.  . W !!,"The following error message was returned:",!!
  1.  . S MSG="" F  S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG=""  W MSG("DIERR",1,"TEXT",MSG),!
  1.  . W !!,"Unable to find the Immunization FINDING TYPE"
  1.  I '$D(MSG) D IMM
  1.  Q
  1. PROMPTS ;
  1.  S PARRAY("PXRM LOT NUMBER")=$O(^PXRMD(801.41,"B","PXRM LOT NUMBER",""))
  1.  S PARRAY("PXRM IMM SITE")=$O(^PXRMD(801.41,"B","PXRM IMM SITE",""))
  1.  S PARRAY("PXRM VOLUME")=$O(^PXRMD(801.41,"B","PXRM VOLUME",""))
  1.  S PARRAY("PXRM IMM VIS DATE")=$O(^PXRMD(801.41,"B","PXRM IMM VIS DATE",""))
  1.  S PARRAY("PXRM SERIES")=$O(^PXRMD(801.41,"B","PXRM SERIES",""))
  1.  S PARRAY("PXRM CONTRAINDICATED")=$O(^PXRMD(801.41,"B","PXRM CONTRAINDICATED",""))
  1.  S PARRAY("PXRM REACTION")=$O(^PXRMD(801.41,"B","PXRM REACTION",""))
  1.  S PARRAY("PXRM IMM ELIG")=$O(^PXRMD(801.41,"B","PXRM IMM ELIG",""))
  1.  S PARRAY("PXRM ADMIN NOTES")=$O(^PXRMD(801.41,"B","PXRM ADMIN NOTES",""))
  1.  Q
  1. IMM ;Find the prompts for the Immunizations
  1.  N STA,IENS
  1.  S IENS=","_TYP_","
  1.  S STA=$$FIND1^DIC(801.451,IENS,,"DONE AT ENCOUNTER",,,.MSG)
  1.  I $D(MSG) D  Q
  1.  . W !!,"The following error message was returned:",!!
  1.  . S MSG="" F  S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG=""  W MSG("DIERR",1,"TEXT",MSG),!
  1.  .W !!,"Unable to find DONE AT ENCOUNTER for Immunization FINDING TYPE"
  1.  I '$D(MSG) D IMMGIV
  1.  Q
  1. IMMGIV ; Replace prompts for Immunization given at encounter
  1.  N IENS,FDA,MSG
  1.  D DELETE
  1.  ;Add the lot number prompt
  1.  S IENS="+1,"_STA_","_TYP_","
  1.  S FDA(801.4515,IENS,.01)=$G(PARRAY("PXRM LOT NUMBER"))
  1.  S FDA(801.4515,IENS,1)=1
  1.  S FDA(801.4515,IENS,5)=1
  1.  D UPDATE^DIE("","FDA","IENS","MSG")
  1.  I $D(MSG) D MSG
  1.  ;Add the Site prompt
  1.  S IENS="+2,"_STA_","_TYP_","
  1.  S FDA(801.4515,IENS,.01)=$G(PARRAY("PXRM IMM SITE"))
  1.  S FDA(801.4515,IENS,5)=1
  1.  D UPDATE^DIE("","FDA","IENS","MSG")
  1.  I $D(MSG) D MSG
  1.  ;Add the Volume prompt
  1.  S IENS="+3,"_STA_","_TYP_","
  1.  S FDA(801.4515,IENS,.01)=$G(PARRAY("PXRM VOLUME"))
  1.  S FDA(801.4515,IENS,5)=1
  1.  D UPDATE^DIE("","FDA","IENS","MSG")
  1.  I $D(MSG) D MSG
  1.  ;Add the Vis DATE prompt
  1.  S IENS="+4,"_STA_","_TYP_","
  1.  S FDA(801.4515,IENS,.01)=$G(PARRAY("PXRM IMM VIS DATE"))
  1.  S FDA(801.4515,IENS,1)=1
  1.  S FDA(801.4515,IENS,5)=1
  1.  D UPDATE^DIE("","FDA","IENS","MSG")
  1.  I $D(MSG) D MSG
  1.  ;Add the elig prompt
  1.  S IENS="+5,"_STA_","_TYP_","
  1.  S FDA(801.4515,IENS,.01)=$G(PARRAY("PXRM IMM ELIG"))
  1.  S FDA(801.4515,IENS,5)=1
  1.  D UPDATE^DIE("","FDA","IENS","MSG")
  1.  I $D(MSG) D MSG
  1.  ; Add the series
  1.  S IENS="+6,"_STA_","_TYP_","
  1.  S FDA(801.4515,IENS,.01)=$G(PARRAY("PXRM SERIES"))
  1.  S FDA(801.4515,IENS,5)=1
  1.  D UPDATE^DIE("","FDA","IENS","MSG")
  1.  I $D(MSG) D MSG
  1.  ;Add the reaction prompt
  1.  S IENS="+7,"_STA_","_TYP_","
  1.  S FDA(801.4515,IENS,.01)=$G(PARRAY("PXRM REACTION"))
  1.  S FDA(801.4515,IENS,5)=1
  1.  D UPDATE^DIE("","FDA","IENS","MSG")
  1.  I $D(MSG) D MSG
  1.  ;Add the contraindicated prompt
  1.  S IENS="+8,"_STA_","_TYP_","
  1.  S FDA(801.4515,IENS,.01)=$G(PARRAY("PXRM CONTRAINDICATED"))
  1.  S FDA(801.4515,IENS,5)=1
  1.  D UPDATE^DIE("","FDA","IENS","MSG")
  1.  I $D(MSG) D MSG
  1.  ;Add the admin notes prompt
  1.  S IENS="+9,"_STA_","_TYP_","
  1.  S FDA(801.4515,IENS,.01)=$G(PARRAY("PXRM ADMIN NOTES"))
  1.  S FDA(801.4515,IENS,5)=1
  1.  D UPDATE^DIE("","FDA","IENS","MSG")
  1.  I $D(MSG) D MSG
  1.  Q
  1. DELETE ;Delete the subnodes
  1.  N PMT,DA,DIK
  1.  S PMT=0 F  S PMT=$O(^PXRMD(801.45,TYP,1,STA,5,PMT)) Q:PMT=""  D
  1.  .S DA(2)=TYP,DA(1)=STA,DA=PMT
  1.  .S DIK="^PXRMD(801.45,"_TYP_",1,"_STA_",5,"
  1.  .D ^DIK
  1.  Q
  1. MSG ;Print out the message
  1.  W !!,"The following error message was returned:",!!
  1.  S MSG="" F  S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG=""  W MSG("DIERR",1,"TEXT",MSG),!
  1.  W !!,"Unable to add a prompt to FINDING NUMBER "_TYP_" Prompt may have to be added manually."
  1.  N MSG
  1.  Q
  1. DIALOG ;Update the dialog prompt
  1.  N IEN,GUI,FDA,IENS,MSG
  1.  S IEN=0,GUI=0
  1.  S IEN=$O(^PXRMD(801.41,"B","PXRM IMM ELIG",IEN)) Q:'+IEN  D
  1.  .S GUI=$O(^PXRMD(801.42,"B","IMM_ELIG",GUI)) Q:'+GUI  D
  1.  ..S IENS=IEN_","
  1.  ..S FDA(801.41,IENS,46)=GUI
  1.  ..D UPDATE^DIE("","FDA","IENS","MSG")
  1.  ..I $D(MSG) D MSG2
  1.  K FDA,IENS,MSG
  1.  S IEN=0,GUI=0
  1.  S IEN=$O(^PXRMD(801.41,"B","PXRM ADMIN NOTES",IEN)) Q:'+IEN  D
  1.  .S GUI=$O(^PXRMD(801.42,"B","IMM_NTS",GUI)) Q:'+GUI  D
  1.  ..S IENS=IEN_","
  1.  ..S FDA(801.41,IENS,46)=GUI
  1.  ..D UPDATE^DIE("","FDA","IENS","MSG")
  1.  ..I $D(MSG) D MSG2
  1.  K FDA,IENS,MSG
  1.  Q
  1. MSG2 ;Print out the message
  1.  W !!,"The following error message was returned:",!!
  1.  S MSG="" F  S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG=""  W MSG("DIERR",1,"TEXT",MSG),!
  1.  W !!,"Unable to add a GUI PROCESS to FINDING NUMBER "_IEN_" GUI process may have to be added manually."
  1.  Q
  1.  ;
  1. INACT ;Inactivate items
  1.  N IEN,I,IENS
  1.  F I="IHS-ANTICOAG CBC 2011","IHS-ANTICOAG OCCULT BLOOD 2011","IHS-ANTICOAG UA 2011","IHS-PPD 2012" D
  1.  .S IEN="" S IEN=$O(^PXD(811.9,"B",I,IEN)) Q:IEN=""  D
  1.  ..N FDA,ERR
  1.  ..S IENS=IEN_","
  1.  ..S FDA(811.9,IENS,1.6)=1
  1.  ..D FILE^DIE("","FDA","ERR")
  1.  Q
  1.  ;===============================================================
  1. CNAK ;Make sure all "NAK" characters are converted back to "^" in
  1.  ;the Exchange File.
  1.  N IEN,TEXT
  1.  D BMES^XPDUTL("Clean up Exchange File entries")
  1.  S IEN=0
  1.  F  S IEN=+$O(^PXD(811.8,IEN)) Q:IEN=0  D
  1.  . D POSTKIDS^PXRMEXU5(IEN)
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. DELEI ;If the Exchange File entry already exists delete it.
  1.  N ARRAY,IC,IND,LIST,LUVALUE,NUM
  1.  S IC=0
  1.  F  S IC=$O(ARRAY(IC)) Q:'IC  D
  1.  .S LUVALUE(1)=ARRAY(IC,1)
  1.  .D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
  1.  .I '$D(LIST) Q
  1.  .S NUM=$P(LIST("DILIST",0),U,1)
  1.  .I NUM'=0 D
  1.  ..F IND=1:1:NUM D
  1.  ... N DA,DIK
  1.  ... S DIK="^PXD(811.8,"
  1.  ... S DA=LIST("DILIST",2,IND)
  1.  ... D ^DIK
  1.  Q
  1.  ;