DIFG2.m

DIFG2 ;SFISC/DG(OHPRD)-PROCESSING OF MULTIPLES FROM FILEGRAM ; [ 02/02/93  4:21 PM ]

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

START ;CALLED BY DIFG

 S DIFG=DIFG+1

 I DIFGMULT=0 S DIFGNDC=0,DIFGM(0)=DIC ;ENTERING HIGHEST LEVEL MULTIPLE

 N DIC

 D MULT

 I DIFGER G X1

 I '$D(DIFG("NOLKUP")) D ^DIFG3 I 1

 E  D NOLOOK

 I DIFGER G X1

 D SET

 K DIFGALNK,DIFGMLND,DIFGPC,DIFGFLD,DIFGVAL,DIFGDOL,DIFGNUMF,DIFGNOLK,DIFGLAGO,Y,DIFG("NOLKUP"),DIFG("ACGRV"),DIFGDIC(DIFGDIC)

 D FILE^DIFG

 K DIFGSKIP(DIFGMULT) ;Going up one level so kill this variable which tells lower level multiples not to do lookup

 D CHANGEDA

 S DIFG=DIFG-1

X1 Q

 ;

MULT ;MULTIPLE FIELD LOOKUP AND CALL TO SET DR STRING FOR MULTIPLE

 I DIFGMULT=0 S DIFGMGBL(DIFGMULT)=$S(DIFGM(0):^DIC(DIFGM(0),0,"GL"),1:DIC),DIFGDA(DIFGMULT)=DA

 S DIFGNODE=$P($P(DIFGMLND,"^",4),";")

 S DIFGLAGO=0

 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

 S DIFGMULT=DIFGMULT+1

 I $D(DIFGSKIP(DIFGMULT-1)) S DIFGSKIP(DIFGMULT)=""

 S DIFGMGBL(DIFGMULT)=DIFGMGBL(DIFGMULT-1)_DIFGDA(DIFGMULT-1)_","_""""_DIFGNODE_""""_","

 S DIFGM(DIFGMULT)=DIFGNUM

 S DIC=DIFGNUM D BASE^DIFG0 Q:DIFGER  D FUNC^DIFG0

 Q

 ;

NOLOOK ;IF NO LOOKUP REQUIRED, SET DA ARRAY

 F DIFGI=DIFGMULT:-1:1 S DA(DIFGI)=$S(DIFGI=1:DA,1:DA(DIFGI-1))

 Q

 ;

SET ;

 I '$D(DIFGSKIP(DIFGMULT)) S (DA,DIFGDA(DIFGMULT))=+Y

 E  S (DA,DIFGDA(DIFGMULT))=DIFGALNK I '$D(DIFGFLUS) D

 . 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)

 S DIC=DIFGM(DIFGMULT)

 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)

 I $D(DIFGSKIP(DIFGMULT)),'$D(DIFGFLUS) D ENADD^DIFG4

 K DIFGTYP,DIFGFLUS ;DIFGTYP exists due to DIFG3 not killing it if DIFGTYP="MV FIELD" - Needed in case one calls ENADD^DIFG4

 Q

 ;

CHANGEDA ;BACK DOWN ONE LEVEL DA'S, I.E. DA=DA(1),DA(1)=DA(2) ETC.

 S DA=DA(1)

 I DIFGMULT>1 F DIFGI=DIFGMULT:-1:2 S DA(DIFGI-1)=DA(DIFGI)

 K DA(DIFGMULT)

 S DIFGMULT=DIFGMULT-1

 Q

 ;

DIFG2     ;SFISC/DG(OHPRD)-PROCESSING OF MULTIPLES FROM FILEGRAM ; [ 02/02/93  4:21 PM ]

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

START     ;CALLED BY DIFG

 +1        SET DIFG=DIFG+1

 +2       ;ENTERING HIGHEST LEVEL MULTIPLE

           IF DIFGMULT=0

               SET DIFGNDC=0

               SET DIFGM(0)=DIC

 +3        NEW DIC

 +4        DO MULT

 +5        IF DIFGER

               GOTO X1

 +6        IF '$DATA(DIFG("NOLKUP"))

               DO ^DIFG3

               IF 1

 +7       IF '$TEST

               DO NOLOOK

 +8        IF DIFGER

               GOTO X1

 +9        DO SET

 +10       KILL DIFGALNK,DIFGMLND,DIFGPC,DIFGFLD,DIFGVAL,DIFGDOL,DIFGNUMF,DIFGNOLK,DIFGLAGO,Y,DIFG("NOLKUP"),DIFG("ACGRV"),DIFGDIC(DIFGDIC)

 +11       DO FILE^DIFG

 +12      ;Going up one level so kill this variable which tells lower level multiples not to do lookup

           KILL DIFGSKIP(DIFGMULT)

 +13       DO CHANGEDA

 +14       SET DIFG=DIFG-1

X1         QUIT 

 +1       ;

MULT      ;MULTIPLE FIELD LOOKUP AND CALL TO SET DR STRING FOR MULTIPLE

 +1        IF DIFGMULT=0

               SET DIFGMGBL(DIFGMULT)=$SELECT(DIFGM(0):^DIC(DIFGM(0),0,"GL"),1:DIC)

               SET DIFGDA(DIFGMULT)=DA

 +2        SET DIFGNODE=$PIECE($PIECE(DIFGMLND,"^",4),";")

 +3        SET DIFGLAGO=0

 +4       ;Not a ptr or a ptr and laygo allowed

           IF $PIECE(^DD(DIFGNUM,.01,0),U,2)'["'"!($DATA(DIFGENV("LAYGO",DIFGNUM,.01)))

               SET DIFGLAGO=1

 +5        SET DIFGMULT=DIFGMULT+1

 +6        IF $DATA(DIFGSKIP(DIFGMULT-1))

               SET DIFGSKIP(DIFGMULT)=""

 +7        SET DIFGMGBL(DIFGMULT)=DIFGMGBL(DIFGMULT-1)_DIFGDA(DIFGMULT-1)_","_""""_DIFGNODE_""""_","

 +8        SET DIFGM(DIFGMULT)=DIFGNUM

 +9        SET DIC=DIFGNUM

           DO BASE^DIFG0

           IF DIFGER

               QUIT 

           DO FUNC^DIFG0

 +10       QUIT 

 +11      ;

NOLOOK    ;IF NO LOOKUP REQUIRED, SET DA ARRAY

 +1        FOR DIFGI=DIFGMULT:-1:1

               SET DA(DIFGI)=$SELECT(DIFGI=1:DA,1:DA(DIFGI-1))

 +2        QUIT 

 +3       ;

SET       ;

 +1        IF '$DATA(DIFGSKIP(DIFGMULT))

               SET (DA,DIFGDA(DIFGMULT))=+Y

 +2       IF '$TEST

               SET (DA,DIFGDA(DIFGMULT))=DIFGALNK

               IF '$DATA(DIFGFLUS)

                   Begin DoDot:1

 +3                    SET ^UTILITY("DIFG",$JOB,DIFGINCR,DIC,"X")=$SELECT($EXTRACT(X)="`":$EXTRACT(X,2,245)_"^N",($DATA(DIFG("ACGRV"))!(X[("^UTILITY(""DIFG@"","_$JOB))):X_"^N",1:X_"^")

                       SET ^("MODE")="A"_"^"_$PIECE(^("MODE"),U,2)

                       SET ^("DIC(""P"")")=$PIECE(DIFGMLND,U,2)

                   End DoDot:1

 +4        SET DIC=DIFGM(DIFGMULT)

 +5        SET ^UTILITY("DIFG",$JOB,DIFGINCR,DIC,"DA")=DA

           SET ^("GL")=DIFGMGBL(DIFGMULT)

           SET ^($SELECT($DATA(DIFGSKIP(DIFGMULT))&('$DATA(DIFGFLUS)):"DIC(""DR"")",1:"DR"))=""

           FOR DIFGI=1:1:DIFGMULT

               SET ^("DA("_DIFGI_")")=DA(DIFGI)

 +6        IF $DATA(DIFGSKIP(DIFGMULT))

               IF '$DATA(DIFGFLUS)

                   DO ENADD^DIFG4

 +7       ;DIFGTYP exists due to DIFG3 not killing it if DIFGTYP="MV FIELD" - Needed in case one calls ENADD^DIFG4

           KILL DIFGTYP,DIFGFLUS

 +8        QUIT 

 +9       ;

CHANGEDA  ;BACK DOWN ONE LEVEL DA'S, I.E. DA=DA(1),DA(1)=DA(2) ETC.

 +1        SET DA=DA(1)

 +2        IF DIFGMULT>1

               FOR DIFGI=DIFGMULT:-1:2

                   SET DA(DIFGI-1)=DA(DIFGI)

 +3        KILL DA(DIFGMULT)

 +4        SET DIFGMULT=DIFGMULT-1

 +5        QUIT 

 +6       ;