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

BPXRM201.m

Go to the documentation of this file. 
  1. BPXRM201 ; IHS/MSC/MGH - Version 2.0 Patch 1 post routine. ;10-Dec-2013 13:12;DU
  1.  ;;2.0;CLINICAL REMINDERS;**1001**;Feb 04, 2005;Build 21
  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.  ;===============================================================
  1. PRE ;EP pre-init
  1.  ;Delete exchange file entries put in by patches
  1.  D DELEI
  1.  ;delete the DDs for files with Variable pointers
  1.  D DELDD
  1.  Q
  1.  ;===============================================================
  1. POST ;Post-install
  1.  D TYPE
  1.  D UPDATE
  1.  Q
  1.  ;
  1. ARRAY(ARRAY) ;List of exchange entries used by delete and install
  1.  ;Patch 1 reminders
  1.  S ARRAY(1,1)="VA-WH MAMMOGRAM REVIEW RESULTS"
  1.  S ARRAY(2,1)="VA-WH MAMMOGRAM SCREENING"
  1.  S ARRAY(3,1)="VA-WH PAP SMEAR REVIEW RESULTS"
  1.  S ARRAY(4,1)="VA-WH PAP SMEAR SCREENING"
  1.  ;Patch 3 reminders
  1.  S ARRAY(5,1)="VA-MHV BMI > 25.0"
  1.  S ARRAY(6,1)="VA-MHV CERVICAL CANCER SCREEN"
  1.  S ARRAY(7,1)="VA-MHV COLORECTAL CANCER SCREEN"
  1.  S ARRAY(8,1)="VA-MHV DIABETES FOOT EXAM"
  1.  S ARRAY(9,1)="VA-MHV DIABETES HGBA1C"
  1.  S ARRAY(10,1)="VA-MHV DIABETES RETINAL EXAM"
  1.  S ARRAY(11,1)="VA-MHV HYPERTENSION"
  1.  S ARRAY(12,1)="VA-MHV INFLUENZA VACCINE"
  1.  S ARRAY(13,1)="VA-MHV LDL CONTROL"
  1.  S ARRAY(14,1)="VA-MHV LIPID MEASUREMENT"
  1.  S ARRAY(15,1)="VA-MHV MAMMOGRAM SCREENING"
  1.  S ARRAY(16,1)="VA-MHV PNEUMOVAX"
  1.  ;Patch 5 reminder
  1.  S ARRAY(17,1)="VA-IRAQ & AFGHAN POST-DEPLOY SCREEN"
  1.  ;Patch 4 reminder
  1.  S ARRAY(18,1)="VA-WH BILATERAL MASTECTOMY"
  1.  S ARRAY(19,1)="VA-WH HYSTERECTOMY W/CERVIX REMOVED"
  1.  S ARRAY(20,1)="VA-MST SCREENING"
  1.  S ARRAY(21,1)="VA-GEC REFERRAL CARE RECOMMENDATION"
  1.  S ARRAY(22,1)="VA-MHV INFLUENZA VACCINE"
  1.  S ARRAY(23,1)="VA-*QUERI LIST RULE UPDATES"
  1.  S ARRAY(24,1)="VA-GEC REFERRAL NURSING ASSESSMENT"
  1.  S ARRAY(25,1)="VA-*QUERI LIST RULE UPDATES"
  1.  S ARRAY(26,1)="VA-HTN ASSESSMENT BP >=140/90"
  1.  S ARRAY(27,1)="VA-HTN ASSESSMENT BP >=160/100"
  1.  ;Patch 8 reminder
  1.  S ARRAY(28,1)="VA-TBI SCREENING"
  1.  ;Patch 10 Reminders
  1.  S ARRAY(29,1)="VA-VANOD SKIN ASSESSMENT"
  1.  S ARRAY(30,1)="VA-VANOD SKIN REASSESSMENT"
  1.  S ARRAY(31,1)="GMTS SKIN RISK HS OBJECTS"
  1.  S ARRAY(32,1)="GMTS SKIN RISK HS TYPES"
  1.  ;Patch 6
  1.  S ARRAY(33,1)="PXRM*2*6 TAXONOMY UPDATES"
  1.  S ARRAY(34,1)="VA-MH TERM UPDATE"
  1.  ;Patch 11 reminders
  1.  S ARRAY(35,1)="VA-ALCOHOL AUDIT-C POSITIVE F/U"
  1.  S ARRAY(36,1)="VA-ALCOHOL USE SCREEN (AUDIT-C"
  1.  S ARRAY(37,1)="VA-BL ALCOHOL SCREEN"
  1.  S ARRAY(38,1)="VA-BL ALCOHOL WITHIN SAFE LIMIT"
  1.  S ARRAY(39,1)="VA-BL DEPRESSION SCREEN"
  1.  S ARRAY(40,1)="VA-BL PTSD SCREEN"
  1.  S ARRAY(41,1)="VA-BL OEF/OIF EMBEDDED FRAGMENTS"
  1.  S ARRAY(42,1)="VA-BL OEF/OIF FEVER"
  1.  S ARRAY(43,1)="VA-BL OEF/OIF GI SX"
  1.  S ARRAY(44,1)="VA-BL OEF/OIF SKIN SX"
  1.  S ARRAY(45,1)="VA-BL OEF/OIF OTHER SX"
  1.  S ARRAY(46,1)="VA-BL OEF/OIF SERVICE INFO ENTERED"
  1.  S ARRAY(47,1)="VA-CV ELIG W/HF FOR NO SERVICE"
  1.  S ARRAY(48,1)="VA-CV INELG W/HF FOR SERVICE"
  1.  S ARRAY(49,1)="VA-DEPRESSION SCREENING"
  1.  S ARRAY(50,1)="VA-IRAQ & AFGHAN POST-DEPLOY SCREEN"
  1.  S ARRAY(51,1)="VA-MHV CERVICAL CANCER SCREEN"
  1.  S ARRAY(52,1)="VA-MHV COLORECTAL CANCER SCREEN"
  1.  S ARRAY(53,1)="VA-MHV DIABETES FOOT EXAM"
  1.  S ARRAY(54,1)="VA-MHV DIABETES RETINAL EXAM"
  1.  S ARRAY(55,1)="VA-MHV HYPERTENSION"
  1.  S ARRAY(56,1)="VA-MHV INFLUENZA VACCINE"
  1.  S ARRAY(57,1)="VA-MHV MAMMOGRAM SCREENING"
  1.  S ARRAY(58,1)="VA-MHV PNEUMOVAX"
  1.  S ARRAY(59,1)="VA-OEF/OIF MONITOR REPORTING"
  1.  S ARRAY(60,1)="VA-PTSD SCREENING"
  1.  S ARRAY(61,1)="VA-TBI SCREENING"
  1.  S ARRAY(62,1)="PATCH 11 ITEMS"
  1.  S ARRAY(63,1)="PATCH 11 LOCATION LIST"
  1.  ;Patch 15 reminder
  1.  S ARRAY(64,1)="VA-TBI/POLYTRAUMA REHAB/REINTEGRATION PLAN OF CARE"
  1.  ;OTHER
  1.  S ARRAY(65,1)="PXRM RESULT GROUP UPDATE REMINDER"
  1.  S ARRAY(66,1)="VA-MHV DIABETES HBA1C"
  1.  Q
  1.  ;
  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.  . S TEXT=" Working on Exchange File entry "_IEN
  1.  . D BMES^XPDUTL(TEXT)
  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.  D ARRAY(.ARRAY)
  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.  ;
  1.  ;===============================================================
  1. DELDD ;Delete the old data dictionaries.
  1.  N DIU,TEXT
  1.  D EN^DDIOL("Removing old data dictionaries.")
  1.  S DIU(0)=""
  1.  F DIU=801.41,811.5,811.9 D
  1.  . S TEXT=" Deleting data dictionary for file # "_DIU
  1.  . D EN^DDIOL(TEXT)
  1.  . D EN^DIU2
  1.  Q
  1. TYPE ;==========================================================
  1.  ;Remove add to problem list from ICD finding type
  1.  N IEN,MSG,TYP,PMT,IENS,STA
  1.  S IEN=$O(^PXRMD(801.41,"B","PXRM ADD TO PROBLEM LIST",""))
  1.  S TYP=$$FIND1^DIC(801.45,,,"POV",,,"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 POV FINDING TYPE"
  1.  I '$D(MSG) D POV
  1.  Q
  1. POV ;Remove the prompt
  1.  S IENS=","_TYP_","
  1.  S STA=$$FIND1^DIC(801.451,IENS,,"DONE AT ENCOUNTER",,,.MSG)
  1.  S PMT=$O(^PXRMD(801.45,TYP,1,STA,5,"B",IEN,""))
  1.  I +PMT D DELETE(TYP,STA,PMT)
  1.  S STA=$$FIND1^DIC(801.451,IENS,,"DONE ELSEWHERE (HISTORICAL)",,,.MSG)
  1.  S PMT=$O(^PXRMD(801.45,TYP,1,STA,5,"B",IEN,""))
  1.  I +PMT D DELETE(TYP,STA,PMT)
  1.  Q
  1.  ;Delete the subnodes
  1. DELETE(TYP,STA,PMT) ;DELETE
  1.  N DA,DIK
  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. UPDATE ;Remove all findings and additional findings that are ICD
  1.  ;Taxonomies that contain ICD will be made inactive
  1.  N IEN,TYPE,NLINES,SUB,SUBT
  1.  S NLINES=0
  1.  S IEN=0
  1.  F  S IEN=$O(^PXRMD(801.41,IEN)) Q:'+IEN  D
  1.  .Q:$$GET1^DIQ(801.41,IEN,3)'=""
  1.  .S TYPE=$P($G(^PXRMD(801.41,IEN,1)),U,5)
  1.  .I $P(TYPE,";",2)="ICD9(" S TAX=$P(TYPE,";",1) D DELF(IEN)
  1.  .I $P(TYPE,";",2)="PXD(811.2," D TAX(IEN,$P(TYPE,";",1))
  1.  .S SUB=0 F  S SUB=$O(^PXRMD(801.41,IEN,3,SUB)) Q:'+SUB  D
  1.  ..S SUBT=$P($G(^PXRMD(801.41,IEN,3,SUB,0)),U,1)
  1.  ..I $P(SUBT,";",2)="ICD9(" D DELSUB(IEN,SUB,$P(SUBT,";",1))
  1.  I NLINES>0 D SEND^PXRMMSG("Reminder items deleted or inactivated")
  1.  Q
  1. DELF(IEN) ;Delete the item
  1.  N FDA,ERR,NAME
  1.  S FDA(801.41,IEN_",",15)="@"
  1.  D FILE^DIE("","FDA","ERR")
  1.  S NAME=$$GET1^DIQ(801.41,IEN,.01)
  1.  S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)="Dialog "_NAME_" had finding item deleted."
  1.  Q
  1. TAX(IEN,TAX) ;Check for 80 nodes and inactivate
  1.  N FDA,ERR
  1.  I $D(^PXD(811.2,TAX,80)) D
  1.  .S FDA(811.2,TAX_",",1.6)=1
  1.  .D FILE^DIE("","FDA","ERR")
  1.  .S NAME=$$GET1^DIQ(811.2,TAX,.01)
  1.  .S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)="Taxonomy "_NAME_" was inactivated."
  1.  Q
  1. DELSUB(IEN,SUB,ICD) ;Delete sub-file
  1.  N DA,DIK
  1.  S DA(1)=IEN,DA=SUB
  1.  S DIK="^PXRMD(801.41,"_IEN_",3,"
  1.  D ^DIK
  1.  S NAME=$$GET1^DIQ(801.41,IEN,.01)
  1.  S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)="Dialog "_NAME_" had an additional finding deleted."
  1.  Q