- 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
- Q
- 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)
- Q
- 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)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBA2792 1061 printed Jan 18, 2025@02:40:58 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