- DVBC248P ;ALB/CP - PATCH DVBA*2.7*248 POST-INSTALL ROUTINE; MAY 10, 2023 ; 5/11/23 3:14pm
- ;;2.7;AMIE;**248**;Apr 10, 1995;Build 6
- ; Per VHA Directive 6402 this routine should not be modified
- ;
- Q
- ;
- NEWENTRY(DVBIEN) ;
- ;update file with copied entry but updated name
- N DVBNAME,DVBBODY,DVBPNM,DVBWK
- S DVBNAME="DBQ GENERAL MEDICAL Gulf War"
- S DVBPNM=$$GET1^DIQ(396.6,DVBIEN,6,"I")
- S DVBBODY=$$GET1^DIQ(396.6,DVBIEN,2,"I")
- ;
- s DVBWK=$$GET1^DIQ(396.6,DVBIEN,.07,"I")
- K DIC,DIE,DA,DR,X,Y,DO
- S DIC=396.6,DIC(0)="Z",X=DVBNAME
- D FILE^DICN
- I Y=-1 K DIC Q
- S (DA)=+Y,DIE=DIC
- S DR=".07///"_DVBWK_";2///"_DVBBODY_";6///"_DVBPNM_";.5///A"
- D ^DIE
- K DIC,DIE,DA,DR,X,Y
- Q
- ;
- STATUPD ;
- ;update status for entry in AMIE Exam
- N DVBIEN,DVBNAME
- S DVBNAME=""
- S DVBIEN=0
- F S DVBIEN=$O(^DVB(396.6,DVBIEN)) Q:DVBIEN="" D
- . S DVBNAME=$P($G(^DVB(396.6,DVBIEN,0)),U,1)
- . Q:DVBNAME'="DBQ GENERAL MEDICAL Gulf War (including burn pits)"
- . D NEWENTRY(DVBIEN)
- . S DIE="^DVB(396.6,"
- . S DA=DVBIEN
- . S DR=".5///I" D ^DIE
- . K DIE,DA,DR,X,Y
- D BMES^XPDUTL("Exam Name DBQ GENERAL MEDICAL GULF WAR updated")
- D SPECUP
- Q
- SPECUP ;
- ;update status for all entries in Special Considerations
- N DVBSTAT S DVBSTAT=1
- N DVBIEN S DVBIEN=0
- K DIC,DIE,DA,DR,DLAYGO,X,Y
- F S DVBIEN=$O(^DVB(396.25,DVBIEN)) Q:DVBIEN=""!('DVBIEN) D
- . Q:$P($G(^DVB(396.25,DVBIEN,0)),U,2)=1
- . S DA=DVBIEN,(DLAYGO,DIE)="^DVB(396.25,",DIC(0)="L"
- . S DR=".02////"_DVBSTAT D ^DIE
- . K DIC,DIE,DA,DR,DLAYGO,X,Y
- D BMES^XPDUTL("Special Consideration File entries updated")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBC248P 1590 printed Apr 23, 2025@17:57:41 Page 2
- DVBC248P ;ALB/CP - PATCH DVBA*2.7*248 POST-INSTALL ROUTINE; MAY 10, 2023 ; 5/11/23 3:14pm
- +1 ;;2.7;AMIE;**248**;Apr 10, 1995;Build 6
- +2 ; Per VHA Directive 6402 this routine should not be modified
- +3 ;
- +4 QUIT
- +5 ;
- NEWENTRY(DVBIEN) ;
- +1 ;update file with copied entry but updated name
- +2 NEW DVBNAME,DVBBODY,DVBPNM,DVBWK
- +3 SET DVBNAME="DBQ GENERAL MEDICAL Gulf War"
- +4 SET DVBPNM=$$GET1^DIQ(396.6,DVBIEN,6,"I")
- +5 SET DVBBODY=$$GET1^DIQ(396.6,DVBIEN,2,"I")
- +6 ;
- +7 SET DVBWK=$$GET1^DIQ(396.6,DVBIEN,.07,"I")
- +8 KILL DIC,DIE,DA,DR,X,Y,DO
- +9 SET DIC=396.6
- SET DIC(0)="Z"
- SET X=DVBNAME
- +10 DO FILE^DICN
- +11 IF Y=-1
- KILL DIC
- QUIT
- +12 SET (DA)=+Y
- SET DIE=DIC
- +13 SET DR=".07///"_DVBWK_";2///"_DVBBODY_";6///"_DVBPNM_";.5///A"
- +14 DO ^DIE
- +15 KILL DIC,DIE,DA,DR,X,Y
- +16 QUIT
- +17 ;
- STATUPD ;
- +1 ;update status for entry in AMIE Exam
- +2 NEW DVBIEN,DVBNAME
- +3 SET DVBNAME=""
- +4 SET DVBIEN=0
- +5 FOR
- SET DVBIEN=$ORDER(^DVB(396.6,DVBIEN))
- if DVBIEN=""
- QUIT
- Begin DoDot:1
- +6 SET DVBNAME=$PIECE($GET(^DVB(396.6,DVBIEN,0)),U,1)
- +7 if DVBNAME'="DBQ GENERAL MEDICAL Gulf War (including burn pits)"
- QUIT
- +8 DO NEWENTRY(DVBIEN)
- +9 SET DIE="^DVB(396.6,"
- +10 SET DA=DVBIEN
- +11 SET DR=".5///I"
- DO ^DIE
- +12 KILL DIE,DA,DR,X,Y
- End DoDot:1
- +13 DO BMES^XPDUTL("Exam Name DBQ GENERAL MEDICAL GULF WAR updated")
- +14 DO SPECUP
- +15 QUIT
- SPECUP ;
- +1 ;update status for all entries in Special Considerations
- +2 NEW DVBSTAT
- SET DVBSTAT=1
- +3 NEW DVBIEN
- SET DVBIEN=0
- +4 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
- +5 FOR
- SET DVBIEN=$ORDER(^DVB(396.25,DVBIEN))
- if DVBIEN=""!('DVBIEN)
- QUIT
- Begin DoDot:1
- +6 if $PIECE($GET(^DVB(396.25,DVBIEN,0)),U,2)=1
- QUIT
- +7 SET DA=DVBIEN
- SET (DLAYGO,DIE)="^DVB(396.25,"
- SET DIC(0)="L"
- +8 SET DR=".02////"_DVBSTAT
- DO ^DIE
- +9 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
- End DoDot:1
- +10 DO BMES^XPDUTL("Special Consideration File entries updated")
- +11 QUIT
