- BDGPRE ; IHS/ANMC/LJF - PIMS PREINIT ; [ 12/02/2002 4:25 PM ]
- ;;5.3;PIMS;;APR 26, 2002
- ;
- ; Changes that must be made BEFORE running install
- ;11/6/2002 WAR - added a call to ^BDGPRE1
- ;D DPTDEL,BULLD,BULLC Q
- D ^BDGPRE1,DPTDEL,BULLD,BULLC Q
- ;
- DPTDEL ; -- delete old dd for files 2,40.8, 42, 43, 44, 405
- ; -- VA removed lots of fields
- S ADIFROM("IHS")="" ;so user won't be asked continue question
- K ^UTILITY("XBDSET",$J)
- S ^UTILITY("XBDSET",$J,2)="S^S"
- S ^UTILITY("XBDSET",$J,40.8)="S^S"
- S ^UTILITY("XBDSET",$J,42)="S^S"
- S ^UTILITY("XBDSET",$J,43)="S^S"
- S ^UTILITY("XBDSET",$J,44)="S^S"
- S ^UTILITY("XBDSET",$J,405)="S^S"
- D EN2^XBKD
- K ADIFROM("IHS")
- Q
- ;
- BULLD ; delete obsolete bulletins
- NEW BDGI,DIK,DA,NAME
- S DIK="^XMB(3.6,"
- F BDGI=1:1:3 S NAME=$P($T(OLDBUL+BDGI),";;",2) D
- . Q:'$D(^XMB(3.6,"B",NAME)) ;does not have old bulletins
- . S DA=$O(^XMB(3.6,"B",NAME,0)) I DA D ^DIK
- Q
- ;
- BULLC ; change names of ADT bulletins if already on system
- ; and delete message text to start fresh
- NEW DIE,DA,DR,OLD,IEN,X,BDGI
- F BDGI=1:1:9 S OLD=$P($T(BULLNM+BDGI),";;",2) D
- . Q:'$D(^XMB(3.6,"B",OLD)) ;does not have old bulletin
- . S IEN=$O(^XMB(3.6,"B",OLD,0)) Q:'IEN ;bad xref
- . ;
- . ; change name
- . S DIE=3.6,DA=IEN,DR=".01///"_$P($T(BULLNM+BDGI),";;",3) D ^DIE
- . ;
- . ; now remove message text
- . S X=0 F S X=$O(^XMB(3.6,IEN,1,X)) Q:'X D
- .. K ^XMB(3.6,IEN,1,X,0)
- Q
- ;
- ;
- OLDBUL ;; obsolete bulletins
- ;;DG IHS INCOMPLETE MOVEMENT;;
- ;;DG IHS ADCORR;;
- ;;DG IHS VHOSP;;
- ;
- ;
- BULLNM ;; bulletin names (old;;new)
- ;;DG IHS A&D;;BDG A&D READY;;
- ;;DG IHS B ADMIT AFTER DAY SURG;;BDG ADMIT AFTER DAY SURG;;
- ;;DG IHS B AMA DISCHARGE;;BDG AMA DISCHARGE;;
- ;;DG IHS B DEATH;;BDG DEATH;;
- ;;DG IHS B ICU TRANSFER;;BDG ICU TRANSFER;;
- ;;DG IHS B READMISSION;;BDG READMISSION;;
- ;;DG IHS B TRANSFER IN ADMIT;;BDG TRANSFER IN ADMIT;;
- ;;DG IHS B TRANSFER OUT DISCH;;BDG TRANSFER OUT DISCH;;
- ;;DG IHS DELETED ADMITS;;BDG DELETED ADMITS;;
- BDGPRE ; IHS/ANMC/LJF - PIMS PREINIT ; [ 12/02/2002 4:25 PM ]
- +1 ;;5.3;PIMS;;APR 26, 2002
- +2 ;
- +3 ; Changes that must be made BEFORE running install
- +4 ;11/6/2002 WAR - added a call to ^BDGPRE1
- +5 ;D DPTDEL,BULLD,BULLC Q
- +6 DO ^BDGPRE1
- DO DPTDEL
- DO BULLD
- DO BULLC
- QUIT
- +7 ;
- DPTDEL ; -- delete old dd for files 2,40.8, 42, 43, 44, 405
- +1 ; -- VA removed lots of fields
- +2 ;so user won't be asked continue question
- SET ADIFROM("IHS")=""
- +3 KILL ^UTILITY("XBDSET",$JOB)
- +4 SET ^UTILITY("XBDSET",$JOB,2)="S^S"
- +5 SET ^UTILITY("XBDSET",$JOB,40.8)="S^S"
- +6 SET ^UTILITY("XBDSET",$JOB,42)="S^S"
- +7 SET ^UTILITY("XBDSET",$JOB,43)="S^S"
- +8 SET ^UTILITY("XBDSET",$JOB,44)="S^S"
- +9 SET ^UTILITY("XBDSET",$JOB,405)="S^S"
- +10 DO EN2^XBKD
- +11 KILL ADIFROM("IHS")
- +12 QUIT
- +13 ;
- BULLD ; delete obsolete bulletins
- +1 NEW BDGI,DIK,DA,NAME
- +2 SET DIK="^XMB(3.6,"
- +3 FOR BDGI=1:1:3
- SET NAME=$PIECE($TEXT(OLDBUL+BDGI),";;",2)
- Begin DoDot:1
- +4 ;does not have old bulletins
- IF '$DATA(^XMB(3.6,"B",NAME))
- QUIT
- +5 SET DA=$ORDER(^XMB(3.6,"B",NAME,0))
- IF DA
- DO ^DIK
- End DoDot:1
- +6 QUIT
- +7 ;
- BULLC ; change names of ADT bulletins if already on system
- +1 ; and delete message text to start fresh
- +2 NEW DIE,DA,DR,OLD,IEN,X,BDGI
- +3 FOR BDGI=1:1:9
- SET OLD=$PIECE($TEXT(BULLNM+BDGI),";;",2)
- Begin DoDot:1
- +4 ;does not have old bulletin
- IF '$DATA(^XMB(3.6,"B",OLD))
- QUIT
- +5 ;bad xref
- SET IEN=$ORDER(^XMB(3.6,"B",OLD,0))
- IF 'IEN
- QUIT
- +6 ;
- +7 ; change name
- +8 SET DIE=3.6
- SET DA=IEN
- SET DR=".01///"_$PIECE($TEXT(BULLNM+BDGI),";;",3)
- DO ^DIE
- +9 ;
- +10 ; now remove message text
- +11 SET X=0
- FOR
- SET X=$ORDER(^XMB(3.6,IEN,1,X))
- IF 'X
- QUIT
- Begin DoDot:2
- +12 KILL ^XMB(3.6,IEN,1,X,0)
- End DoDot:2
- End DoDot:1
- +13 QUIT
- +14 ;
- +15 ;
- OLDBUL ;; obsolete bulletins
- +1 ;;DG IHS INCOMPLETE MOVEMENT;;
- +2 ;;DG IHS ADCORR;;
- +3 ;;DG IHS VHOSP;;
- +4 ;
- +5 ;
- BULLNM ;; bulletin names (old;;new)
- +1 ;;DG IHS A&D;;BDG A&D READY;;
- +2 ;;DG IHS B ADMIT AFTER DAY SURG;;BDG ADMIT AFTER DAY SURG;;
- +3 ;;DG IHS B AMA DISCHARGE;;BDG AMA DISCHARGE;;
- +4 ;;DG IHS B DEATH;;BDG DEATH;;
- +5 ;;DG IHS B ICU TRANSFER;;BDG ICU TRANSFER;;
- +6 ;;DG IHS B READMISSION;;BDG READMISSION;;
- +7 ;;DG IHS B TRANSFER IN ADMIT;;BDG TRANSFER IN ADMIT;;
- +8 ;;DG IHS B TRANSFER OUT DISCH;;BDG TRANSFER OUT DISCH;;
- +9 ;;DG IHS DELETED ADMITS;;BDG DELETED ADMITS;;
