Routine: DVBA2792

DVBA2792 ;DLS/DEK - PATCH DRIVER ; 5/2/05

 ;;2.7;AMIE;**92**;Apr 10, 1995

 ; DBIA#  External Reference(s)

 ;  2053  FILE^DIE

 ; 10013  ENALL^DIK

 ; 10103  $$FMADD^XLFDT

 ; 10141  BMES^XPDUTL, MES^XPDUTL

 N DIK S N="92T1",(C,J,L,V)=0,K=396.18,B=$$FMADD^XLFDT(DT,-9),DIK="^DVB("_K_",",DIK(1)=".01^2"

 F  S L=$O(^DVB(K,L)) Q:'L  S T=^(L,0),V=$P(T,"~",2),M=L,C=C+1 D

 .I V=N D C(T'["MENT"+2,L) Q

 .I V["T",'$P($G(^DVB(K,L,2)),U,2) D C(3,L)

 S $P(^DVB(K,0),U,3,4)=M_U_C

 D:J L(">>>>>   Review these errors   <<<<<")

 K A,B,C,J,K,L,M,N,T,V,^TMP("DIERR",$J),^TMP("DVBA",$J),@(DIK_"""AV"")")

 D ENALL^DIK

3 S A(K,IEN,7)=0,A(K,IEN,F)=B,A(K,IEN,2)="@" Q

2 S A(K,IEN,7)=1,A(K,IEN,F)=DT,A(K,IEN,3)="@" Q

C(F,IEN) S IEN=IEN_"," D @F,FILE^DIE(,"A")

 I $D(^TMP("DIERR",$J)) S J=J+1 M ^TMP("DVBA",$J,J)=^TMP("DIERR",$J)

L(X) I $D(XPDNM) K C M C=^TMP("DVBA",$J) D BMES^XPDUTL(X),MES^XPDUTL(.C) Q

 S L="""",A=L_","_$J,J="DVBA"_A,V="^TMP("_L_"DIERR"_A_","

 W !!,X S C=$Q(^TMP("DVBA",$J)) F  Q:C'[J  W !?3,V,$P(C,",",3,99)," = ",@C S C=$Q(@C)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBA2792   1061     printed  Dec 13, 2024@01:39:44                                                                                                                                                                                                    Page 2

DVBA2792  ;DLS/DEK - PATCH DRIVER ; 5/2/05

 +1       ;;2.7;AMIE;**92**;Apr 10, 1995

 +2       ;

 +3       ; DBIA#  External Reference(s)

 +4       ;  2053  FILE^DIE

 +5       ; 10013  ENALL^DIK

 +6       ; 10103  $$FMADD^XLFDT

 +7       ; 10141  BMES^XPDUTL, MES^XPDUTL

 +8        NEW DIK

           SET N="92T1"

           SET (C,J,L,V)=0

           SET K=396.18

           SET B=$$FMADD^XLFDT(DT,-9)

           SET DIK="^DVB("_K_","

           SET DIK(1)=".01^2"

 +9        FOR

               SET L=$ORDER(^DVB(K,L))

               if 'L

                   QUIT

               SET T=^(L,0)

               SET V=$PIECE(T,"~",2)

               SET M=L

               SET C=C+1

               Begin DoDot:1

 +10               IF V=N

                       DO C(T'["MENT"+2,L)

                       QUIT

 +11               IF V["T"

                       IF '$PIECE($GET(^DVB(K,L,2)),U,2)

                           DO C(3,L)

               End DoDot:1

 +12       SET $PIECE(^DVB(K,0),U,3,4)=M_U_C

 +13       if J

               DO L(">>>>>   Review these errors   <<<<<")

 +14       KILL A,B,C,J,K,L,M,N,T,V,^TMP("DIERR",$JOB),^TMP("DVBA",$JOB),@(DIK_"""AV"")")

 +15       DO ENALL^DIK

 +16       QUIT

3          SET A(K,IEN,7)=0

           SET A(K,IEN,F)=B

           SET A(K,IEN,2)="@"

           QUIT

2          SET A(K,IEN,7)=1

           SET A(K,IEN,F)=DT

           SET A(K,IEN,3)="@"

           QUIT

C(F,IEN)   SET IEN=IEN_","

           DO @F

           DO FILE^DIE(,"A")

 +1        IF $DATA(^TMP("DIERR",$JOB))

               SET J=J+1

               MERGE ^TMP("DVBA",$JOB,J)=^TMP("DIERR",$JOB)

 +2        QUIT

L(X)       IF $DATA(XPDNM)

               KILL C

               MERGE C=^TMP("DVBA",$JOB)

               DO BMES^XPDUTL(X)

               DO MES^XPDUTL(.C)

               QUIT

 +1        SET L=""""

           SET A=L_","_$JOB

           SET J="DVBA"_A

           SET V="^TMP("_L_"DIERR"_A_","

 +2        WRITE !!,X

           SET C=$QUERY(^TMP("DVBA",$JOB))

FOR

               if C'[J

                   QUIT

               WRITE !?3,V,$PIECE(C,",",3,99)," = ",@C

               SET C=$QUERY(@C)

 +3        QUIT

DVBA2792.m