ACPTENVC ; IHS/SD/SDR - Environment checker for ACPT V2.10 ;4/21/08 14:11
;;2.10;CPT FILES;;DEC 18, 2009
;
I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
;
I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
;
S X=$P(^VA(200,DUZ,0),U)
W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_" Patch "_$P($T(+2),";",5)_".",IOM),!
;
S XPDQUIT=0,ACPTQUIT=0
I '$$VCHK("XU","8",2)
I '$$VCHK("XT","7.3",2)
I '$$VCHK("DI","21",2)
I '$$VCHK("ACPT","2.09",2) S XPDQUIT=2
;
NEW DA,DIC
S X="ACPT",DIC="^DIC(9.4,",DIC(0)="",D="C"
D IX^DIC
I Y<0,$D(^DIC(9.4,"C","ACPT")) D S XPDQUIT=2
. W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""ACPT"" prefix.",IOM)
. W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
. W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
.Q
;
I XPDQUIT D SORRY(XPDQUIT) Q
;
W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
;
I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2) Q
Q
;
SORRY(X) ;
KILL DIFQ
S XPDQUIT=X
W:'$D(ZTQUEUED) *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
Q
;
VCHK(ACPTPRE,ACPTVER,ACPTQUIT) ; Check versions needed.
;
NEW ACPTV
S ACPTV=$$VERSION^XPDUTL(ACPTPRE)
W !,$$CJ^XLFSTR("Need at least "_ACPTPRE_" v "_ACPTVER_"....."_ACPTPRE_" v "_ACPTV_" Present",IOM)
I ACPTV<ACPTVER S XPDQUIT=ACPTQUIT W *7,!,$$CJ^XLFSTR("^^^^**NEEDS FIXED**^^^^",IOM) Q 0
Q 1
;
INSTALLD(ACPTINST) ;EP - Determine if patch ACPTINST was installed, where ACPTINST is
; the name of the INSTALL. E.g "AG*6.0*10".
;;^DIC(9.4,D0,22,D1,PAH,D2,0)=
;;(#.01) PATCH APPLICATION HISTORY [1F] ^ (#.02)DATE APPLIED [2D] ^ (#.03) APPLIED BY [3P] ^
NEW DIC,X,Y
S X=$P(ACPTINST,"*",1)
S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
D IX^DIC
I Y<1 Q 0
S DIC=DIC_+Y_",22,",X=$P(ACPTINST,"*",2)
D ^DIC
I Y<1 Q 0
S DIC=DIC_+Y_",""PAH"",",X=$P(ACPTINST,"*",3)
D ^DIC
Q $S(Y<1:0,1:1)
;
LAST(PKG,VER) ;EP - returns last patch applied for a Package, PATCH^DATE
; Patch includes Seq # if Released
N PKGIEN,VERIEN,LATEST,PATCH,SUBIEN
I $G(VER)="" S VER=$$VERSION^XPDUTL(PKG) Q:'VER -1
S PKGIEN=$O(^DIC(9.4,"B",PKG,"")) Q:'PKGIEN -1
S VERIEN=$O(^DIC(9.4,PKGIEN,22,"B",VER,"")) Q:'VERIEN -1
S LATEST=-1,PATCH=-1,SUBIEN=0
F S SUBIEN=$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN)) Q:SUBIEN'>0 D
. I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST S LATEST=$P(^(0),U,2),PATCH=$P(^(0),U)
. I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)=LATEST,$P(^(0),U)>PATCH S PATCH=$P(^(0),U)
Q PATCH_U_LATEST
;
POST1(ACPTDIR) ; input transform for KIDS question POST1
;
; .ACPTDIR, passed by reference, is X from the Fileman Reader, the
; input to this input transform.
;
I $ZV["UNIX" D ; if unix, ensure proper syntax for unix
.S ACPTDIR=$TR(ACPTDIR,"\","/") ; forward slash should delimit
.S:$E(ACPTDIR)'="/" ACPTDIR="/"_ACPTDIR ; start with root (/)
.S:$E(ACPTDIR,$L(ACPTDIR))'="/" ACPTDIR=ACPTDIR_"/" ; ensure trailing /
;
E D ; otherwise, ensure proper syntax for other operating systems
.S ACPTDIR=$TR(ACPTDIR,"/","\") ; back slash should delimit
.I $E(ACPTDIR)'="\",ACPTDIR'[":" D
..S ACPTDIR="\"_ACPTDIR ; start with \ if not using : (?)
.S:$E(ACPTDIR,$L(ACPTDIR))'="\" ACPTDIR=ACPTDIR_"\" ; ensure trailing \
;
W !!,"Checking directory ",ACPTDIR,"..."
;
N ACPTFIND S ACPTFIND=0 ; do we find our files in that directory?
D ; find out whether that directory contains those files
.N ACPTFILE
.S ACPTFILE("acpt2010.9l")=""
.S ACPTFILE("acpt2010.9h")=""
.S ACPTFILE("acpt2010.9d")=""
.S ACPTFILE("acpt2010.l")=""
.S ACPTFILE("acpt2010.d")=""
.N Y S Y=$$LIST^%ZISH(ACPTDIR,"ACPTFILE","ACPTFIND")
.D Q:ACPTFIND ; format for most platforms:
..K ACPTQUIT
..I ($$VERSION^XPDUTL("BCSV")>0) D Q:($G(ACPTQUIT)=1)
...I ('$D(ACPTFIND("acpt2010.9l"))&('$D(ACPTFIND(ACPTDIR_"acpt2010.9l")))) S ACPTQUIT=1
...I ('$D(ACPTFIND("acpt2010.9h"))&('$D(ACPTFIND(ACPTDIR_"acpt2010.9h")))) S ACPTQUIT=1
...I ('$D(ACPTFIND("acpt2010.9d"))&('$D(ACPTFIND(ACPTDIR_"acpt2010.9d")))) S ACPTQUIT=1
...I ('$D(ACPTFIND("acpt2010.l"))&('$D(ACPTFIND(ACPTDIR_"acpt2010.l")))) S ACPTQUIT=1
...I ('$D(ACPTFIND("acpt2010.d"))&('$D(ACPTFIND(ACPTDIR_"acpt2010.d")))) S ACPTQUIT=1
..I ($$VERSION^XPDUTL("BCSV")<1) D Q:($G(ACPTQUIT)=1)
..I ('$D(ACPTFIND("acpt2010.l"))&('$D(ACPTFIND(ACPTDIR_"acpt2010.l")))) S ACPTQUIT=1
..I ('$D(ACPTFIND("acpt2010.d"))&('$D(ACPTFIND(ACPTDIR_"acpt2010.d")))) S ACPTQUIT=1
..I $G(ACPTQUIT)'=1 S ACPTFIND=1
.;D ; format for Cache on UNIX
..;Q:('$D(ACPTFIND("acpt2010.9l"))!'$D(ACPTFIND("acpt2010.9h"))!'$D(ACPTFIND("acpt2010.9d"))!'$D(ACPTFIND("acpt2010.l"))!'$D(ACPTFIND("acpt2010.d")))&($$VERSION^XPDUTL("BCSV")>0)
..;Q:('$D(ACPTFIND("acpt2010.l"))!'$D(ACPTFIND("acpt2010.d")))&($$VERSION^XPDUTL("BCSV")<1)
..;S ACPTFIND=1
;
I $$VERSION^XPDUTL("BCSV")>0 D
.I $D(ACPTFIND("acpt2010.9l"))!$D(ACPTFIND(ACPTDIR_"acpt2010.9l")) D
..W !,"CPT Description file acpt2010.9l found."
.I $D(ACPTFIND("acpt2010.9d"))!$D(ACPTFIND(ACPTDIR_"acpt2010.9d")) D
..W !,"CPT delete file acpt2010.9d found."
.I $D(ACPTFIND("acpt2010.9h"))!$D(ACPTFIND(ACPTDIR_"acpt2010.9h")) D
..W !,"HCPCS file acpt2010.9h found."
;
I $D(ACPTFIND("acpt2010.l"))!$D(ACPTFIND(ACPTDIR_"acpt2010.l")) D
.W !,"CPT Description file acpt2010.l found."
I $D(ACPTFIND("acpt2010.d"))!$D(ACPTFIND(ACPTDIR_"acpt2010.d")) D
.W !,"CPT delete file acpt2010.d found."
;
I ACPTFIND D Q ; if they picked a valid directory
.W !!,"Thank you. The file is in that directory."
.W !,"Proceeding with the install of ACPT*2.10."
;
I 'ACPTFIND D
.W !!,"I'm sorry, but that cannot be correct."
.W !,"Directory ",ACPTDIR," does not contain that file."
.;
.D
..N ACPTFILE S ACPTFILE("*")=""
..N ACPTLIST
..N Y S Y=$$LIST^%ZISH(ACPTDIR,"ACPTFILE","ACPTLIST")
..W !!,"Directory ",ACPTDIR," contains the following file:"
..N ACPTF S ACPTF="" F S ACPTF=$O(ACPTLIST(ACPTF)) Q:ACPTF="" D
...W !?5,ACPTF
.;
.W !!,"Please select a directory that contains the CPT file."
.K ACPTDIR
;
Q
ACPTENVC ; IHS/SD/SDR - Environment checker for ACPT V2.10 ;4/21/08 14:11
+1 ;;2.10;CPT FILES;;DEC 18, 2009
+2 ;
+3 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO SORRY(2)
QUIT
+4 ;
+5 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO SORRY(2)
QUIT
+6 ;
+7 SET X=$PIECE(^VA(200,DUZ,0),U)
+8 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+9 WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_" Patch "_$PIECE($TEXT(+2),";",5)_".",IOM),!
+10 ;
+11 SET XPDQUIT=0
SET ACPTQUIT=0
+12 IF '$$VCHK("XU","8",2)
+13 IF '$$VCHK("XT","7.3",2)
+14 IF '$$VCHK("DI","21",2)
+15 IF '$$VCHK("ACPT","2.09",2)
SET XPDQUIT=2
+16 ;
+17 NEW DA,DIC
+18 SET X="ACPT"
SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET D="C"
+19 DO IX^DIC
+20 IF Y<0
IF $DATA(^DIC(9.4,"C","ACPT"))
Begin DoDot:1
+21 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""ACPT"" prefix.",IOM)
+22 WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
+23 WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
+24 QUIT
End DoDot:1
SET XPDQUIT=2
+25 ;
+26 IF XPDQUIT
DO SORRY(XPDQUIT)
QUIT
+27 ;
+28 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+29 ;
+30 IF '$$DIR^XBDIR("E","","","","","",1)
DO SORRY(2)
QUIT
+31 QUIT
+32 ;
SORRY(X) ;
+1 KILL DIFQ
+2 SET XPDQUIT=X
+3 IF '$DATA(ZTQUEUED)
WRITE *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
+4 QUIT
+5 ;
VCHK(ACPTPRE,ACPTVER,ACPTQUIT) ; Check versions needed.
+1 ;
+2 NEW ACPTV
+3 SET ACPTV=$$VERSION^XPDUTL(ACPTPRE)
+4 WRITE !,$$CJ^XLFSTR("Need at least "_ACPTPRE_" v "_ACPTVER_"....."_ACPTPRE_" v "_ACPTV_" Present",IOM)
+5 IF ACPTV<ACPTVER
SET XPDQUIT=ACPTQUIT
WRITE *7,!,$$CJ^XLFSTR("^^^^**NEEDS FIXED**^^^^",IOM)
QUIT 0
+6 QUIT 1
+7 ;
INSTALLD(ACPTINST) ;EP - Determine if patch ACPTINST was installed, where ACPTINST is
+1 ; the name of the INSTALL. E.g "AG*6.0*10".
+2 ;;^DIC(9.4,D0,22,D1,PAH,D2,0)=
+3 ;;(#.01) PATCH APPLICATION HISTORY [1F] ^ (#.02)DATE APPLIED [2D] ^ (#.03) APPLIED BY [3P] ^
+4 NEW DIC,X,Y
+5 SET X=$PIECE(ACPTINST,"*",1)
+6 SET DIC="^DIC(9.4,"
SET DIC(0)="FM"
SET D="C"
+7 DO IX^DIC
+8 IF Y<1
QUIT 0
+9 SET DIC=DIC_+Y_",22,"
SET X=$PIECE(ACPTINST,"*",2)
+10 DO ^DIC
+11 IF Y<1
QUIT 0
+12 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(ACPTINST,"*",3)
+13 DO ^DIC
+14 QUIT $SELECT(Y<1:0,1:1)
+15 ;
LAST(PKG,VER) ;EP - returns last patch applied for a Package, PATCH^DATE
+1 ; Patch includes Seq # if Released
+2 NEW PKGIEN,VERIEN,LATEST,PATCH,SUBIEN
+3 IF $GET(VER)=""
SET VER=$$VERSION^XPDUTL(PKG)
IF 'VER
QUIT -1
+4 SET PKGIEN=$ORDER(^DIC(9.4,"B",PKG,""))
IF 'PKGIEN
QUIT -1
+5 SET VERIEN=$ORDER(^DIC(9.4,PKGIEN,22,"B",VER,""))
IF 'VERIEN
QUIT -1
+6 SET LATEST=-1
SET PATCH=-1
SET SUBIEN=0
+7 FOR
SET SUBIEN=$ORDER(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN))
IF SUBIEN'>0
QUIT
Begin DoDot:1
+8 IF $PIECE(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST
SET LATEST=$PIECE(^(0),U,2)
SET PATCH=$PIECE(^(0),U)
+9 IF $PIECE(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)=LATEST
IF $PIECE(^(0),U)>PATCH
SET PATCH=$PIECE(^(0),U)
End DoDot:1
+10 QUIT PATCH_U_LATEST
+11 ;
POST1(ACPTDIR) ; input transform for KIDS question POST1
+1 ;
+2 ; .ACPTDIR, passed by reference, is X from the Fileman Reader, the
+3 ; input to this input transform.
+4 ;
+5 ; if unix, ensure proper syntax for unix
IF $ZV["UNIX"
Begin DoDot:1
+6 ; forward slash should delimit
SET ACPTDIR=$TRANSLATE(ACPTDIR,"\","/")
+7 ; start with root (/)
IF $EXTRACT(ACPTDIR)'="/"
SET ACPTDIR="/"_ACPTDIR
+8 ; ensure trailing /
IF $EXTRACT(ACPTDIR,$LENGTH(ACPTDIR))'="/"
SET ACPTDIR=ACPTDIR_"/"
End DoDot:1
+9 ;
+10 ; otherwise, ensure proper syntax for other operating systems
IF '$TEST
Begin DoDot:1
+11 ; back slash should delimit
SET ACPTDIR=$TRANSLATE(ACPTDIR,"/","\")
+12 IF $EXTRACT(ACPTDIR)'="\"
IF ACPTDIR'[":"
Begin DoDot:2
+13 ; start with \ if not using : (?)
SET ACPTDIR="\"_ACPTDIR
End DoDot:2
+14 ; ensure trailing \
IF $EXTRACT(ACPTDIR,$LENGTH(ACPTDIR))'="\"
SET ACPTDIR=ACPTDIR_"\"
End DoDot:1
+15 ;
+16 WRITE !!,"Checking directory ",ACPTDIR,"..."
+17 ;
+18 ; do we find our files in that directory?
NEW ACPTFIND
SET ACPTFIND=0
+19 ; find out whether that directory contains those files
Begin DoDot:1
+20 NEW ACPTFILE
+21 SET ACPTFILE("acpt2010.9l")=""
+22 SET ACPTFILE("acpt2010.9h")=""
+23 SET ACPTFILE("acpt2010.9d")=""
+24 SET ACPTFILE("acpt2010.l")=""
+25 SET ACPTFILE("acpt2010.d")=""
+26 NEW Y
SET Y=$$LIST^%ZISH(ACPTDIR,"ACPTFILE","ACPTFIND")
+27 ; format for most platforms:
Begin DoDot:2
+28 KILL ACPTQUIT
+29 IF ($$VERSION^XPDUTL("BCSV")>0)
Begin DoDot:3
+30 IF ('$DATA(ACPTFIND("acpt2010.9l"))&('$DATA(ACPTFIND(ACPTDIR_"acpt2010.9l"))))
SET ACPTQUIT=1
+31 IF ('$DATA(ACPTFIND("acpt2010.9h"))&('$DATA(ACPTFIND(ACPTDIR_"acpt2010.9h"))))
SET ACPTQUIT=1
+32 IF ('$DATA(ACPTFIND("acpt2010.9d"))&('$DATA(ACPTFIND(ACPTDIR_"acpt2010.9d"))))
SET ACPTQUIT=1
+33 IF ('$DATA(ACPTFIND("acpt2010.l"))&('$DATA(ACPTFIND(ACPTDIR_"acpt2010.l"))))
SET ACPTQUIT=1
+34 IF ('$DATA(ACPTFIND("acpt2010.d"))&('$DATA(ACPTFIND(ACPTDIR_"acpt2010.d"))))
SET ACPTQUIT=1
End DoDot:3
IF ($GET(ACPTQUIT)=1)
QUIT
+35 IF ($$VERSION^XPDUTL("BCSV")<1)
Begin DoDot:3
End DoDot:3
IF ($GET(ACPTQUIT)=1)
QUIT
+36 IF ('$DATA(ACPTFIND("acpt2010.l"))&('$DATA(ACPTFIND(ACPTDIR_"acpt2010.l"))))
SET ACPTQUIT=1
+37 IF ('$DATA(ACPTFIND("acpt2010.d"))&('$DATA(ACPTFIND(ACPTDIR_"acpt2010.d"))))
SET ACPTQUIT=1
+38 IF $GET(ACPTQUIT)'=1
SET ACPTFIND=1
End DoDot:2
IF ACPTFIND
QUIT
+39 ;D ; format for Cache on UNIX
+40 ;Q:('$D(ACPTFIND("acpt2010.9l"))!'$D(ACPTFIND("acpt2010.9h"))!'$D(ACPTFIND("acpt2010.9d"))!'$D(ACPTFIND("acpt2010.l"))!'$D(ACPTFIND("acpt2010.d")))&($$VERSION^XPDUTL("BCSV")>0)
+41 ;Q:('$D(ACPTFIND("acpt2010.l"))!'$D(ACPTFIND("acpt2010.d")))&($$VERSION^XPDUTL("BCSV")<1)
+42 ;S ACPTFIND=1
End DoDot:1
+43 ;
+44 IF $$VERSION^XPDUTL("BCSV")>0
Begin DoDot:1
+45 IF $DATA(ACPTFIND("acpt2010.9l"))!$DATA(ACPTFIND(ACPTDIR_"acpt2010.9l"))
Begin DoDot:2
+46 WRITE !,"CPT Description file acpt2010.9l found."
End DoDot:2
+47 IF $DATA(ACPTFIND("acpt2010.9d"))!$DATA(ACPTFIND(ACPTDIR_"acpt2010.9d"))
Begin DoDot:2
+48 WRITE !,"CPT delete file acpt2010.9d found."
End DoDot:2
+49 IF $DATA(ACPTFIND("acpt2010.9h"))!$DATA(ACPTFIND(ACPTDIR_"acpt2010.9h"))
Begin DoDot:2
+50 WRITE !,"HCPCS file acpt2010.9h found."
End DoDot:2
End DoDot:1
+51 ;
+52 IF $DATA(ACPTFIND("acpt2010.l"))!$DATA(ACPTFIND(ACPTDIR_"acpt2010.l"))
Begin DoDot:1
+53 WRITE !,"CPT Description file acpt2010.l found."
End DoDot:1
+54 IF $DATA(ACPTFIND("acpt2010.d"))!$DATA(ACPTFIND(ACPTDIR_"acpt2010.d"))
Begin DoDot:1
+55 WRITE !,"CPT delete file acpt2010.d found."
End DoDot:1
+56 ;
+57 ; if they picked a valid directory
IF ACPTFIND
Begin DoDot:1
+58 WRITE !!,"Thank you. The file is in that directory."
+59 WRITE !,"Proceeding with the install of ACPT*2.10."
End DoDot:1
QUIT
+60 ;
+61 IF 'ACPTFIND
Begin DoDot:1
+62 WRITE !!,"I'm sorry, but that cannot be correct."
+63 WRITE !,"Directory ",ACPTDIR," does not contain that file."
+64 ;
+65 Begin DoDot:2
+66 NEW ACPTFILE
SET ACPTFILE("*")=""
+67 NEW ACPTLIST
+68 NEW Y
SET Y=$$LIST^%ZISH(ACPTDIR,"ACPTFILE","ACPTLIST")
+69 WRITE !!,"Directory ",ACPTDIR," contains the following file:"
+70 NEW ACPTF
SET ACPTF=""
FOR
SET ACPTF=$ORDER(ACPTLIST(ACPTF))
IF ACPTF=""
QUIT
Begin DoDot:3
+71 WRITE !?5,ACPTF
End DoDot:3
End DoDot:2
+72 ;
+73 WRITE !!,"Please select a directory that contains the CPT file."
+74 KILL ACPTDIR
End DoDot:1
+75 ;
+76 QUIT
