BUDENV.m

BUDENV ; IHS/CMI/LAB - environmental check ;

 ;;12.0;IHS/RPMS UNIFORM DATA SYSTEM;;NOV 22, 2017;Build 75

 ;

ENV ;

 ; 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

 Q

 ;

 ;

PRE ;

 F DA=1:1:50 S DIK="^BUDCNTL(" D ^DIK

 F DA=1:1:50 S DIK="^BUDIL(" D ^DIK

 F DA=1:1:50 S DIK="^BUDTFIVE(" D ^DIK

 F DA=1:1:50 S DIK="^BUDTTA(" D ^DIK

 Q

POST ;

 NEW X

 S X=$$ADD^XPDMENU("BUD MANAGER UTILITIES","APCL TAXONOMY SETUP","TAX",99)

 I 'X W "Attempt to add taxonomy setup option failed.." H 3

 D ^BUDTX

LAB ;

 S BGPX="BGP PAP SMEAR TAX" D LAB1

 S BGPX="BGP HIV TEST TAX" D LAB1

 Q

LAB1 ;

 W !,"Creating ",BGPX," Taxonomy..."

 S BGPDA=$O(^ATXLAB("B",BGPX,0))

 Q:BGPDA  ;taxonomy already exisits

 S X=BGPX,DIC="^ATXLAB(",DIC(0)="L",DIADD=1,DLAYGO=9002228 D ^DIC K DIC,DA,DIADD,DLAYGO,I

 I Y=-1 W !!,"ERROR IN CREATING ",BGPX," TAX" Q

 S BGPTX=+Y,$P(^ATXLAB(BGPTX,0),U,2)=BGPX,$P(^(0),U,5)=DUZ,$P(^(0),U,6)=DT,$P(^(0),U,8)="B",$P(^(0),U,9)=60,^ATXLAB(BGPTX,21,0)="^9002228.02101PA^0^0"

 S DA=BGPTX,DIK="^ATXAX(" D IX1^DIK

 Q

BUDENV    ; IHS/CMI/LAB - environmental check ;

 +1       ;;12.0;IHS/RPMS UNIFORM DATA SYSTEM;;NOV 22, 2017;Build 75

 +2       ;

ENV       ;

 +1       ; The following line prevents the "Disable Options..." and "Move

 +2       ; Routines..." questions from being asked during the install.

 +3        IF $GET(XPDENV)=1

               SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0

 +4        QUIT 

 +5       ;

 +6       ;

PRE       ;

 +1        FOR DA=1:1:50

               SET DIK="^BUDCNTL("

               DO ^DIK

 +2        FOR DA=1:1:50

               SET DIK="^BUDIL("

               DO ^DIK

 +3        FOR DA=1:1:50

               SET DIK="^BUDTFIVE("

               DO ^DIK

 +4        FOR DA=1:1:50

               SET DIK="^BUDTTA("

               DO ^DIK

 +5        QUIT 

POST      ;

 +1        NEW X

 +2        SET X=$$ADD^XPDMENU("BUD MANAGER UTILITIES","APCL TAXONOMY SETUP","TAX",99)

 +3        IF 'X

               WRITE "Attempt to add taxonomy setup option failed.."

               HANG 3

 +4        DO ^BUDTX

LAB       ;

 +1        SET BGPX="BGP PAP SMEAR TAX"

           DO LAB1

 +2        SET BGPX="BGP HIV TEST TAX"

           DO LAB1

 +3        QUIT 

LAB1      ;

 +1        WRITE !,"Creating ",BGPX," Taxonomy..."

 +2        SET BGPDA=$ORDER(^ATXLAB("B",BGPX,0))

 +3       ;taxonomy already exisits

           IF BGPDA

               QUIT 

 +4        SET X=BGPX

           SET DIC="^ATXLAB("

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=9002228

           DO ^DIC

           KILL DIC,DA,DIADD,DLAYGO,I

 +5        IF Y=-1

               WRITE !!,"ERROR IN CREATING ",BGPX," TAX"

               QUIT 

 +6        SET BGPTX=+Y

           SET $PIECE(^ATXLAB(BGPTX,0),U,2)=BGPX

           SET $PIECE(^(0),U,5)=DUZ

           SET $PIECE(^(0),U,6)=DT

           SET $PIECE(^(0),U,8)="B"

           SET $PIECE(^(0),U,9)=60

           SET ^ATXLAB(BGPTX,21,0)="^9002228.02101PA^0^0"

 +7        SET DA=BGPTX

           SET DIK="^ATXAX("

           DO IX1^DIK

 +8        QUIT