DVBA2778 ;DLS/DEK - PATCH DRIVER ; 10/21/04
;;2.7;AMIE;**78**;Apr 10, 1995
; DBIA# External Reference(s)
; 2053 FILE^DIE
; 10141 BMES^XPDUTL, MES^XPDUTL
SET S (C,I,J)=0,K=396.18 Q
PRE D SET,DEACT,KILL Q
POST D SET,FIXUP,KILL Q
KILL D:J B(">>> Review the following errors <<<"),SHO
K C,I,J,K,NM,IEN,FD,^TMP("DIERR",$J),^TMP("DVBA",$J)
Q
B(X) S X=" "_$G(X)
I '$D(XPDNM) W !!,X Q
D BMES^XPDUTL(X)
Q
DEACT ;Deactivate forms
F S I=$O(^DVB(K,I)) Q:'I D
.S IEN=I_","
.D CD(3041125,3)
Q
CD(D,F) ;Change data
S FD(K,IEN,F)=D
S FD(K,IEN,7)=$S(F=2:1,1:0)
S:F=2 FD(K,IEN,3)="@"
D FILE^DIE(,"FD")
I $D(^TMP("DIERR",$J)) D
.S J=J+1
.M ^TMP("DVBA",$J,J)=^TMP("DIERR",$J)
Q
FIXUP ;Adjust zero-node
F S I=$O(^DVB(K,I)) Q:'I S C=C+1
S I=$O(^DVB(K,"A"),-1),$P(^DVB(K,0),U,3,4)=I_U_C
;Adjust forms
F I=0:0 S I=$O(^DVB(K,I)) Q:'I D
.S NM=^(I,0),C=$P(NM,"~",2),IEN=I_","
.D:C=78 CD(3041205,2)
Q
SHO I $D(XPDNM) D Q
.K C
.M C=^TMP("DVBA",$J)
.D MES^XPDUTL(.C)
S C=$Q(^TMP("DVBA",$J))
F Q:C="" D
.W !?3,@(C)
.S C=$Q(@C)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBA2778 1096 printed Dec 13, 2024@01:39:39 Page 2
DVBA2778 ;DLS/DEK - PATCH DRIVER ; 10/21/04
+1 ;;2.7;AMIE;**78**;Apr 10, 1995
+2 ; DBIA# External Reference(s)
+3 ; 2053 FILE^DIE
+4 ; 10141 BMES^XPDUTL, MES^XPDUTL
SET SET (C,I,J)=0
SET K=396.18
QUIT
PRE DO SET
DO DEACT
DO KILL
QUIT
POST DO SET
DO FIXUP
DO KILL
QUIT
KILL if J
DO B(">>> Review the following errors <<<")
DO SHO
+1 KILL C,I,J,K,NM,IEN,FD,^TMP("DIERR",$JOB),^TMP("DVBA",$JOB)
+2 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
SET I=$ORDER(^DVB(K,I))
if 'I
QUIT
Begin DoDot:1
+2 SET IEN=I_","
+3 DO CD(3041125,3)
End DoDot:1
+4 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 if F=2
SET FD(K,IEN,3)="@"
+4 DO FILE^DIE(,"FD")
+5 IF $DATA(^TMP("DIERR",$JOB))
Begin DoDot:1
+6 SET J=J+1
+7 MERGE ^TMP("DVBA",$JOB,J)=^TMP("DIERR",$JOB)
End DoDot:1
+8 QUIT
FIXUP ;Adjust zero-node
+1 FOR
SET I=$ORDER(^DVB(K,I))
if 'I
QUIT
SET C=C+1
+2 SET I=$ORDER(^DVB(K,"A"),-1)
SET $PIECE(^DVB(K,0),U,3,4)=I_U_C
+3 ;Adjust forms
+4 FOR I=0:0
SET I=$ORDER(^DVB(K,I))
if 'I
QUIT
Begin DoDot:1
+5 SET NM=^(I,0)
SET C=$PIECE(NM,"~",2)
SET IEN=I_","
+6 if C=78
DO CD(3041205,2)
End DoDot:1
+7 QUIT
SHO IF $DATA(XPDNM)
Begin DoDot:1
+1 KILL C
+2 MERGE C=^TMP("DVBA",$JOB)
+3 DO MES^XPDUTL(.C)
End DoDot:1
QUIT
+4 SET C=$QUERY(^TMP("DVBA",$JOB))
+5 FOR
if C=""
QUIT
Begin DoDot:1
+6 WRITE !?3,@(C)
+7 SET C=$QUERY(@C)
End DoDot:1
+8 QUIT
