- BJPC2P16 ; IHS/CMI/LAB - PCC Suite v2.0 P15 ;
- ;;2.0;IHS PCC SUITE;**16**;MAY 14, 2009;Build 9
- ;
- ;
- ; 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
- ;KERNEL
- 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))
- ;FILEMAN
- 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))
- ;BJPC 2.0 PATCH 13
- I '$$INSTALLD("BJPC*2.0*15") D MES^XPDUTL($$CJ^XLFSTR("Requires bjpc V2.0 patch 15. Not installed.",80)) D SORRY(2)
- ;I '$$INSTALLD("ATX*5.1*13") D MES^XPDUTL($$CJ^XLFSTR("Requires atx (taxonomy) v5.1 patch 13. Not installed.",80)) D SORRY(2)
- ;
- Q
- ;
- PRE ;
- K ^APCHTMP("HMR STATUS")
- S X=0 F S X=$O(^APCHSURV(X)) Q:X'=+X S ^APCHTMP("HMR STATUS",X)=$P(^APCHSURV(X,0),U)_U_$P(^APCHSURV(X,0),U,3)
- Q
- POST ;
- ;CR# 05990
- S DA=$O(^AUTTMSR("B","AG",0)) I DA S ^AUTTMSR(DA,11,1,0)="Enter Abdominal Girth. Must be in the range 0-250. Up to 2 decimal ",^AUTTMSR(DA,11,2,0)="digits. e.g. 38.5 or 40 or 39.25"
- K ^AUPNPROB("ASLT")
- K ^AUPNPROB("ALST")
- ;K ^DD(9000011,0,"IX","ALST",9000011,80001)
- ;K ^DD(9000011,0,"IX","ALSTA",9000011,.22)
- S DIK="^AUPNPROB(",DIK(1)=".22" D ENALL^DIK
- ;HMR STATUS
- S APCHX=0 F S APCHX=$O(^APCHTMP("HMR STATUS",APCHX)) Q:APCHX'=+APCHX D
- .S X=$P(^APCHTMP("HMR STATUS",APCHX),U),APCHS=$P(^APCHTMP("HMR STATUS",APCHX),U,2) ;,DIC="^APCHSURV(",DIC(0)="M" D ^DIC
- .;I Y=-1 W !!,"could not update status on ",X," hmr" Q
- .Q:'$D(^APCHSURV(APCHX,0))
- .I $P(^APCHSURV(APCHX,0),U,3)'="D" S $P(^APCHSURV(APCHX,0),U,3)=APCHS
- K ^APCHTMP("HMR STATUS")
- K APCHX,APCHS
- S X=$$ADD^XPDMENU("APCDSUPER","APCD UPDATE DEFAULT STATUS","PLST")
- I 'X W !,"Attempt to add APCD UPDATE DEFAULT STATUS option failed.." H 3
- Q
- INSTALLD(BJPCSTAL) ;EP - Determine if patch BJPCSTAL was installed, where
- ; APCLSTAL is the name of the INSTALL. E.g "AG*6.0*11".
- ;
- NEW BJPCY,DIC,X,Y
- S X=$P(BJPCSTAL,"*",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(BJPCSTAL,"*",2)
- D ^DIC
- I Y<1 D IMES Q 0
- S DIC=DIC_+Y_",""PAH"",",X=$P(BJPCSTAL,"*",3)
- D ^DIC
- S BJPCY=Y
- D IMES
- Q $S(BJPCY<1:0,1:1)
- IMES ;
- D MES^XPDUTL($$CJ^XLFSTR("Patch """_BJPCSTAL_""" 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
- BJPC2P16 ; IHS/CMI/LAB - PCC Suite v2.0 P15 ;
- +1 ;;2.0;IHS PCC SUITE;**16**;MAY 14, 2009;Build 9
- +2 ;
- +3 ;
- +4 ; The following line prevents the "Disable Options..." and "Move Routines..." questions from being asked during the install.
- +5 IF $GET(XPDENV)=1
- SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
- +6 FOR X="XPO1","XPZ1","XPZ2","XPI1"
- SET XPDDIQ(X)=0
- +7 ;KERNEL
- +8 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
- +9 IF '$TEST
- DO MES^XPDUTL($$CJ^XLFSTR("Requires Kernel Version 8.0....Present.",80))
- +10 ;FILEMAN
- +11 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
- +12 IF '$TEST
- DO MES^XPDUTL($$CJ^XLFSTR("Requires Fileman v22....Present.",80))
- +13 ;BJPC 2.0 PATCH 13
- +14 IF '$$INSTALLD("BJPC*2.0*15")
- DO MES^XPDUTL($$CJ^XLFSTR("Requires bjpc V2.0 patch 15. Not installed.",80))
- DO SORRY(2)
- +15 ;I '$$INSTALLD("ATX*5.1*13") D MES^XPDUTL($$CJ^XLFSTR("Requires atx (taxonomy) v5.1 patch 13. Not installed.",80)) D SORRY(2)
- +16 ;
- +17 QUIT
- +18 ;
- PRE ;
- +1 KILL ^APCHTMP("HMR STATUS")
- +2 SET X=0
- FOR
- SET X=$ORDER(^APCHSURV(X))
- IF X'=+X
- QUIT
- SET ^APCHTMP("HMR STATUS",X)=$PIECE(^APCHSURV(X,0),U)_U_$PIECE(^APCHSURV(X,0),U,3)
- +3 QUIT
- POST ;
- +1 ;CR# 05990
- +2 SET DA=$ORDER(^AUTTMSR("B","AG",0))
- IF DA
- SET ^AUTTMSR(DA,11,1,0)="Enter Abdominal Girth. Must be in the range 0-250. Up to 2 decimal "
- SET ^AUTTMSR(DA,11,2,0)="digits. e.g. 38.5 or 40 or 39.25"
- +3 KILL ^AUPNPROB("ASLT")
- +4 KILL ^AUPNPROB("ALST")
- +5 ;K ^DD(9000011,0,"IX","ALST",9000011,80001)
- +6 ;K ^DD(9000011,0,"IX","ALSTA",9000011,.22)
- +7 SET DIK="^AUPNPROB("
- SET DIK(1)=".22"
- DO ENALL^DIK
- +8 ;HMR STATUS
- +9 SET APCHX=0
- FOR
- SET APCHX=$ORDER(^APCHTMP("HMR STATUS",APCHX))
- IF APCHX'=+APCHX
- QUIT
- Begin DoDot:1
- +10 ;,DIC="^APCHSURV(",DIC(0)="M" D ^DIC
- SET X=$PIECE(^APCHTMP("HMR STATUS",APCHX),U)
- SET APCHS=$PIECE(^APCHTMP("HMR STATUS",APCHX),U,2)
- +11 ;I Y=-1 W !!,"could not update status on ",X," hmr" Q
- +12 IF '$DATA(^APCHSURV(APCHX,0))
- QUIT
- +13 IF $PIECE(^APCHSURV(APCHX,0),U,3)'="D"
- SET $PIECE(^APCHSURV(APCHX,0),U,3)=APCHS
- End DoDot:1
- +14 KILL ^APCHTMP("HMR STATUS")
- +15 KILL APCHX,APCHS
- +16 SET X=$$ADD^XPDMENU("APCDSUPER","APCD UPDATE DEFAULT STATUS","PLST")
- +17 IF 'X
- WRITE !,"Attempt to add APCD UPDATE DEFAULT STATUS option failed.."
- HANG 3
- +18 QUIT
- INSTALLD(BJPCSTAL) ;EP - Determine if patch BJPCSTAL was installed, where
- +1 ; APCLSTAL is the name of the INSTALL. E.g "AG*6.0*11".
- +2 ;
- +3 NEW BJPCY,DIC,X,Y
- +4 SET X=$PIECE(BJPCSTAL,"*",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(BJPCSTAL,"*",2)
- +9 DO ^DIC
- +10 IF Y<1
- DO IMES
- QUIT 0
- +11 SET DIC=DIC_+Y_",""PAH"","
- SET X=$PIECE(BJPCSTAL,"*",3)
- +12 DO ^DIC
- +13 SET BJPCY=Y
- +14 DO IMES
- +15 QUIT $SELECT(BJPCY<1:0,1:1)
- IMES ;
- +1 DO MES^XPDUTL($$CJ^XLFSTR("Patch """_BJPCSTAL_""" 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
