DIFG0B.m

DIFG0B ;SFISC/DG(OHPRD)-PROCESS BASEFILE ;Jan 05, 2015

 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 ;;Per VA Directive 6402, this routine should not be modified.

 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 ;;Licensed under the terms of the Apache License, Version 2.0.

 ;

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

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DIFG0B   1381     printed  Apr 09, 2024@21:49:37                                                                                                                                                                                                      Page 2

DIFG0B    ;SFISC/DG(OHPRD)-PROCESS BASEFILE ;Jan 05, 2015

 +1       ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 +4       ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 +5       ;;Licensed under the terms of the Apache License, Version 2.0.

 +6       ;

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       ;