PSB3P58.m

PSB3P58 ;BIRMINGHAM/GN - POST INSTALL FOR PSB-3-58 ;4/28/11 11:23am

 ;;3.0;BAR CODE MED ADMIN;**58**;Mar 2004;Build 37

 ;

 ; Init New XPAR Divisional parameter for all BCMA active Medical

 ; Center Divisions.

 ;

 ;    PSB NON-NURSE VERIFIED PROMPT = "N"

 ;      Emulates how BCMA worked prior to this patch.

 ;

 ; Reference/IA

 ; File #40.8/2817

 ;

BEGIN ;set all medical center divisions Non-ver prompts if BCMA online

 N ENT,DV,T5,T10,T20

 S T5="",$P(T5," ",5)=" ",T10="",$P(T10," ",10)=" ",T20="",$P(T20," ",20)=" "

 D MES^XPDUTL("")

 D MES^XPDUTL("*** PSB*3*58 POST INSTALL NOW RUNNING ***")

 D LIST(0)

 D LIST(1) H 6

 Q

 ;

LIST(UPD) ;update or list

 ; input: UPD=1 update, else list only

 N FOUND,WORD S FOUND=0,WORD=$S(UPD:"After",1:"Before")

 D MES^XPDUTL("")

 D MES^XPDUTL(T20_WORD_" update")

 D MES^XPDUTL("")

 ;loop thru all medical divisions and only update those that use BCMA

 F DV=0:0 S DV=$O(^DG(40.8,"AD",DV)) Q:'DV  D

 . S ENT=DV_";DIC(4,"

 . Q:'$$GET^XPAR(ENT,"PSB ONLINE")

 . S FOUND=1

 . I UPD,$$GET^XPAR(ENT,"PSB NON-NURSE VERIFIED PROMPT")="" D

 .. D EN^XPAR(ENT,"PSB NON-NURSE VERIFIED PROMPT",1,"N")

 . D MES^XPDUTL("  "_$E($P(^DIC(4,+ENT,0),U)_T20,1,25)_T10_$$GET^XPAR(ENT,"PSB NON-NURSE VERIFIED PROMPT",,"E"))

 D:'FOUND MES^XPDUTL(T5_"** NO DIVISIONS FOUND WITH BCMA ONLINE **")

 D MES^XPDUTL("")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSB3P58   1365     printed  Apr 09, 2024@20:44:59                                                                                                                                                                                                     Page 2

PSB3P58   ;BIRMINGHAM/GN - POST INSTALL FOR PSB-3-58 ;4/28/11 11:23am

 +1       ;;3.0;BAR CODE MED ADMIN;**58**;Mar 2004;Build 37

 +2       ;

 +3       ; Init New XPAR Divisional parameter for all BCMA active Medical

 +4       ; Center Divisions.

 +5       ;

 +6       ;    PSB NON-NURSE VERIFIED PROMPT = "N"

 +7       ;      Emulates how BCMA worked prior to this patch.

 +8       ;

 +9       ; Reference/IA

 +10      ; File #40.8/2817

 +11      ;

BEGIN     ;set all medical center divisions Non-ver prompts if BCMA online

 +1        NEW ENT,DV,T5,T10,T20

 +2        SET T5=""

           SET $PIECE(T5," ",5)=" "

           SET T10=""

           SET $PIECE(T10," ",10)=" "

           SET T20=""

           SET $PIECE(T20," ",20)=" "

 +3        DO MES^XPDUTL("")

 +4        DO MES^XPDUTL("*** PSB*3*58 POST INSTALL NOW RUNNING ***")

 +5        DO LIST(0)

 +6        DO LIST(1)

           HANG 6

 +7        QUIT 

 +8       ;

LIST(UPD) ;update or list

 +1       ; input: UPD=1 update, else list only

 +2        NEW FOUND,WORD

           SET FOUND=0

           SET WORD=$SELECT(UPD:"After",1:"Before")

 +3        DO MES^XPDUTL("")

 +4        DO MES^XPDUTL(T20_WORD_" update")

 +5        DO MES^XPDUTL("")

 +6       ;loop thru all medical divisions and only update those that use BCMA

 +7        FOR DV=0:0

               SET DV=$ORDER(^DG(40.8,"AD",DV))

               if 'DV

                   QUIT 

               Begin DoDot:1

 +8                SET ENT=DV_";DIC(4,"

 +9                if '$$GET^XPAR(ENT,"PSB ONLINE")

                       QUIT 

 +10               SET FOUND=1

 +11               IF UPD

                       IF $$GET^XPAR(ENT,"PSB NON-NURSE VERIFIED PROMPT")=""

                           Begin DoDot:2

 +12                           DO EN^XPAR(ENT,"PSB NON-NURSE VERIFIED PROMPT",1,"N")

                           End DoDot:2

 +13               DO MES^XPDUTL("  "_$EXTRACT($PIECE(^DIC(4,+ENT,0),U)_T20,1,25)_T10_$$GET^XPAR(ENT,"PSB NON-NURSE VERIFIED PROMPT",,"E"))

               End DoDot:1

 +14       if 'FOUND

               DO MES^XPDUTL(T5_"** NO DIVISIONS FOUND WITH BCMA ONLINE **")

 +15       DO MES^XPDUTL("")

 +16       QUIT