AMH40P3 ; IHS/CMI/LAB - POST INIT BH 16 Apr 2009 7:37 AM 01 Aug 2009 5:37 AM ; 13 Apr 2010 3:54 PM
;;4.0;IHS BEHAVIORAL HEALTH;**3**;JUN 18, 2010;Build 10
;
ENV ;EP
F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
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
E D MES^XPDUTL($$CJ^XLFSTR("Requires Kernel Version 8.0....Present.",80))
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
E D MES^XPDUTL($$CJ^XLFSTR("Requires Fileman v22....Present.",80))
I $E($$VERSION^XPDUTL("AMH"),1,3)'="4.0" D MES^XPDUTL($$CJ^XLFSTR("Version 4.0 of AMH is required. Not installed.",80)) D SORRY(2) I 1
E D MES^XPDUTL($$CJ^XLFSTR("Requires AMH v4.0....Present.",80))
I '$$INSTALLD("AMH*4.0*2") D SORRY(2)
Q
;
PRE ;
S DA=0 F S DA=$O(^AMHRECD(DA)) Q:DA'=+DA S DIK="^AMHRECD(" D ^DIK
K DA,DIK
Q
;
POST ;EP
;D RESET ;reset AEX for all visits with a visit date 100106 or greater.
;set new site parameter to 1 if it is not filled in
S AMHX=0 F S AMHX=$O(^AMHSITE(AMHX)) Q:AMHX'=+AMHX D
.I $P($G(^AMHSITE(AMHX,18)),U,10)'="" Q ;already set
.S DA=AMHX,DIE="^AMHSITE(",DR="1810///1" D ^DIE K DA,DR,DIE
D MENU
D ZISH
D BMXPO
Q
;
N X
S X=$$ADD^XPDMENU("AMH M EXPORT UTILITY","AMH EY AUTO EXPORT","SAE")
Q
;
ZISH ;create entry in ZISH SEND PARAMETERS file
D ^XBFMK K DIADD,DLAYGO,DIC,DD,D0,DO
;Q:$D(^%ZIB(9888888.93,"B","AMH AUTO SEND"))
S APCLY=0 F S APCLY=$O(^%ZIB(9888888.93,"B","AMH AUTO SEND",0)) Q:APCLY'=+APCLY D
.I APCLY S DA=APCLY,DIK="^%ZIB(9888888.93," D ^DIK K DA,DIK
S X="AMH AUTO SEND",DIC(0)="L",DIC="^%ZIB(9888888.93," D FILE^DICN
I Y=-1 W !!,"error creating ZISH SEND PARAMETERS entry" Q
S DA=+Y,DIE="^%ZIB(9888888.93,",DR=".02///QUOVADX-IE.IHS.GOV;.03///ihpesusr;.04///g2dwy66b;.06///-u;.07///B;.08///sendto"
D ^DIE
I $D(Y) W !!,"error updating ZISH SEND PARAMETERS entry" Q
Q
BMXPO ;-- update the RPC file
N AMHRPC
S AMHRPC=$O(^DIC(19,"B","AMHGRPC",0))
Q:'AMHRPC
D CLEAN(AMHRPC)
D GUIEP^BMXPO(.RETVAL,AMHRPC_"|AMH")
Q
;
CLEAN(APP) ;-- clean out the RPC multiple first
S DA(1)=APP
S DIK="^DIC(19,"_DA(1)_","_"""RPC"""_","
N AMHDA
S AMHDA=0 F S AMHDA=$O(^DIC(19,APP,"RPC",AMHDA)) Q:'AMHDA D
. S DA=AMHDA
. D ^DIK
K ^DIC(19,APP,"RPC","B")
Q
INSTALLD(AMHSTAL) ;EP - Determine if patch AMHSTAL was installed, where
; APCLSTAL is the name of the INSTALL. E.g "AG*6.0*11".
;
NEW AMHY,DIC,X,Y
S X=$P(AMHSTAL,"*",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(AMHSTAL,"*",2)
D ^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",""PAH"",",X=$P(AMHSTAL,"*",3)
D ^DIC
S AMHY=Y
D IMES
Q $S(AMHY<1:0,1:1)
IMES ;
D MES^XPDUTL($$CJ^XLFSTR("Patch """_AMHSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" Present.",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
AMH40P3 ; IHS/CMI/LAB - POST INIT BH 16 Apr 2009 7:37 AM 01 Aug 2009 5:37 AM ; 13 Apr 2010 3:54 PM
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**3**;JUN 18, 2010;Build 10
+2 ;
ENV ;EP
+1 FOR X="XPO1","XPZ1","XPZ2","XPI1"
SET XPDDIQ(X)=0
+2 IF +$$VERSION^XPDUTL("XU")<8
DO MES^XPDUTL($$CJ^XLFSTR("Version 8.0 of KERNEL is required. Not installed",80))
DO SORRY(2)
IF 1
+3 IF '$TEST
DO MES^XPDUTL($$CJ^XLFSTR("Requires Kernel Version 8.0....Present.",80))
+4 IF +$$VERSION^XPDUTL("DI")<22
DO MES^XPDUTL($$CJ^XLFSTR("Version 22.0 of FILEMAN is required. Not installed.",80))
DO SORRY(2)
IF 1
+5 IF '$TEST
DO MES^XPDUTL($$CJ^XLFSTR("Requires Fileman v22....Present.",80))
+6 IF $EXTRACT($$VERSION^XPDUTL("AMH"),1,3)'="4.0"
DO MES^XPDUTL($$CJ^XLFSTR("Version 4.0 of AMH is required. Not installed.",80))
DO SORRY(2)
IF 1
+7 IF '$TEST
DO MES^XPDUTL($$CJ^XLFSTR("Requires AMH v4.0....Present.",80))
+8 IF '$$INSTALLD("AMH*4.0*2")
DO SORRY(2)
+9 QUIT
+10 ;
PRE ;
+1 SET DA=0
FOR
SET DA=$ORDER(^AMHRECD(DA))
IF DA'=+DA
QUIT
SET DIK="^AMHRECD("
DO ^DIK
+2 KILL DA,DIK
+3 QUIT
+4 ;
POST ;EP
+1 ;D RESET ;reset AEX for all visits with a visit date 100106 or greater.
+2 ;set new site parameter to 1 if it is not filled in
+3 SET AMHX=0
FOR
SET AMHX=$ORDER(^AMHSITE(AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+4 ;already set
IF $PIECE($GET(^AMHSITE(AMHX,18)),U,10)'=""
QUIT
+5 SET DA=AMHX
SET DIE="^AMHSITE("
SET DR="1810///1"
DO ^DIE
KILL DA,DR,DIE
End DoDot:1
+6 DO MENU
+7 DO ZISH
+8 DO BMXPO
+9 QUIT
+10 ;
+1 NEW X
+2 SET X=$$ADD^XPDMENU("AMH M EXPORT UTILITY","AMH EY AUTO EXPORT","SAE")
+3 QUIT
+4 ;
ZISH ;create entry in ZISH SEND PARAMETERS file
+1 DO ^XBFMK
KILL DIADD,DLAYGO,DIC,DD,D0,DO
+2 ;Q:$D(^%ZIB(9888888.93,"B","AMH AUTO SEND"))
+3 SET APCLY=0
FOR
SET APCLY=$ORDER(^%ZIB(9888888.93,"B","AMH AUTO SEND",0))
IF APCLY'=+APCLY
QUIT
Begin DoDot:1
+4 IF APCLY
SET DA=APCLY
SET DIK="^%ZIB(9888888.93,"
DO ^DIK
KILL DA,DIK
End DoDot:1
+5 SET X="AMH AUTO SEND"
SET DIC(0)="L"
SET DIC="^%ZIB(9888888.93,"
DO FILE^DICN
+6 IF Y=-1
WRITE !!,"error creating ZISH SEND PARAMETERS entry"
QUIT
+7 SET DA=+Y
SET DIE="^%ZIB(9888888.93,"
SET DR=".02///QUOVADX-IE.IHS.GOV;.03///ihpesusr;.04///g2dwy66b;.06///-u;.07///B;.08///sendto"
+8 DO ^DIE
+9 IF $DATA(Y)
WRITE !!,"error updating ZISH SEND PARAMETERS entry"
QUIT
+10 QUIT
BMXPO ;-- update the RPC file
+1 NEW AMHRPC
+2 SET AMHRPC=$ORDER(^DIC(19,"B","AMHGRPC",0))
+3 IF 'AMHRPC
QUIT
+4 DO CLEAN(AMHRPC)
+5 DO GUIEP^BMXPO(.RETVAL,AMHRPC_"|AMH")
+6 QUIT
+7 ;
CLEAN(APP) ;-- clean out the RPC multiple first
+1 SET DA(1)=APP
+2 SET DIK="^DIC(19,"_DA(1)_","_"""RPC"""_","
+3 NEW AMHDA
+4 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^DIC(19,APP,"RPC",AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+5 SET DA=AMHDA
+6 DO ^DIK
End DoDot:1
+7 KILL ^DIC(19,APP,"RPC","B")
+8 QUIT
INSTALLD(AMHSTAL) ;EP - Determine if patch AMHSTAL was installed, where
+1 ; APCLSTAL is the name of the INSTALL. E.g "AG*6.0*11".
+2 ;
+3 NEW AMHY,DIC,X,Y
+4 SET X=$PIECE(AMHSTAL,"*",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(AMHSTAL,"*",2)
+9 DO ^DIC
+10 IF Y<1
DO IMES
QUIT 0
+11 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(AMHSTAL,"*",3)
+12 DO ^DIC
+13 SET AMHY=Y
+14 DO IMES
+15 QUIT $SELECT(AMHY<1:0,1:1)
IMES ;
+1 DO MES^XPDUTL($$CJ^XLFSTR("Patch """_AMHSTAL_""" is"_$SELECT(Y<1:" *NOT*",1:"")_" Present.",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
