ATX51P19 ; IHS/CMI/LAB - PCC Suite v5.1 patch 19 environment check
;;5.1;TAXONOMY;**19**;FEB 04, 1997;Build 32
;
;
; The following line prevents the "Disable Options..." and "Move
; Routines..." questions from being asked during the install.
I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
I '$$INSTALLD("ATX*5.1*18") D SORRY(2)
I +$$VERSION^XPDUTL("AICD")<4 D MES^XPDUTL($$CJ^XLFSTR("Version 4.0 of AICD is required. Not installed",80)) D SORRY(2) I 1
E D MES^XPDUTL($$CJ^XLFSTR("Requires AICD V4.0....Present.",80))
;
Q
;
PRE ;
Q
POST ;
D ^ATXF6
D SETTAXRN^ATX6ENV
Q
SETTAXRN ;EP
;set read only and no delete for selected taxonomies
S ATXTFI="" F S ATXTFI=$O(^ATXAX("B",ATXTFI)) Q:ATXTFI="" D
.S ATXTDA=$O(^ATXAX("B",ATXTFI,0))
.Q:'ATXTDA ;did not find taxonomy
.Q:'$$NS(ATXTFI)
.I $P(^ATXAX(ATXTDA,0),U,4)'="n" S $P(^ATXAX(ATXTDA,0),U,4)="n" D MES^XPDUTL(".") ;set no delete
.Q:$P(^ATXAX(ATXTDA,0),U,22)=1 ;ALREADY SET
.S F=$P(^ATXAX(ATXTDA,0),U,15)
.I $$RO(F,ATXTFI) S $P(^ATXAX(ATXTDA,0),U,22)=1 D MES^XPDUTL($P(^ATXAX(ATXTDA,0),U,1)) ;SET READ ONLY
.Q
Q
RO(T,S) ;
I T=81 Q 1 ;CPT
I T=80 Q 1 ;ICD DX
I T=80.1 Q 1 ;ICD OP
I T=9999999.31 Q 1 ;
I T=9999999.64 Q 1 ;HEALTH FACTORS
I T=9999999.14 Q 1 ;cvx codes
I T=95.3 Q 1 ;LAB LOINC
I S[" NDC" Q 1 ;NDC taxonomies - not perfect logic by no tax had " NDC " but NDC taxonomies
Q 0
NS(T,L) ;
;I T["DIABETES REG" Q 0
I $E(T,1,4)="APCD" Q 1
I $E(T,1,3)="BGP" Q 1
;I $E(T,1,7)="SURVEIL" Q 1
I $E(T,1,4)="APCH" Q 1
I $E(T,1,4)="APCL" Q 1
I $E(T,1,3)="ATX" Q 1
;I $E(T,1,3)="BAT" Q 1
;I $E(T,1,3)="BDR" Q 1
;I $E(T,1,3)="BI " Q 1
I $E(T,1,4)="BJPC" Q 1
;I $E(T,1,3)="BUD" Q 1
;I $E(T,1,8)="DM AUDIT" Q 1
Q 0
INSTALLD(ATXSTAL) ;EP - Determine if patch ATXSTAL was installed, where
; ATXSTAL is the name of the INSTALL. E.g "AG*6.0*11".
;
NEW ATXY,DIC,X,Y
S X=$P(ATXSTAL,"*",1)
S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
D IX^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",22,",X=$P(ATXSTAL,"*",2)
D ^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",""PAH"",",X=$P(ATXSTAL,"*",3)
D ^DIC
S ATXY=Y
D IMES
Q $S(ATXY<1:0,1:1)
IMES ;
D MES^XPDUTL($$CJ^XLFSTR("Patch """_ATXSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
Q
SORRY(X) ;
KILL DIFQ
I X=3 S XPDQUIT=2 Q
S XPDQUIT=X
W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
Q
ATX51P19 ; IHS/CMI/LAB - PCC Suite v5.1 patch 19 environment check
+1 ;;5.1;TAXONOMY;**19**;FEB 04, 1997;Build 32
+2 ;
+3 ;
+4 ; The following line prevents the "Disable Options..." and "Move
+5 ; Routines..." questions from being asked during the install.
+6 IF $GET(XPDENV)=1
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+7 FOR X="XPO1","XPZ1","XPZ2","XPI1"
SET XPDDIQ(X)=0
+8 IF '$$INSTALLD("ATX*5.1*18")
DO SORRY(2)
+9 IF +$$VERSION^XPDUTL("AICD")<4
DO MES^XPDUTL($$CJ^XLFSTR("Version 4.0 of AICD is required. Not installed",80))
DO SORRY(2)
IF 1
+10 IF '$TEST
DO MES^XPDUTL($$CJ^XLFSTR("Requires AICD V4.0....Present.",80))
+11 ;
+12 QUIT
+13 ;
PRE ;
+1 QUIT
POST ;
+1 DO ^ATXF6
+2 DO SETTAXRN^ATX6ENV
+3 QUIT
SETTAXRN ;EP
+1 ;set read only and no delete for selected taxonomies
+2 SET ATXTFI=""
FOR
SET ATXTFI=$ORDER(^ATXAX("B",ATXTFI))
IF ATXTFI=""
QUIT
Begin DoDot:1
+3 SET ATXTDA=$ORDER(^ATXAX("B",ATXTFI,0))
+4 ;did not find taxonomy
IF 'ATXTDA
QUIT
+5 IF '$$NS(ATXTFI)
QUIT
+6 ;set no delete
IF $PIECE(^ATXAX(ATXTDA,0),U,4)'="n"
SET $PIECE(^ATXAX(ATXTDA,0),U,4)="n"
DO MES^XPDUTL(".")
+7 ;ALREADY SET
IF $PIECE(^ATXAX(ATXTDA,0),U,22)=1
QUIT
+8 SET F=$PIECE(^ATXAX(ATXTDA,0),U,15)
+9 ;SET READ ONLY
IF $$RO(F,ATXTFI)
SET $PIECE(^ATXAX(ATXTDA,0),U,22)=1
DO MES^XPDUTL($PIECE(^ATXAX(ATXTDA,0),U,1))
+10 QUIT
End DoDot:1
+11 QUIT
RO(T,S) ;
+1 ;CPT
IF T=81
QUIT 1
+2 ;ICD DX
IF T=80
QUIT 1
+3 ;ICD OP
IF T=80.1
QUIT 1
+4 ;
IF T=9999999.31
QUIT 1
+5 ;HEALTH FACTORS
IF T=9999999.64
QUIT 1
+6 ;cvx codes
IF T=9999999.14
QUIT 1
+7 ;LAB LOINC
IF T=95.3
QUIT 1
+8 ;NDC taxonomies - not perfect logic by no tax had " NDC " but NDC taxonomies
IF S[" NDC"
QUIT 1
+9 QUIT 0
NS(T,L) ;
+1 ;I T["DIABETES REG" Q 0
+2 IF $EXTRACT(T,1,4)="APCD"
QUIT 1
+3 IF $EXTRACT(T,1,3)="BGP"
QUIT 1
+4 ;I $E(T,1,7)="SURVEIL" Q 1
+5 IF $EXTRACT(T,1,4)="APCH"
QUIT 1
+6 IF $EXTRACT(T,1,4)="APCL"
QUIT 1
+7 IF $EXTRACT(T,1,3)="ATX"
QUIT 1
+8 ;I $E(T,1,3)="BAT" Q 1
+9 ;I $E(T,1,3)="BDR" Q 1
+10 ;I $E(T,1,3)="BI " Q 1
+11 IF $EXTRACT(T,1,4)="BJPC"
QUIT 1
+12 ;I $E(T,1,3)="BUD" Q 1
+13 ;I $E(T,1,8)="DM AUDIT" Q 1
+14 QUIT 0
INSTALLD(ATXSTAL) ;EP - Determine if patch ATXSTAL was installed, where
+1 ; ATXSTAL is the name of the INSTALL. E.g "AG*6.0*11".
+2 ;
+3 NEW ATXY,DIC,X,Y
+4 SET X=$PIECE(ATXSTAL,"*",1)
+5 SET DIC="^DIC(9.4,"
SET DIC(0)="FM"
SET D="C"
+6 DO IX^DIC
+7 IF Y<1
DO IMES
QUIT 0
+8 SET DIC=DIC_+Y_",22,"
SET X=$PIECE(ATXSTAL,"*",2)
+9 DO ^DIC
+10 IF Y<1
DO IMES
QUIT 0
+11 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(ATXSTAL,"*",3)
+12 DO ^DIC
+13 SET ATXY=Y
+14 DO IMES
+15 QUIT $SELECT(ATXY<1:0,1:1)
IMES ;
+1 DO MES^XPDUTL($$CJ^XLFSTR("Patch """_ATXSTAL_""" is"_$SELECT(Y<1:" *NOT*",1:"")_" installed.",IOM))
+2 QUIT
SORRY(X) ;
+1 KILL DIFQ
+2 IF X=3
SET XPDQUIT=2
QUIT
+3 SET XPDQUIT=X
+4 WRITE *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
+5 QUIT
