BEHBUSAP.m

BEHBUSAP ;MSC/JS - BUSA Audit Post-installation program ;07-Oct-2013 09:34;PLS

 ;;1.1;BEH COMPONENTS;**054001**;Mar 20, 2007;Build 23

 ;

 ;-- KIDS Post-Install Update - Queued update to set inactive all MSC non-patient BUSA RPCS except CIAVMCFG GETTEMPL

 ;                              file #9002319.03 -- BUSA AUDIT RPC DEFINITIONS FILE

 ;

UPALL ;

 N EHRBUSA

 S EHRBUSA(1)=""

 S EHRBUSA(2)="Queuing update to set all non patient-related BUSA RPCs to 'inactive' status..."

 S EHRBUSA(3)=""

 D MES^XPDUTL(.EHRBUSA) K EHRBUSA

 ;

 ;-- schedule TM job to run 'NOW' --

 S ZTIO=""

 S ZTDTH=$H

 S ZTRTN="DQ^BEHBUSAP"

 S ZTDESC="Tasked Update file #9002319.03 -- BUSA AUDIT RPC DEFINITIONS FILE from KIDs build "_$G(XPDNM)

 I $G(XPDNM)]"" S ZTSAVE("XPDNM")=""

 D ^%ZTLOAD K IO("Q")

 ;

 D HOME^%ZIS

 N EHRBUSA

 S EHRBUSA(1)=""

 S EHRBUSA(2)="The update for BUSA AUDIT RPC DEFINITIONS FILE"_$S($G(ZTSK)]"":" is tasked #"_ZTSK,1:" has NOT been tasked")

 S EHRBUSA(3)=""

 D MES^XPDUTL(.EHRBUSA) K EHRBUSA

 K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK

 Q

 ;

 ; Turn off MSC RPCs that have category other than 'Patient Related', excepting RPC 'CIAVMCFG GETTEMPL'

 ; Checks RPC namespaces:

 ;   BEH

 ;   BGO

 ;   BLR

 ;   CIA

 ;

DQ ; -- tasked update from KIDs Post-Install job starts here

 S U="^"

 N IEN S IEN=""

 S A=0

 F  S IEN=$O(^BUSA(9002319.03,IEN)) Q:IEN=""  D

 .S NOD0=$G(^BUSA(9002319.03,IEN,0))

 .Q:NOD0=""

 .S P1=$P(NOD0,U,1),P2=$P(NOD0,U,2)

 .S NSP=$E(P1,1,3)

 .I NSP["BEH"!(NSP["BGO")!(NSP["BLR")!(NSP["CIA") D  ;  -- screen for only MSC namespaced RPCs to inactivate

 ..Q:P1="CIAVMCFG GETTEMPL"  ; Skip this one, returns user HL7 Info Button access info

 ..Q:P2="P"  ; Category = 'Patient Related'

 ..S $P(^BUSA(9002319.03,IEN,0),U,7)=1 ; set Inactive fld #.07

 K A,IEN,NOD0,NSP,P1,P2

 Q

BEHBUSAP  ;MSC/JS - BUSA Audit Post-installation program ;07-Oct-2013 09:34;PLS

 +1       ;;1.1;BEH COMPONENTS;**054001**;Mar 20, 2007;Build 23

 +2       ;

 +3       ;-- KIDS Post-Install Update - Queued update to set inactive all MSC non-patient BUSA RPCS except CIAVMCFG GETTEMPL

 +4       ;                              file #9002319.03 -- BUSA AUDIT RPC DEFINITIONS FILE

 +5       ;

UPALL     ;

 +1        NEW EHRBUSA

 +2        SET EHRBUSA(1)=""

 +3        SET EHRBUSA(2)="Queuing update to set all non patient-related BUSA RPCs to 'inactive' status..."

 +4        SET EHRBUSA(3)=""

 +5        DO MES^XPDUTL(.EHRBUSA)

           KILL EHRBUSA

 +6       ;

 +7       ;-- schedule TM job to run 'NOW' --

 +8        SET ZTIO=""

 +9        SET ZTDTH=$HOROLOG

 +10       SET ZTRTN="DQ^BEHBUSAP"

 +11       SET ZTDESC="Tasked Update file #9002319.03 -- BUSA AUDIT RPC DEFINITIONS FILE from KIDs build "_$GET(XPDNM)

 +12       IF $GET(XPDNM)]""

               SET ZTSAVE("XPDNM")=""

 +13       DO ^%ZTLOAD

           KILL IO("Q")

 +14      ;

 +15       DO HOME^%ZIS

 +16       NEW EHRBUSA

 +17       SET EHRBUSA(1)=""

 +18       SET EHRBUSA(2)="The update for BUSA AUDIT RPC DEFINITIONS FILE"_$SELECT($GET(ZTSK)]"":" is tasked #"_ZTSK,1:" has NOT been tasked")

 +19       SET EHRBUSA(3)=""

 +20       DO MES^XPDUTL(.EHRBUSA)

           KILL EHRBUSA

 +21       KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK

 +22       QUIT 

 +23      ;

 +24      ; Turn off MSC RPCs that have category other than 'Patient Related', excepting RPC 'CIAVMCFG GETTEMPL'

 +25      ; Checks RPC namespaces:

 +26      ;   BEH

 +27      ;   BGO

 +28      ;   BLR

 +29      ;   CIA

 +30      ;

DQ        ; -- tasked update from KIDs Post-Install job starts here

 +1        SET U="^"

 +2        NEW IEN

           SET IEN=""

 +3        SET A=0

 +4        FOR 

               SET IEN=$ORDER(^BUSA(9002319.03,IEN))

               IF IEN=""

                   QUIT 

               Begin DoDot:1

 +5                SET NOD0=$GET(^BUSA(9002319.03,IEN,0))

 +6                IF NOD0=""

                       QUIT 

 +7                SET P1=$PIECE(NOD0,U,1)

                   SET P2=$PIECE(NOD0,U,2)

 +8                SET NSP=$EXTRACT(P1,1,3)

 +9       ;  -- screen for only MSC namespaced RPCs to inactivate

                   IF NSP["BEH"!(NSP["BGO")!(NSP["BLR")!(NSP["CIA")

                       Begin DoDot:2

 +10      ; Skip this one, returns user HL7 Info Button access info

                           IF P1="CIAVMCFG GETTEMPL"

                               QUIT 

 +11      ; Category = 'Patient Related'

                           IF P2="P"

                               QUIT 

 +12      ; set Inactive fld #.07

                           SET $PIECE(^BUSA(9002319.03,IEN,0),U,7)=1

                       End DoDot:2

               End DoDot:1

 +13       KILL A,IEN,NOD0,NSP,P1,P2

 +14       QUIT