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

BJPC2P3.m

Go to the documentation of this file. 
  1. BJPC2P3 ; IHS/CMI/LAB - PCC Suite v1.0 patch 3 environment check ;   
  1.  ;;2.0;IHS PCC SUITE;**4**;MAY 14, 2009
  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.  I '$$INSTALLD("APCL*3.0*25") D SORRY(2)
  1.  I '$$INSTALLD("BJPC*2.0*2") D SORRY(2)
  1.  ;
  1.  Q
  1.  ;
  1. PRE ;
  1.  S BJPCDA=0 F  S BJPCDA=$O(^APCLVSTS(BJPCDA)) Q:BJPCDA'=+BJPCDA  S DA=BJPCDA,DIK="^APCLVSTS(" D ^DIK
  1.  K DIK,DA
  1.  S DA=$O(^APCHSCMP("B","MEASUREMENT PANELS",0))
  1.  I DA S DIE="^APCHSCMP(",DR=".01///MEASUREMENT PANELS (OUTPATIENT)" D ^DIE
  1.  S DA=$O(^APCHSCMP("B","MEASUREMENTS",0))
  1.  I DA S DIE="^APCHSCMP(",DR=".01///MEASUREMENTS (OUTPATIENT)" D ^DIE
  1.  K DA,DIE,DR
  1.  ;DELETE V MEAS DD SO XREFS GO AWAY
  1.  S DIU(0)="",DIU=9000010.01
  1.  D EN^DIU2
  1.  Q
  1. POST ;
  1.  ;file qualifiers into multiple 1 in GMRV VITAL QUALIFIERS
  1.  D MES^XPDUTL("Adding Measurement Type to Vital Qualifiers file...")
  1.  ;wipe out existing data
  1.  S X=0 F  S X=$O(^GMRD(120.52,X)) Q:X'=+X  K ^GMRD(120.52,X,1)
  1.  K ^GMRD(120.52,"AA"),^GMRD(120.52,"BB"),^GMRD(120.52,"D"),^GMRD(120.52,"C")
  1.  NEW BJPCVIEN,BJPCMT,BJPCCAT,BJPCMIEN,BJPCFDA,BJPCIENS,BJPCERRR,BJPCAIEN
  1.  S BJPCVIEN=0
  1.  F  S BJPCVIEN=$O(@XPDGREF@("VITALQUALMT",BJPCVIEN)) Q:BJPCVIEN<1  D
  1.  .S BJPCMIEN=0 F  S BJPCMIEN=$O(@XPDGREF@("VITALQUALMT",BJPCVIEN,BJPCMIEN)) Q:BJPCMIEN'=+BJPCMIEN  D
  1.  ..S MT=$P(@XPDGREF@("VITALQUALMT",BJPCVIEN,BJPCMIEN),U,1)
  1.  ..S CAT=$P(@XPDGREF@("VITALQUALMT",BJPCVIEN,BJPCMIEN),U,2)
  1.  ..;file entry into multiple using the external values
  1.  ..K BJPCFDA,BJPCIENS,BJPCERRR,BJPCAIEN
  1.  ..S BJPCIENS="+2,"_BJPCVIEN_","
  1.  ..S BJPCFDA(120.521,BJPCIENS,.01)=MT
  1.  ..S BJPCFDA(120.521,BJPCIENS,.02)=CAT
  1.  ..D UPDATE^DIE("E","BJPCFDA","BJPCIENS","BJPCERRR(1)")
  1.  ..I $D(BJPCERRR) D MES^XPDUTL("Error updating qualifier "_$P(^GMRD(120.52,BJPCVIEN,0),U)_" / measurement type "_MT)
  1. VMEAS ;
  1.  D MES^XPDUTL("hold on...fixing V Measurement entries, this may take a while...")
  1.  ;take 1201 field value and if entered by data entry move to .07 and then wipe out 1201 field
  1.  S BJPCDA=0,BJPCCNT=0 F  S BJPCDA=$O(^AUPNVMSR(BJPCDA)) Q:BJPCDA'=+BJPCDA  D
  1.  .S BJPCCNT=BJPCCNT+1
  1.  .I '(BJPCCNT#10000) W "."
  1.  .Q:'$D(^AUPNVMSR(BJPCDA,12))
  1.  .Q:'$P(^AUPNVMSR(BJPCDA,12),U,1)  ;no date
  1.  .Q:$P(^AUPNVMSR(BJPCDA,12),U,2)  ;EHR Entered
  1.  .Q:$P(^AUPNVMSR(BJPCDA,12),U,4)  ;EHR ENTERED
  1.  .S BJPCSAVE=$P(^AUPNVMSR(BJPCDA,0),U,7)
  1.  .S DA=BJPCDA,DR=".07///"_$P(^AUPNVMSR(BJPCDA,12),U,1)_";1201///@",DIE="^AUPNVMSR(" D ^DIE K DA,DIE,DR
  1.  .I BJPCSAVE]"" S DA=BJPCDA,DR="1201///"_BJPCSAVE,DIE="^AUPNVMSR(" D ^DIE K DA,DR,DIE  ;if they had entered a .07 move it to 1201 although I doubt d/e entered it as they don't know it
  1.  ;reindex AB and AE if they are moved to 1201
  1.  D MES^XPDUTL("reindexing AB and AE xrefs...")
  1.  K ^AUPNVMSR("AB"),^AUPNVMSR("AE")  ;kill existing xrefs
  1.  S DIK="^AUPNVMSR(",DIK(1)="1201^AB^AE"
  1.  D ENALL^DIK
  1.  Q
  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.  ; Pre-Transport global for Vital Qualifier measurement type mapping (multiple)
  1. PRETRAN ;
  1.  N IEN,VAL,TXT,MIEN,MT,CAT,BJPCAR,J,BJPCC
  1.  S IEN=0,BJPCC=0
  1.  F  S IEN=$O(^GMRD(120.52,IEN)) Q:IEN<1  D
  1.  .K BJPCAR
  1.  .D GETS^DIQ(120.52,IEN_",",1_"*","","BJPCAR")
  1.  .S J="" F  S J=$O(BJPCAR(120.521,J)) Q:J=""  D
  1.  ..S MT=$G(BJPCAR(120.521,J,.01))
  1.  ..S CAT=$G(BJPCAR(120.521,J,.02))
  1.  ..S BJPCC=BJPCC+1
  1.  ..S @XPDGREF@("VITALQUALMT",IEN,BJPCC)=MT_"^"_CAT
  1.  Q