- DVB442PT ;ALB/ZJF POST-INSTALL FOR PATCH DVB*4*42
- ;;4.0;HINQ;**42**;03/25/92
- ;
- ;This routine will be run as a post-installation for patch DVB*4*42.
- ;This routine will add three new disability codes to the DISABILITY
- ;CONDITION file (#31).
- ;
- POST ;entry point for post-install, setting up checkpoints
- N %
- S %=$$NEWCP^XPDUTL("DVBLINE","EN^DVB442PT",1)
- Q
- ;
- EN ;begin processing
- ;
- N DVBLINE
- ;
- D BMES^XPDUTL(" >> *** Updating DISABILITY CONDITION file (#31)")
- D MES^XPDUTL(" ")
- ;
- ;get value from checkpoints, previous run
- S DVBLINE=+$$PARCP^XPDUTL("DVBLINE")
- ;
- DVBNEW ;add new codes or modify name if code is in use
- ;
- F DVBI=DVBLINE:1 S DVBJ=$P($T(NEWCODE+DVBI),";;",2) Q:DVBJ["$EXIT" D
- .S DVBCODE=+DVBJ,DVBNAME=$E($P(DVBJ,"^",2),1,45),DVBLINE=DVBI
- .S DVBDESC=$E($P(DVBJ,"^",3),1,200)
- .;
- .;add new code
- .I '$D(^DIC(31,"C",DVBCODE)) D G UPDATECH
- ..K DD,DO
- ..S DIC="^DIC(31,",DIC(0)="L",DIC("DR")="2////"_DVBCODE_";10////"_DVBDESC
- ..S X=DVBNAME,DLAYGO=31
- ..D FILE^DICN
- ..D MES^XPDUTL(DVBCODE_": adding "_DVBCODE_" "_X)
- ..K DLAYGO,DIC,X
- ..Q
- .;
- .;modify name
- .S DVBIEN=+$O(^DIC(31,"C",DVBCODE,0))
- .S DVBREC=$G(^DIC(31,DVBIEN,0)),DVBOLDSC=$G(^DIC(31,DVBIEN,1)) I DVBREC']"" D G UPDATECH
- ..D MES^XPDUTL(" >>>> error "_DVBCODE_" in C x-reference and not in file 31")
- ..Q
- .S DVBOLDN=$P(DVBREC,"^") I DVBOLDN=DVBNAME&(DVBOLDSC=DVBDESC) G UPDATECH
- .S DA=DVBIEN,DIE="^DIC(31,",DR=".01////"_DVBNAME_";10////"_DVBDESC
- .D ^DIE
- .K DR,DA,DIE
- .I DVBOLDN'=DVBNAME D
- ..D MES^XPDUTL(DVBCODE_": changing name from "_DVBOLDN)
- ..D MES^XPDUTL(" to "_DVBNAME)
- .I DVBOLDSC'=DVBDESC D
- ..D MES^XPDUTL(DVBCODE_": changing description...")
- ..D MES^XPDUTL(" from: "_DVBOLDSC)
- ..D MES^XPDUTL(" to: "_DVBDESC)
- .;
- UPDATECH .;update checkpoint
- .S %=$$UPCP^XPDUTL("DVBLINE",DVBLINE)
- .Q
- K DVBCODE,DVBI,DVBIEN,DVBJ,DVBNAME,DVBOLDN,DVBREC,DVBDESC,DVBOLDSC
- Q
- ;
- NEWCODE ;codes to be added or changed
- ;;5230^LIMITATION ON MOTION, RING OR LITTLE FINGER^LIMITATION ON MOTION, RING OR LITTLE FINGER
- ;;7829^CHLORACNE^CHLORACNE
- ;;7820^INFECTIONS OF THE SKIN^INFECTIONS OF THE SKIN
- ;;$EXIT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVB442PT 2219 printed Feb 18, 2025@23:23:57 Page 2
- DVB442PT ;ALB/ZJF POST-INSTALL FOR PATCH DVB*4*42
- +1 ;;4.0;HINQ;**42**;03/25/92
- +2 ;
- +3 ;This routine will be run as a post-installation for patch DVB*4*42.
- +4 ;This routine will add three new disability codes to the DISABILITY
- +5 ;CONDITION file (#31).
- +6 ;
- POST ;entry point for post-install, setting up checkpoints
- +1 NEW %
- +2 SET %=$$NEWCP^XPDUTL("DVBLINE","EN^DVB442PT",1)
- +3 QUIT
- +4 ;
- EN ;begin processing
- +1 ;
- +2 NEW DVBLINE
- +3 ;
- +4 DO BMES^XPDUTL(" >> *** Updating DISABILITY CONDITION file (#31)")
- +5 DO MES^XPDUTL(" ")
- +6 ;
- +7 ;get value from checkpoints, previous run
- +8 SET DVBLINE=+$$PARCP^XPDUTL("DVBLINE")
- +9 ;
- DVBNEW ;add new codes or modify name if code is in use
- +1 ;
- +2 FOR DVBI=DVBLINE:1
- SET DVBJ=$PIECE($TEXT(NEWCODE+DVBI),";;",2)
- if DVBJ["$EXIT"
- QUIT
- Begin DoDot:1
- +3 SET DVBCODE=+DVBJ
- SET DVBNAME=$EXTRACT($PIECE(DVBJ,"^",2),1,45)
- SET DVBLINE=DVBI
- +4 SET DVBDESC=$EXTRACT($PIECE(DVBJ,"^",3),1,200)
- +5 ;
- +6 ;add new code
- +7 IF '$DATA(^DIC(31,"C",DVBCODE))
- Begin DoDot:2
- +8 KILL DD,DO
- +9 SET DIC="^DIC(31,"
- SET DIC(0)="L"
- SET DIC("DR")="2////"_DVBCODE_";10////"_DVBDESC
- +10 SET X=DVBNAME
- SET DLAYGO=31
- +11 DO FILE^DICN
- +12 DO MES^XPDUTL(DVBCODE_": adding "_DVBCODE_" "_X)
- +13 KILL DLAYGO,DIC,X
- +14 QUIT
- End DoDot:2
- GOTO UPDATECH
- +15 ;
- +16 ;modify name
- +17 SET DVBIEN=+$ORDER(^DIC(31,"C",DVBCODE,0))
- +18 SET DVBREC=$GET(^DIC(31,DVBIEN,0))
- SET DVBOLDSC=$GET(^DIC(31,DVBIEN,1))
- IF DVBREC']""
- Begin DoDot:2
- +19 DO MES^XPDUTL(" >>>> error "_DVBCODE_" in C x-reference and not in file 31")
- +20 QUIT
- End DoDot:2
- GOTO UPDATECH
- +21 SET DVBOLDN=$PIECE(DVBREC,"^")
- IF DVBOLDN=DVBNAME&(DVBOLDSC=DVBDESC)
- GOTO UPDATECH
- +22 SET DA=DVBIEN
- SET DIE="^DIC(31,"
- SET DR=".01////"_DVBNAME_";10////"_DVBDESC
- +23 DO ^DIE
- +24 KILL DR,DA,DIE
- +25 IF DVBOLDN'=DVBNAME
- Begin DoDot:2
- +26 DO MES^XPDUTL(DVBCODE_": changing name from "_DVBOLDN)
- +27 DO MES^XPDUTL(" to "_DVBNAME)
- End DoDot:2
- +28 IF DVBOLDSC'=DVBDESC
- Begin DoDot:2
- +29 DO MES^XPDUTL(DVBCODE_": changing description...")
- +30 DO MES^XPDUTL(" from: "_DVBOLDSC)
- +31 DO MES^XPDUTL(" to: "_DVBDESC)
- End DoDot:2
- +32 ;
- UPDATECH ;update checkpoint
- +1 SET %=$$UPCP^XPDUTL("DVBLINE",DVBLINE)
- +2 QUIT
- End DoDot:1
- +3 KILL DVBCODE,DVBI,DVBIEN,DVBJ,DVBNAME,DVBOLDN,DVBREC,DVBDESC,DVBOLDSC
- +4 QUIT
- +5 ;
- NEWCODE ;codes to be added or changed
- +1 ;;5230^LIMITATION ON MOTION, RING OR LITTLE FINGER^LIMITATION ON MOTION, RING OR LITTLE FINGER
- +2 ;;7829^CHLORACNE^CHLORACNE
- +3 ;;7820^INFECTIONS OF THE SKIN^INFECTIONS OF THE SKIN
- +4 ;;$EXIT
- +5 QUIT