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

BGOIN021.m

Go to the documentation of this file. 
  1. BGOIN021 ; IHS/MSC/PLS - BGO*1.1*21 ;15-Sep-2016 12:15;PLS
  1.  ;;1.1;BGO COMPONENTS;**21**;Mar 20, 2007
  1. EC Q
  1.  ; Preinit
  1. PRE ;
  1.  Q
  1.  ; Postinit
  1. POST ;
  1.  ; Register RPCs
  1.  D REGNMSP^CIAURPC("BGO","CIAV VUECENTRIC")
  1.  ; Update BGO component versions
  1.  N VER,FDA,PID,IEN,X
  1.  D BMES^XPDUTL("Updating version numbers...")
  1.  F VER=0:1 S X=$P($T(VER+VER),";;",2) Q:'$L(X)  D
  1.  .S PID=$$PRGID^CIAVMCFG($P(X,";"))
  1.  .S:PID FDA(19930.2,PID_",",2)=$P(X,";",2),FDA(19930.2,PID_",",7)=$P(X,";",3)
  1.  D:$D(FDA) FILE^DIE(,"FDA")
  1.  D UPDCHM
  1.  D PARS2
  1.  D ADD^XPDMENU("BGOPL MAIN","BGO UPDATE PICKLIST STATUS","UPS")
  1.  Q
  1.  ;
  1. UPDCHM ;EP-
  1.  N CHM,PID
  1.  F CHM=0:1 S X=$P($T(CHM+CHM),";;",2) Q:'$L(X)  D
  1.  .S PID=$$PRGID^CIAVMCFG($P(X,";"))
  1.  .D AECHM(PID,$P(X,";",2,99))
  1.  W !!
  1.  Q
  1. UPDBUSA ;EP-
  1.  N RPC,RPCIEN,FDA,VAL
  1.  S VAL="S X=$P(X,U)"
  1.  F RPC=0:1 S X=$P($T(BUSARPC+RPC),";;",2) Q:'$L(X)  D
  1.  .S RPCIEN=$$FIND1^DIC(9002319.03,"","MX",X)
  1.  .Q:'RPCIEN
  1.  .S FDA(9002319.03,RPCIEN_",",2.02)=VAL
  1.  I $D(FDA) D
  1.  .D FILE^DIE(,"FDA")
  1.  Q
  1. PARS ;Store system levels of new parameter
  1.  D EN^XPAR("SYS","BGO PROBLEM EDUCATION",1,"DISEASE PROCESS")
  1.  D EN^XPAR("SYS","BGO PROBLEM EDUCATION",2,"NUTRITION")
  1.  D EN^XPAR("SYS","BGO PROBLEM EDUCATION",3,"EXERCISE")
  1.  D EN^XPAR("SYS","BGO PROBLEM EDUCATION",4,"LIFESTYLE ADAPTATION")
  1.  D EN^XPAR("SYS","BGO PROBLEM EDUCATION",5,"MEDICATIONS")
  1.  D EN^XPAR("SYS","BGO PROBLEM EDUCATION",6,"PREVENTION")
  1.  Q
  1. PARS1 ;EP - Cleanup old parameter values for location
  1.  N PAR,ENT,ERR
  1.  S PAR="" S PAR=$O(^XTV(8989.51,"B","BGO PROBLEM EDUCATION",PAR))
  1.  Q:'+PAR
  1.  S ENT="" F  S ENT=$O(^XTV(8989.5,"AC",PAR,ENT)) Q:ENT=""  D
  1.  .Q:$P(ENT,";",2)'="SC("
  1.  .S ERR=0
  1.  .D NDEL^XPAR(ENT,PAR,.ERR)
  1.  N LIEN
  1.  S LIEN="" S LIEN=$O(^XTV(8989.51,PAR,30,"B",100,LIEN))
  1.  Q:LIEN=""
  1.  S DA(1)=PAR,DA=LIEN
  1.  S DIK="^XTV(8989.51,PAR,30,"
  1.  D ^DIK
  1.  Q
  1. PARS2 ;EP - Populate SNOMED Parameters
  1.  D LOCK("BGO NORMAL/ABNORMAL",0)
  1.  D EN^XPAR("SYS","BGO NORMAL/ABNORMAL",1,"w/o abn find;Without Abnormal Findings;162656002")
  1.  D EN^XPAR("SYS","BGO NORMAL/ABNORMAL",2,"w/abn find;With Abnormal Findings;71994000")
  1.  D EN^XPAR("SYS","BGO NORMAL/ABNORMAL",3,"not examined/unk;Not Applicable/Not Examined/Unknown")
  1.  D LOCK("BGO NORMAL/ABNORMAL",1)
  1.  Q
  1.  ;Set prohibit editing field of parameter
  1. LOCK(PARAM,VAL) ;EP-
  1.  N IEN
  1.  S IEN=$O(^XTV(8989.51,"B",PARAM,0))
  1.  Q:'IEN
  1.  S $P(^XTV(8989.51,IEN,0),U,6)=VAL
  1.  Q
  1.  ; Set DISABLED field of OBJ to VAL
  1. DISABLED(OBJ,VAL) ;
  1.  N PID,FDA
  1.  S VAL=$G(VAL,0)
  1.  S PID=$$PRGID^CIAVMCFG($G(OBJ))
  1.  Q:'PID
  1.  S FDA(19930.2,PID_",",13)=VAL
  1.  D FILE^DIE(,"FDA")
  1.  Q
  1. PICK ;Install the national pick lists
  1.  D UPDATE^BGOSNLK
  1.  Q
  1.  N LP,NAME,SNO,BSTS,RET
  1.  F LP=0:1 S NAME=$P($T(LIST+LP),";;",2) Q:'$L(NAME)  D
  1.  .S BSTS=$P(NAME,"^",1)
  1.  .S SNO=$P(NAME,"^",2)
  1.  .D IMPORT^BGOSNLK(.RET,BSTS,SNO)
  1.  Q
  1.  ;National pick lists
  1. LIST ;;PICK ABNORMAL FINDINGS^ABNORMAL FINDINGS
  1.  ;;PICK CQM Problems^CQM PROBLEMS
  1.  ;;PICK Case Management^CASE MANAGEMENT
  1.  ;;PICK Diabetic Retinopathy^DIABETIC RETINOPATHY
  1.  ;;PICK Eye General^EYE GENERAL
  1.  ;;PICK Immunizations^IMMUNIZATIONS
  1.  ;;PICK NIST Problems^NIST PROBLEMS
  1.  ;;PICK Nutrition^NUTRITION
  1.  ;;PICK Prenatal - Care^PRENATAL CARE
  1.  ;;PICK Prenatal - Problem Fetus^PRENATAL PROBLEM FETUS
  1.  ;;PICK Prenatal - Problem Pregnancy^PRENATAL PROBLEM PREGNANCY
  1.  ;;PICK Prenatal - Risk^PRENATAL RISK
  1.  ;;PICK Public Health Nursing^PUBLIC HEALTH NURSING
  1.  ;;PICK Womens Health^WOMENS HEALTH
  1.  ;;
  1. AECHM(PID,VAL) ;EP-
  1.  N LN,FN,IDX,TXT,ARY,CNT,IENS
  1.  S FN=$P(VAL,";"),CNT=0
  1.  S LN=0 F  S LN=$O(^CIAVOBJ(19930.2,PID,6,LN)) Q:'LN  D  Q:$G(IDX)
  1.  .S TXT=^CIAVOBJ(19930.2,PID,6,LN,0)
  1.  .S ARY(LN,0)=TXT,CNT=CNT+1
  1.  .I $$UP^XLFSTR(TXT)[$$UP^XLFSTR($P(VAL,";")) S IDX=LN
  1.  I $G(IDX) D
  1.  .S ^CIAVOBJ(19930.2,PID,6,IDX,0)=VAL
  1.  E  D
  1.  .S ARY($S('CNT:1,1:CNT+1),0)=VAL
  1.  .S IENS=PID_","
  1.  .S FDA(19930.2,IENS,10)="ARY"
  1.  .D FILE^DIE(,"FDA")
  1.  Q
  1.  ;
  1. CLNMNU ;
  1.  ; Remove option from menu
  1.  N OPTION,MENU,DA,DIK,PAR,ERR,X
  1.  S (OPTION,MENU)=""
  1.  S OPTION="BGO IMM STOP ADDING CPT CODES"
  1.  S MENU="BGOIMM MAIN"
  1.  S X=$$DELETE^XPDMENU(MENU,OPTION)
  1.  Q:'+X
  1.  ;Inactivate the option
  1.  D OUT^XPDMENU(OPTION,"No longer used")
  1.  ;Clean out the parameter
  1.  S PAR=""
  1.  S PAR=$O(^XTV(8989.51,"B","BGO IMM STOP ADDING CPT CODES",PAR))
  1.  Q:'+PAR
  1.  S ERR=0
  1.  D NDEL^XPAR("USR",PAR,.ERR)
  1.  Q:ERR>0
  1.  D NDEL^XPAR("DIV",PAR,.ERR)
  1.  Q:ERR>0
  1.  D NDEL^XPAR("PKG",PAR,.ERR)
  1.  Q:ERR>0
  1.  ;Delete the parameter
  1.  S DA=PAR,DIK="^XTV(8989.51," D ^DIK
  1.  Q
  1. VER ;;BEHIPL.IPL;1.1.20.13;09809DB11DB9C2912515A5C55A2CC799
  1.  ;;
  1.  ;;
  1. CHM ;;
  1.  ;;
  1. BUSARPC ;;
  1.  ;;