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

BJPC2P11.m

Go to the documentation of this file. 
  1. BJPC2P11 ; IHS/CMI/LAB - PCC Suite v2.0 patch 3 environment check ;   
  1.  ;;2.0;IHS PCC SUITE;**11,11**;MAY 14, 2009;Build 58
  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.  ;BJPC
  1.  I $$VERSION^XPDUTL("BJPC")'="2.0" D MES^XPDUTL($$CJ^XLFSTR("Version 2.0 of the IHS PCC SUITE (BJPC) is required.  Not installed",80)) D SORRY(2) I 1
  1.  E  D MES^XPDUTL($$CJ^XLFSTR("Requires IHS PCC Suite (BJPC) Version 2.0....Present.",80))
  1.  ;BJPC 2.0 PATCH 4
  1.  I '$$INSTALLD("BJPC*2.0*10") D SORRY(2)
  1.  I '$$INSTALLD("ATX*5.1*11") D SORRY(2)
  1.  I '$$INSTALLD("LEX*2.0*1003") D SORRY(2)
  1.  I $$VERSION^XPDUTL("AICD")<4 D MES^XPDUTL($$CJ^XLFSTR("Version 4.0 of the AICD is required.  Not installed",80)) D SORRY(2) I 1
  1.  E  D MES^XPDUTL($$CJ^XLFSTR("Requires AICD Version 4.0....Present.",80))
  1.  ;
  1.  Q
  1.  ;
  1. PRE ;
  1.  S DA=0 F  S DA=$O(^APCLVSTS(DA)) Q:DA'=+DA  S DIK="^APCLVSTS(" D ^DIK
  1.  I $T(PRE^AMQQPOST)]"" D PRE^AMQQPOST I 1
  1.  E  D AMQQPRE
  1.  S DA=$O(^APCDERR("B","E026",0))
  1.  I DA S DIE="^APCDERR(",DR=".02///UNCODED ICD DX CODE USED;.03///AN UNCODED DX CODE WAS ENTERED" D ^DIE K DA,DIE,DR
  1.  S DA=$O(^DIC(19,"B","APCD SUPER MENU FIX UNCODED",0))
  1.  I DA S DIE="^DIC(19,",DR="1///Fix UNCODED ICD Diagnoses/Operations" D ^DIE K DA,DIE,DR
  1.  Q
  1. POST ;
  1.  ;D POST^ATX6ENV
  1.  D CHA
  1.  S DIK="^APCHSURV(" D IXALL^DIK
  1.  ;HMR TEXT
  1.  D HMRT
  1.  ;remove coding quidelines
  1.  S DA=$O(^APCDTKW("B","CODE",0)) I DA S DIK="^APCDTKW(" D ^DIK K DA,DIK
  1.  D DELETE^XPDMENU("APCD MENU UTILITIES","APCD DISPLAY CODING GUIDELINES")
  1.  D DELETE^XPDMENU("APCL M DX/PROC COUNT REPORTS","APCL P QA POVAPC")
  1.  S X=$$ADD^XPDMENU("APCDSUPER","APCD UPDATE ICD FROM SNOMED","UIFS")
  1.  I 'X W !,"Attempt to add APCD UPDATE ICD FROM SNOMED option failed.." H 3
  1.  S X=$$ADD^XPDMENU("APCDCAF EHR CODING AUDIT MENU","APCDCAF INCOMP CHARTS BY PROV","ICPD")
  1.  I 'X W !,"Attempt to add APCDCAF INCOMP CHARTS BY PROV option failed.." H 3
  1.  S X=$$ADD^XPDMENU("APCDSUPER","APCD DXC BY REV/USER","DXV")
  1.  I 'X W !,"Attempt to add APCD DXC BY REV/USER option failed.." H 3
  1.  S X=$$ADD^XPDMENU("APCDCAF EHR CODING AUDIT MENU","APCDCAF TRV2","TRVL")
  1.  I 'X W !,"Attempt to add APCDCAF TRVL option failed.." H 3
  1.  D HS
  1.  D ASCI ;REINDEX NEW XREF FOR ICARE
  1.  ;D ^BJPC2A  - TAXONOMIES WILL GO OUT IN ATX
  1.  D POST^AMQQPOST
  1.  Q
  1. CHA ;
  1.  S BJPCX=0 F  S BJPCX=$O(^APCLACTG(BJPCX)) Q:BJPCX'=+BJPCX  D
  1.  .Q:$P(^APCLACTG(BJPCX,0),U,3)'="AUTTCHA"
  1.  .S DA=BJPCX,DIE="^APCLACTG(",DR=".03///ICM" D ^DIE
  1.  .Q
  1.  Q
  1. HMRT ;
  1.  S BJPCX=0 F  S BJPCX=$O(^APCHREMU(BJPCX)) Q:BJPCX'=+BJPCX  D
  1.  .S BJPCN=$P(^APCHREMU(BJPCX,0),U,1)
  1.  .S BJPCDA=$O(^APCHSURV("AL",BJPCN,0))
  1.  .I 'BJPCDA Q
  1.  .K ^APCHSURV(BJPCDA,1)
  1.  .M ^APCHSURV(BJPCDA,1)=^APCHREMU(BJPCX,11)
  1.  S DIK="^APCHSURV(" D IXALL^DIK
  1.  Q
  1. ASCI ;
  1.  NEW P,S,D,I
  1.  K ^AUPNVPOV("ASCI")
  1.  S P=0 F  S P=$O(^AUPNVPOV("ASNC",P)) Q:P'=+P  D
  1.  .S S="" F  S S=$O(^AUPNVPOV("ASNC",P,S)) Q:S=""  D
  1.  ..S D=0 F  S D=$O(^AUPNVPOV("ASNC",P,S,D)) Q:D=""  D
  1.  ...S I=0 F  S I=$O(^AUPNVPOV("ASNC",P,S,D,I)) Q:I=""  D
  1.  ....S ^AUPNVPOV("ASCI",S,I)=""
  1.  Q
  1. HS ;
  1.  S DA=$O(^APCHSCMP("B","PROBLEMS - ACTIVE",0))
  1.  I DA S DIE="^APCHSCMP(",DR="3///ACTIVE PROBLEMS (ALL)" D ^DIE K DIE,DA,DR
  1.  ;S DA=$O(^APCHSCMP("B","PROBLEMS - INACTIVE",0))
  1.  ;I DA S DIE="^APCHSCMP(",DR="3///INACTIVE/RESOLVED PROBLEMS" D ^DIE K DIE,DA,DR
  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. AMQQPRE ;EP;FOR PRE-INSTALL
  1.  N X,Y,Z
  1.  F X=1,5 D
  1.  .S Y=0
  1.  .F  S Y=$O(^AMQQ(X,Y)) Q:Y>999!'Y  K ^AMQQ(X,Y)
  1.  .S Y="A"
  1.  .F  S Y=$O(^AMQQ(X,Y)) Q:Y=""  K ^AMQQ(X,Y)
  1.  Q