- DVB470P ;MNT/RFS - UPDATE DISABILITY CONDITION (#31) FILE; September 9, 2021
- ;;4.0;HINQ;**70**;03/25/92;Build 1
- ;
- Q
- ;
- ;
- EN ;Initialize variables and validate user.
- N DVBI,DVBJ,DVBREF,DIC,DO,X,Y
- I '$D(DUZ) D BMES^XPDUTL("*** PROGRAMMER NOT DEFINED ***") Q
- DVBNEW ;Add new codes.
- D BMES^XPDUTL("** Updating DISABILITY CONDITION (#31) file **")
- F DVBI=1:1 S DVBJ=$P($T(NEWCODE+DVBI),";;",2) Q:DVBJ="QUIT" D
- .S DVBREF=+DVBJ
- .I $D(^DIC(31,"C",DVBREF)) D DVBERR1 Q
- .K DO
- .S DIC="^DIC(31,",DIC(0)="L",DIC("DR")="2///"_DVBREF,X=$P(DVBJ,"^",2)
- .D FILE^DICN
- .I Y=-1 D DVBERR2 Q
- .D BMES^XPDUTL("** "_DVBREF_" "_X_" has been added **")
- D BMES^XPDUTL("** Done **")
- Q
- DVBERR1 ;Message to the user that the file entry already exists.
- D BMES^XPDUTL("*** A FILE ENTRY FOR DISABILITY CODE "_DVBREF_" HAS ALREADY BEEN CREATED ***")
- Q
- DVBERR2 ;Message to the user that an error occurred.
- D BMES^XPDUTL("*** AN ERROR OCCURRED WHEN ATTEMPTING TO ADD NEW FILE ENTRIES. PLEASE CONTACT PRODUCT SUPPORT ***")
- Q
- NEWCODE ;Code to be added.
- ;;5244^TRAUMATIC PARALYSIS, COMPLETE
- ;;5269^PLANTAR FASCIITIS
- ;;5330^RHABDOMYOLYSIS, RESIDUALS OF
- ;;5331^COMPARTMENT SYNDROME
- ;;6312^NONTUBERCULOSIS MYCOBACTERIUM INFECTION
- ;;6325^HYPERINFECTION SYND OR STRONGYLOIDIASIS
- ;;6326^SCHISTOSOMIASIS
- ;;6329^HEMORRHAGIC FEVERS
- ;;6330^CAMPYLOBACTER JEJUNI INFECTION
- ;;6331^COXIELLA BURNETII INFECTION (Q FEVER)
- ;;6333^NONTYPHOID SALMONELLA INFECTIONS
- ;;6334^SHIGELLA INFECTIONS
- ;;6335^WEST NILE VIRUS INFECTION
- ;;7009^BRADYCARDIA REQUIRING PACEMAKER
- ;;7124^PRIMARY RAYNAUD'S
- ;;7543^VARICOCELE/HYDROCELE
- ;;7544^RENAL DISEASE CAUSED BY VIRAL INFECTION
- ;;7545^BLADDER, DIVERTICULUM OF
- ;;QUIT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVB470P 1738 printed Mar 13, 2025@21:02:25 Page 2
- DVB470P ;MNT/RFS - UPDATE DISABILITY CONDITION (#31) FILE; September 9, 2021
- +1 ;;4.0;HINQ;**70**;03/25/92;Build 1
- +2 ;
- +3 QUIT
- +4 ;
- +5 ;
- EN ;Initialize variables and validate user.
- +1 NEW DVBI,DVBJ,DVBREF,DIC,DO,X,Y
- +2 IF '$DATA(DUZ)
- DO BMES^XPDUTL("*** PROGRAMMER NOT DEFINED ***")
- QUIT
- DVBNEW ;Add new codes.
- +1 DO BMES^XPDUTL("** Updating DISABILITY CONDITION (#31) file **")
- +2 FOR DVBI=1:1
- SET DVBJ=$PIECE($TEXT(NEWCODE+DVBI),";;",2)
- if DVBJ="QUIT"
- QUIT
- Begin DoDot:1
- +3 SET DVBREF=+DVBJ
- +4 IF $DATA(^DIC(31,"C",DVBREF))
- DO DVBERR1
- QUIT
- +5 KILL DO
- +6 SET DIC="^DIC(31,"
- SET DIC(0)="L"
- SET DIC("DR")="2///"_DVBREF
- SET X=$PIECE(DVBJ,"^",2)
- +7 DO FILE^DICN
- +8 IF Y=-1
- DO DVBERR2
- QUIT
- +9 DO BMES^XPDUTL("** "_DVBREF_" "_X_" has been added **")
- End DoDot:1
- +10 DO BMES^XPDUTL("** Done **")
- +11 QUIT
- DVBERR1 ;Message to the user that the file entry already exists.
- +1 DO BMES^XPDUTL("*** A FILE ENTRY FOR DISABILITY CODE "_DVBREF_" HAS ALREADY BEEN CREATED ***")
- +2 QUIT
- DVBERR2 ;Message to the user that an error occurred.
- +1 DO BMES^XPDUTL("*** AN ERROR OCCURRED WHEN ATTEMPTING TO ADD NEW FILE ENTRIES. PLEASE CONTACT PRODUCT SUPPORT ***")
- +2 QUIT
- NEWCODE ;Code to be added.
- +1 ;;5244^TRAUMATIC PARALYSIS, COMPLETE
- +2 ;;5269^PLANTAR FASCIITIS
- +3 ;;5330^RHABDOMYOLYSIS, RESIDUALS OF
- +4 ;;5331^COMPARTMENT SYNDROME
- +5 ;;6312^NONTUBERCULOSIS MYCOBACTERIUM INFECTION
- +6 ;;6325^HYPERINFECTION SYND OR STRONGYLOIDIASIS
- +7 ;;6326^SCHISTOSOMIASIS
- +8 ;;6329^HEMORRHAGIC FEVERS
- +9 ;;6330^CAMPYLOBACTER JEJUNI INFECTION
- +10 ;;6331^COXIELLA BURNETII INFECTION (Q FEVER)
- +11 ;;6333^NONTYPHOID SALMONELLA INFECTIONS
- +12 ;;6334^SHIGELLA INFECTIONS
- +13 ;;6335^WEST NILE VIRUS INFECTION
- +14 ;;7009^BRADYCARDIA REQUIRING PACEMAKER
- +15 ;;7124^PRIMARY RAYNAUD'S
- +16 ;;7543^VARICOCELE/HYDROCELE
- +17 ;;7544^RENAL DISEASE CAUSED BY VIRAL INFECTION
- +18 ;;7545^BLADDER, DIVERTICULUM OF
- +19 ;;QUIT
- +20 QUIT
