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 Nov 22, 2024@16:53:27 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
