source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIFG6.m@ 1446

Last change on this file since 1446 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1DIFG6 ;SFISC/DG(OHPRD)-UPDATE FILES ;2/3/93 12:23 PM
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4START ;
5 S DIFGORDR=0
6 F DIFGL=0:0 S DIFGORDR=$O(^UTILITY("DIFG",$J,DIFGORDR)) Q:DIFGORDR=""!(DIFGER) D SETVAR D:'$D(DIFGNODL) PROCESS K DIFGNODL
7 D EOJ
8 Q
9 ;
10SETVAR ;SET UP VARIABLES FOR DI* CALLS FOR A GIVEN ENTRY IN ^UTILITY("DIFG",$J,...)
11 S DIFGFILE=$O(^UTILITY("DIFG",$J,DIFGORDR,0))
12 S DIFGMODE=$P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"MODE"),U)
13 I DIFGMODE="D",^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DA")=-1 S DIFGNODL="" G X3
14 I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"X")) S:^("X")["^UTILITY" ^("X")="~"_$E(^("X"),2,$L(^("X"))) S X=$S($P(^("X"),U,2)'="N"!(+^("X")):$P(^("X"),U),1:@($TR($P(^("X"),U),"~","^")))
15 I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DA(1)")) F DIFGI=1:1 Q:'$D(^("DA("_DIFGI_")")) S @("DA("_DIFGI_")="_^("DA("_DIFGI_")"))
16 I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DIC(""P"")")) S DIC("P")=^("DIC(""P"")") ;Exists if a multiple and calling DIC to add
17 I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DIC(""DR"")")) S DIC("DR")=^("DIC(""DR"")")
18 ;I $D(DIC("DR")) S DIFGZRO=0 F DIFGL=0:0 S DIFGZRO=$O(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DIC(""DR"")",DIFGZRO)) Q:'DIFGZRO S DIC("DR"
19X3 Q
20 ;
21PROCESS ;DETERMINE WHICH DI* ROUTINE(S) TO CALL FOR A GIVEN ENTRY
22 I DIFGMODE="A" S DIC=^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"GL") D CALLDIC^DIFG7 S:'DIFGER DIFGAVAL=+Y D:'DIFGER ADDCONT G X1
23 D BUILDDR
24 S DIE=^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"GL"),@("DA="_^("DA")) I $D(DR),DR]"" D CALLDIE^DIFG7 I $D(Y) S DIFGER=14_U_$P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"MODE"),U,2) D ERROR^DIFG G X1
25 I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"WP")) D WP^DIFG7 I $D(Y) S DIFGER=17_"^"_$P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"MODE"),U,2) D ERROR^DIFG G X1
26 I DIFGMODE="D",'DIFGER S DIK=DIE D CALLDIK^DIFG7
27 I 'DIFGER S $P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DA"),"^",2)="I"
28X1 K DIC,DIE,DIK,DA,DR,DIFGAVAL
29 Q
30 ;
31ADDCONT ;CONTINUATION OF MODE="A" PROCESSING UPON RETURN FROM ^DIC
32 S DA=DIFGAVAL,DIE=DIC
33 I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"WP")) D WP^DIFG7 I $D(Y) S DIK=DIE,@(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DA"))="" D CALLDIK^DIFG7 S DIFGER=17_"^"_$P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"MODE"),U,2)_"^I" D ERROR^DIFG G X1
34 D BUILDDR
35 I $D(DR),DR]"" S DA=DIFGAVAL D CALLDIE^DIFG7 I $D(Y) S DIK=DIE,@(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DA"))="" D CALLDIK^DIFG7 S DIFGER=15_U_$P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"MODE"),U,2) D ERROR^DIFG
36 I 'DIFGER S @(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DA"))=DIFGAVAL,^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DA")=DIFGAVAL_"^I" D RESET
37 Q
38 ;
39BUILDDR ;SET DR (BUILD DR ARRAY IF APPROPRIATE)
40 I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DR")) S DR=^("DR")
41 I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DR"))=11 S DIFGZRO=0 F DIFGL=0:0 S DIFGZRO=$O(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DR",DIFGZRO)) Q:'DIFGZRO S DR(1,DIFGFILE,DIFGZRO)=^(DIFGZRO)
42 Q
43 ;
44RESET ;RESETS MODE INDICATOR IN FILEGRAM FROM "A" TO "M"
45 I DIFGORDR'<1 S DIFGTMP=DIFGLO_$P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"MODE"),U,2)_",0)",DIFGVL0=@DIFGTMP,DIFGVL1=$P(DIFGVL0,"="),DIFGVL2=$P(DIFGVL0,"=",2,3),$P(DIFGVL1,U,3)="M"
46 E G X2
47 S DIFGTMP="^UTILITY(""DIFGFG"",$J,$P(^UTILITY(""DIFG"",$J,DIFGORDR,DIFGFILE,""MODE""),U,2))"
48 S @(DIFGTMP_"=DIFGVL1_""=""_DIFGVL2")
49 ;
50X2 Q
51 ;
52EOJ K DIFGI,DIFGORDR,DIFGFILE,DIFGMODE,DIFGTMP,DIFGVL0,DIFGVL1,DIFGVL2,DIFGDRVL,DIFGDRPT,DIFGZRO
53 Q
Note: See TracBrowser for help on using the repository browser.