DVBA2768 ;DLS/DEK - PATCH DRIVER ; 6/9/04
;;2.7;AMIE;**68**;Apr 10, 1995
; DBIA# External Reference(s)
; 2051 $$FIND1^DIC
; 2053 FILE^DIE
; 10141 BMES^XPDUTL, MES^XPDUTL
SET S (I,J)=0,K=396.18 Q
PRE D SET,DEACT,KILL Q
POST D SET,NODE0,ADJ,KILL Q
KILL K ^TMP("DIERR",$J),^TMP("DVBA",$J),I,J,K,NM,IEN,FD Q
B(X) S X=" "_$G(X)
I '$D(XPDNM) W !!,X Q
D BMES^XPDUTL(X)
Q
DEACT ;Deactivate forms
F I=1:1 S NM=$P($T(DATA+I),";;",2) Q:NM']"" D
.S IEN=$$FIND1^DIC(K,,"O",NM)_","
.D:IEN CD(3040615,3)
;F I=0:0 S I=$O(^DVB(K,I)) Q:'I D
;.S IEN=I_","
;.I '$D(^DVB(K,I,2)) D CD(3040721,3) Q
;.D:'$P(^DVB(K,I,2),U,2) CD(3040915,3)
D:J B(">>> Review the following errors <<<"),SHO
Q
CD(D,F) ;Change data
S FD(K,IEN,F)=D
S FD(K,IEN,7)=$S(F=2:1,1:0)
D FILE^DIE(,"FD")
I $D(^TMP("DIERR",$J)) D
.S J=J+1
.M ^TMP("DVBA",$J,J)=^TMP("DIERR",$J)
Q
NODE0 ;Adjust zero-node
F S I=$O(^DVB(K,I)) Q:'I S J=J+1
S I=$O(^DVB(K,"A"),-1),$P(^DVB(K,0),U,3,4)=I_U_J
Q
ADJ ;Adjust forms
F I=0:0 S I=$O(^DVB(K,I)) Q:'I D
.S NM=^(I,0),J=$P(NM,"~",2),IEN=I_","
.I J=3 D Q
..S $P(NM,"~",2)=4
..I $$FIND1^DIC(K,,"O",NM) D CD(3040915,3) Q
..D CD(3040721,2)
.D:J=4 CD(3040915,2)
Q
SHO I $D(XPDNM) D Q
.K J
.M J=^TMP("DVBA",$J)
.D MES^XPDUTL(.J)
S J=$Q(^TMP("DVBA",$J))
F Q:J="" D
.W !?3,@(J)
.S J=$Q(@J)
DATA Q
;;AID AND ATTENDANCE
;;ARTERIES AND VEINS
;;AUDIO
;;EAR DISEASE
;;ESOPHAGUS & HIATAL HERNIA
;;EYE EXAMINATION
;;GENITOURINARY
;;MISC RESPIRATORY DISEASES
;;MUSCLES
;;NEUROLOGICAL DISORDERS, MISC.
;;NOSE SINUS LARYNX PHARYNX
;;PTSD INITIAL EVALUATION
;;PTSD REVIEW
;;RECTUM AND ANUS
;;SCARS
;;SKIN DISEASES (OTHER THAN SCARS)
;;STOMACH DUODENUM
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBA2768 1771 printed Sep 23, 2025@19:15:37 Page 2
DVBA2768 ;DLS/DEK - PATCH DRIVER ; 6/9/04
+1 ;;2.7;AMIE;**68**;Apr 10, 1995
+2 ; DBIA# External Reference(s)
+3 ; 2051 $$FIND1^DIC
+4 ; 2053 FILE^DIE
+5 ; 10141 BMES^XPDUTL, MES^XPDUTL
SET SET (I,J)=0
SET K=396.18
QUIT
PRE DO SET
DO DEACT
DO KILL
QUIT
POST DO SET
DO NODE0
DO ADJ
DO KILL
QUIT
KILL KILL ^TMP("DIERR",$JOB),^TMP("DVBA",$JOB),I,J,K,NM,IEN,FD
QUIT
B(X) SET X=" "_$GET(X)
+1 IF '$DATA(XPDNM)
WRITE !!,X
QUIT
+2 DO BMES^XPDUTL(X)
+3 QUIT
DEACT ;Deactivate forms
+1 FOR I=1:1
SET NM=$PIECE($TEXT(DATA+I),";;",2)
if NM']""
QUIT
Begin DoDot:1
+2 SET IEN=$$FIND1^DIC(K,,"O",NM)_","
+3 if IEN
DO CD(3040615,3)
End DoDot:1
+4 ;F I=0:0 S I=$O(^DVB(K,I)) Q:'I D
+5 ;.S IEN=I_","
+6 ;.I '$D(^DVB(K,I,2)) D CD(3040721,3) Q
+7 ;.D:'$P(^DVB(K,I,2),U,2) CD(3040915,3)
+8 if J
DO B(">>> Review the following errors <<<")
DO SHO
+9 QUIT
CD(D,F) ;Change data
+1 SET FD(K,IEN,F)=D
+2 SET FD(K,IEN,7)=$SELECT(F=2:1,1:0)
+3 DO FILE^DIE(,"FD")
+4 IF $DATA(^TMP("DIERR",$JOB))
Begin DoDot:1
+5 SET J=J+1
+6 MERGE ^TMP("DVBA",$JOB,J)=^TMP("DIERR",$JOB)
End DoDot:1
+7 QUIT
NODE0 ;Adjust zero-node
+1 FOR
SET I=$ORDER(^DVB(K,I))
if 'I
QUIT
SET J=J+1
+2 SET I=$ORDER(^DVB(K,"A"),-1)
SET $PIECE(^DVB(K,0),U,3,4)=I_U_J
+3 QUIT
ADJ ;Adjust forms
+1 FOR I=0:0
SET I=$ORDER(^DVB(K,I))
if 'I
QUIT
Begin DoDot:1
+2 SET NM=^(I,0)
SET J=$PIECE(NM,"~",2)
SET IEN=I_","
+3 IF J=3
Begin DoDot:2
+4 SET $PIECE(NM,"~",2)=4
+5 IF $$FIND1^DIC(K,,"O",NM)
DO CD(3040915,3)
QUIT
+6 DO CD(3040721,2)
End DoDot:2
QUIT
+7 if J=4
DO CD(3040915,2)
End DoDot:1
+8 QUIT
SHO IF $DATA(XPDNM)
Begin DoDot:1
+1 KILL J
+2 MERGE J=^TMP("DVBA",$JOB)
+3 DO MES^XPDUTL(.J)
End DoDot:1
QUIT
+4 SET J=$QUERY(^TMP("DVBA",$JOB))
+5 FOR
if J=""
QUIT
Begin DoDot:1
+6 WRITE !?3,@(J)
+7 SET J=$QUERY(@J)
End DoDot:1
DATA QUIT
+1 ;;AID AND ATTENDANCE
+2 ;;ARTERIES AND VEINS
+3 ;;AUDIO
+4 ;;EAR DISEASE
+5 ;;ESOPHAGUS & HIATAL HERNIA
+6 ;;EYE EXAMINATION
+7 ;;GENITOURINARY
+8 ;;MISC RESPIRATORY DISEASES
+9 ;;MUSCLES
+10 ;;NEUROLOGICAL DISORDERS, MISC.
+11 ;;NOSE SINUS LARYNX PHARYNX
+12 ;;PTSD INITIAL EVALUATION
+13 ;;PTSD REVIEW
+14 ;;RECTUM AND ANUS
+15 ;;SCARS
+16 ;;SKIN DISEASES (OTHER THAN SCARS)
+17 ;;STOMACH DUODENUM
+18 ;;
