| [613] | 1 | DIFG2 ;SFISC/DG(OHPRD)-PROCESSING OF MULTIPLES FROM FILEGRAM ; [ 02/02/93 4:21 PM ]
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | START ;CALLED BY DIFG
|
|---|
| 5 | S DIFG=DIFG+1
|
|---|
| 6 | I DIFGMULT=0 S DIFGNDC=0,DIFGM(0)=DIC ;ENTERING HIGHEST LEVEL MULTIPLE
|
|---|
| 7 | N DIC
|
|---|
| 8 | D MULT
|
|---|
| 9 | I DIFGER G X1
|
|---|
| 10 | I '$D(DIFG("NOLKUP")) D ^DIFG3 I 1
|
|---|
| 11 | E D NOLOOK
|
|---|
| 12 | I DIFGER G X1
|
|---|
| 13 | D SET
|
|---|
| 14 | K DIFGALNK,DIFGMLND,DIFGPC,DIFGFLD,DIFGVAL,DIFGDOL,DIFGNUMF,DIFGNOLK,DIFGLAGO,Y,DIFG("NOLKUP"),DIFG("ACGRV"),DIFGDIC(DIFGDIC)
|
|---|
| 15 | D FILE^DIFG
|
|---|
| 16 | K DIFGSKIP(DIFGMULT) ;Going up one level so kill this variable which tells lower level multiples not to do lookup
|
|---|
| 17 | D CHANGEDA
|
|---|
| 18 | S DIFG=DIFG-1
|
|---|
| 19 | X1 Q
|
|---|
| 20 | ;
|
|---|
| 21 | MULT ;MULTIPLE FIELD LOOKUP AND CALL TO SET DR STRING FOR MULTIPLE
|
|---|
| 22 | I DIFGMULT=0 S DIFGMGBL(DIFGMULT)=$S(DIFGM(0):^DIC(DIFGM(0),0,"GL"),1:DIC),DIFGDA(DIFGMULT)=DA
|
|---|
| 23 | S DIFGNODE=$P($P(DIFGMLND,"^",4),";")
|
|---|
| 24 | S DIFGLAGO=0
|
|---|
| 25 | I $P(^DD(DIFGNUM,.01,0),U,2)'["'"!($D(DIFGENV("LAYGO",DIFGNUM,.01))) S DIFGLAGO=1 ;Not a ptr or a ptr and laygo allowed
|
|---|
| 26 | S DIFGMULT=DIFGMULT+1
|
|---|
| 27 | I $D(DIFGSKIP(DIFGMULT-1)) S DIFGSKIP(DIFGMULT)=""
|
|---|
| 28 | S DIFGMGBL(DIFGMULT)=DIFGMGBL(DIFGMULT-1)_DIFGDA(DIFGMULT-1)_","_""""_DIFGNODE_""""_","
|
|---|
| 29 | S DIFGM(DIFGMULT)=DIFGNUM
|
|---|
| 30 | S DIC=DIFGNUM D BASE^DIFG0 Q:DIFGER D FUNC^DIFG0
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | NOLOOK ;IF NO LOOKUP REQUIRED, SET DA ARRAY
|
|---|
| 34 | F DIFGI=DIFGMULT:-1:1 S DA(DIFGI)=$S(DIFGI=1:DA,1:DA(DIFGI-1))
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | SET ;
|
|---|
| 38 | I '$D(DIFGSKIP(DIFGMULT)) S (DA,DIFGDA(DIFGMULT))=+Y
|
|---|
| 39 | E S (DA,DIFGDA(DIFGMULT))=DIFGALNK I '$D(DIFGFLUS) D
|
|---|
| 40 | . S ^UTILITY("DIFG",$J,DIFGINCR,DIC,"X")=$S($E(X)="`":$E(X,2,245)_"^N",($D(DIFG("ACGRV"))!(X[("^UTILITY(""DIFG@"","_$J))):X_"^N",1:X_"^"),^("MODE")="A"_"^"_$P(^("MODE"),U,2),^("DIC(""P"")")=$P(DIFGMLND,U,2)
|
|---|
| 41 | S DIC=DIFGM(DIFGMULT)
|
|---|
| 42 | S ^UTILITY("DIFG",$J,DIFGINCR,DIC,"DA")=DA,^("GL")=DIFGMGBL(DIFGMULT),^($S($D(DIFGSKIP(DIFGMULT))&('$D(DIFGFLUS)):"DIC(""DR"")",1:"DR"))="" F DIFGI=1:1:DIFGMULT S ^("DA("_DIFGI_")")=DA(DIFGI)
|
|---|
| 43 | I $D(DIFGSKIP(DIFGMULT)),'$D(DIFGFLUS) D ENADD^DIFG4
|
|---|
| 44 | K DIFGTYP,DIFGFLUS ;DIFGTYP exists due to DIFG3 not killing it if DIFGTYP="MV FIELD" - Needed in case one calls ENADD^DIFG4
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | CHANGEDA ;BACK DOWN ONE LEVEL DA'S, I.E. DA=DA(1),DA(1)=DA(2) ETC.
|
|---|
| 48 | S DA=DA(1)
|
|---|
| 49 | I DIFGMULT>1 F DIFGI=DIFGMULT:-1:2 S DA(DIFGI-1)=DA(DIFGI)
|
|---|
| 50 | K DA(DIFGMULT)
|
|---|
| 51 | S DIFGMULT=DIFGMULT-1
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
