DIFG0B.m

DIFG0B ;SFISC/DG(OHPRD)-PROCESS BASEFILE ;

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

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

 ;

BASEFILE ;

 S DIFGTYPE="FILE"

 D BASE^DIFG0 G:DIFGER X2 D FUNC^DIFG0

 S DIFGLAGO=0

 I $P(DIFGMO(DIFGMULT),U)="L",$D(DINUM),$D(@(^DIC(DIC,0,"GL")_"DINUM)")) S $P(^UTILITY("DIFG",$J,DIFGINCR,DIC,"MODE"),U)="M",$P(DIFGMO(DIFGMULT),U)="M"

 E  I "AL"[$P(DIFGMO(DIFGMULT),U) S DIFGSECP=$P(^DD(DIC,.01,0),U,2) I DIFGSECP'["'"!($D(DIFGENV("LAYGO",DIC,.01))) S DIFGLAGO=1

 I $D(DINUM),$P(^DD(DIC,.01,0),U,5,99)["DINUM","MD"'[$P(DIFGMO(DIFGMULT),U) S DIFGER=7_U_DIFGY D ERROR^DIFG G X2

 I $D(DINUM) S ^UTILITY("DIFG",$J,DIFGINCR,DIC,$S("MD"[$P(DIFGMO(DIFGMULT),U):"DA",1:"DINUM"))=DINUM

 I $D(DIADD) S:"AL"'[$P(DIFGMO(DIFGMULT),U) DIFGER=8_U_DIFGY D:DIFGER ERROR^DIFG I 'DIFGER S $P(DIFGMO(DIFGMULT),U)="A",$P(^UTILITY("DIFG",$J,DIFGINCR,DIC,"MODE"),U)="A"

 K DIADD,DINUM

 I DIFGER G X2

 S:$D(^UTILITY("DIFG",$J,DIFGINCR,DIC,"DA")) DIFGDINM="" D ^DIFG3

 I DIFGER G X2

 K DIFGLAGO

 D SET^DIFG0A

 D KILLVAR0^DIFG0A

 S DIFGBSE=^UTILITY("DIFG",$J,DIFGINCR,DIC,"DA")_"^"_DIC_$S(^("MODE")["A":"^1",1:"")

X2 Q

 ;

DIFG0B    ;SFISC/DG(OHPRD)-PROCESS BASEFILE ;

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

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

 +3       ;

BASEFILE  ;

 +1        SET DIFGTYPE="FILE"

 +2        DO BASE^DIFG0

           IF DIFGER

               GOTO X2

           DO FUNC^DIFG0

 +3        SET DIFGLAGO=0

 +4        IF $PIECE(DIFGMO(DIFGMULT),U)="L"

               IF $DATA(DINUM)

                   IF $DATA(@(^DIC(DIC,0,"GL")_"DINUM)"))

                       SET $PIECE(^UTILITY("DIFG",$JOB,DIFGINCR,DIC,"MODE"),U)="M"

                       SET $PIECE(DIFGMO(DIFGMULT),U)="M"

 +5       IF '$TEST

               IF "AL"[$PIECE(DIFGMO(DIFGMULT),U)

                   SET DIFGSECP=$PIECE(^DD(DIC,.01,0),U,2)

                   IF DIFGSECP'["'"!($DATA(DIFGENV("LAYGO",DIC,.01)))

                       SET DIFGLAGO=1

 +6        IF $DATA(DINUM)

               IF $PIECE(^DD(DIC,.01,0),U,5,99)["DINUM"

                   IF "MD"'[$PIECE(DIFGMO(DIFGMULT),U)

                       SET DIFGER=7_U_DIFGY

                       DO ERROR^DIFG

                       GOTO X2

 +7        IF $DATA(DINUM)

               SET ^UTILITY("DIFG",$JOB,DIFGINCR,DIC,$SELECT("MD"[$PIECE(DIFGMO(DIFGMULT),U):"DA",1:"DINUM"))=DINUM

 +8        IF $DATA(DIADD)

               IF "AL"'[$PIECE(DIFGMO(DIFGMULT),U)

                   SET DIFGER=8_U_DIFGY

               IF DIFGER

                   DO ERROR^DIFG

               IF 'DIFGER

                   SET $PIECE(DIFGMO(DIFGMULT),U)="A"

                   SET $PIECE(^UTILITY("DIFG",$JOB,DIFGINCR,DIC,"MODE"),U)="A"

 +9        KILL DIADD,DINUM

 +10       IF DIFGER

               GOTO X2

 +11       IF $DATA(^UTILITY("DIFG",$JOB,DIFGINCR,DIC,"DA"))

               SET DIFGDINM=""

           DO ^DIFG3

 +12       IF DIFGER

               GOTO X2

 +13       KILL DIFGLAGO

 +14       DO SET^DIFG0A

 +15       DO KILLVAR0^DIFG0A

 +16       SET DIFGBSE=^UTILITY("DIFG",$JOB,DIFGINCR,DIC,"DA")_"^"_DIC_$SELECT(^("MODE")["A":"^1",1:"")

X2         QUIT 

 +1       ;