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

BJPC2P20.m

Go to the documentation of this file. 
  1. BJPC2P20 ; IHS/CMI/LAB - PCC Suite v2.0 P15 ; 31 Jan 2017  11:18 AM
  1.  ;;2.0;IHS PCC SUITE;**20**;MAY 14, 2009;Build 25
  1.  ;
  1.  ;
  1.  ; The following line prevents the "Disable Options..." and "Move Routines..." questions from being asked during the install.
  1.  I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
  1.  ;KERNEL
  1.  I +$$VERSION^XPDUTL("XU")<8 D MES^XPDUTL($$CJ^XLFSTR("Version 8.0 of KERNEL is required.  Not installed",80)) D SORRY(2) I 1
  1.  E  D MES^XPDUTL($$CJ^XLFSTR("Requires Kernel Version 8.0....Present.",80))
  1.  ;FILEMAN
  1.  I +$$VERSION^XPDUTL("DI")<22 D MES^XPDUTL($$CJ^XLFSTR("Version 22.0 of FILEMAN is required.  Not installed.",80)) D SORRY(2) I 1
  1.  E  D MES^XPDUTL($$CJ^XLFSTR("Requires Fileman v22....Present.",80))
  1.  I '$$INSTALLD("BJPC*2.0*19") D MES^XPDUTL($$CJ^XLFSTR("Requires bjpc V2.0 patch 19.  Not installed.",80)) D SORRY(2)
  1.  Q
  1.  ;
  1. PRE ;
  1.  S DIU=9000010.16,DIU(0)="" D EN^DIU2 K DIU
  1.  Q
  1. POST ;
  1.  D ADDMSR  ;add measurement to PCC MAN REPORTS VGEN MEASUREMENT TYPE
  1.  S X=$$ADD^XPDMENU("APCDSUPER","APCD DELETE DUPE PT ED","DDPE",35)
  1.  I 'X W !,"Attempt to add DUPLICATE PATIENT ED option failed.." H 3
  1.  ;
  1.  S DA=$O(^APCLACTG("B","PHN",0)) I DA S DIE="^APCLACTG(",DR=".04///1" D ^DIE K DA,DIE,DR
  1.  ;FIX MEAS PANEL VU OR VC, TRANSFORM AND LENGTH
  1.  NEW BJPCDA,BJPCDA1,X,M
  1.  S BJPCDA=0 F  S BJPCDA=$O(^APCHSMPN(BJPCDA)) Q:BJPCDA'=+BJPCDA  D
  1.  .S BJPCDA1=0 F  S BJPCDA1=$O(^APCHSMPN(BJPCDA,1,BJPCDA1)) Q:BJPCDA1'=+BJPCDA1  D
  1.  ..S X=$P($G(^APCHSMPN(BJPCDA,1,BJPCDA1,0)),U,2)
  1.  ..Q:'X
  1.  ..S M=$P($G(^AUTTMSR(X,0)),U,1)
  1.  ..I M'="VU",M'="VC" Q  ;VISION ONLY
  1.  ..S $P(^APCHSMPN(BJPCDA,1,BJPCDA1,0),U,3)=17
  1.  ..S ^APCHSMPN(BJPCDA,1,BJPCDA1,1)="S X=$$VCVU^AUPNVMSR(X,APCHSVNM)"
  1.  ;
  1. ER ;MOVE V ER .16 TO 1.01
  1.  D MES^XPDUTL($$CJ^XLFSTR("Moving .16 of V ER to 1.01",80))
  1.  S BJPCDA=0 F  S BJPCDA=$O(^AUPNVER(BJPCDA)) Q:BJPCDA'=+BJPCDA  D
  1.  .S BJPCX=$$VAL^XBDIQ1(9000010.29,BJPCDA,.16)
  1.  .Q:BJPCX=""
  1.  .S DIE="^AUPNVER(",DA=BJPCDA,DR="1.01///"_BJPCX D ^DIE K DA,DIE,DR
  1.  .Q
  1. VPED ;REINDEX APRB, APRV ON V PATIENT ED
  1.  D MES^XPDUTL($$CJ^XLFSTR("Reindexing APRB and APRV on V Patient ED",80))
  1.  K ^AUPNVPED("APRB")
  1.  K ^AUPNVPED("APRV")
  1.  S DIK="^AUPNVPED(",DIK(1)="1103^APRB^APRV" D ENALL^DIK K DIK
  1.  Q
  1. ADDMSR ;-add the measurement type
  1.  N I
  1.  F I="BMI","BMIP" D ADDM(I)
  1.  Q
  1.  ;
  1. ADDM(MSR) ;-- add it here
  1.  N FDA,FIENS,FERR,MSRI,MIEN
  1.  N WFIENS,WFERR,WFROOT,WP
  1.  S MSRI=$O(^AUTTMSR("B",MSR,0))
  1.  Q:'MSRI
  1.  Q:$O(^APCLVGMS("B",MSRI,0))
  1.  S FIENS="+1,"
  1.  S FDA(9001003.71,FIENS,.01)=MSRI
  1.  S FDA(9001003.71,FIENS,.02)=1
  1.  D UPDATE^DIE("","FDA","FIENS","FERR(1)")
  1.  I $D(FERR(1)) Q
  1.  S MIEN=$G(FIENS(1))
  1.  S ^APCLVGMS(MIEN,2)="K:X'[""-"" X I $D(X) D NUMIP^APCLVL03"
  1.  S WFIENS=MIEN_","
  1.  I MSR="BMI" D BMIH
  1.  I MSR="BMIP" D BMIPH
  1.  D WP^DIE(9001003.71,WFIENS,1,,"BJPCH")
  1.  K BJPCH
  1.  Q
  1.  ;
  1. INSTALLD(BJPCSTAL) ;EP - Determine if patch BJPCSTAL was installed, where
  1.  ; APCLSTAL is the name of the INSTALL.  E.g "AG*6.0*11".
  1.  ;
  1.  NEW BJPCY,DIC,X,Y
  1.  S X=$P(BJPCSTAL,"*",1)
  1.  S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
  1.  D IX^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",22,",X=$P(BJPCSTAL,"*",2)
  1.  D ^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(BJPCSTAL,"*",3)
  1.  D ^DIC
  1.  S BJPCY=Y
  1.  D IMES
  1.  Q $S(BJPCY<1:0,1:1)
  1. IMES ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("Patch """_BJPCSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
  1.  Q
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  I X=3 S XPDQUIT=2 Q
  1.  S XPDQUIT=X
  1.  W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
  1.  Q
  1.  ;
  1. BMIH ;-bmi help
  1.  K BJPCH
  1.  S BJPCH(1)="Enter a range of BMI  values to search for.  Enter the range in the "
  1.  S BJPCH(2)="format nnn-nnn.  For example, to search for all BMI measurements with "
  1.  S BJPCH(3)="a value of 20-30 enter 20-30."
  1.  Q
  1.  ;
  1. BMIPH ;-bmip help
  1.  K BJPCH
  1.  S BJPCH(1)="Enter a range of BMIP values to search for.  Enter the range in the "
  1.  S BJPCH(2)="format nnn-nnn (decimal digits are allowed)."
  1.  S BJPCH(3)=" For example, to search for all BMIP measurements with"
  1.  S BJPCH(4)="a value of 50-60 enter 50-60."
  1.  Q
  1.  ;