DIFG0A.m

DIFG0A ;SFISC/DG(OHPRD)-CALLED FOR CONTEXT SWITCH ;6/5/92  12:32 PM [ 04/02/2003   8:25 AM ]

 ;;22.0;VA FileMan;**1001**;APR 1, 2003

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

 ;THIS ROUTINE CONTAINS AN IHS MODIFICATION BY IHS/TUCSON/LAB 3/13/96

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

SWITCH ;CONTEXT SWITCH

 N DIC,DIFGM,DIFGNDC,DA,DIFGINCR,DIFGSKIP,DIFGDI,DIFGMO,DIFGPOIN

 S DIFG=DIFG+1,(DIFGNDC,DIFGLAGO)=0

 S DIFGTYPE="FILE"

 D BASE^DIFG0

 I DIFGER G X1

 D FUNC^DIFG0

 I '$D(DIFG("NOLKUP")) D BEGEND

 I DIFGER G X1

 D SET

 D KILLVAR0

 D FILE^DIFG

 S DIFG=DIFG-1

 D KILLVAR

X1 Q

 ;

BEGEND ;CALL DIFG3 TO PROCESS BEGIN-END BLOCK

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

 D ^DIFG3

 Q

 ;

SET ;

 I '$D(DIFGSKIP(DIFGMULT)),$D(^UTILITY("DIFG",$J,DIFGINCR,DIC)),'$D(^(DIC,"DA")) S ^UTILITY("DIFG",$J,DIFGINCR,DIC,"DA")=+Y,^("DR")=""

 I $D(DIFGSKIP(DIFGMULT)) S ^UTILITY("DIFG",$J,DIFGINCR,DIC,"DA")=DIFGALNK S:'$D(DIFGFLUS) ^("X")=$S($E(X)="`":$E(X,2,245)_"^N",X[("^UTILITY(""DIFG@"","_$J):X_"^N",1:X)

 I $D(DIFGFLUS),$P(DIFGMO(DIFGMULT),U)="L" S $P(^UTILITY("DIFG",$J,DIFGINCR,DIC,"MODE"),U)="M"

 S ^UTILITY("DIFG",$J,DIFGINCR,DIC,"GL")=^DIC(DIC,0,"GL"),(DA,DIFGDA(0))=DIFGALNK I $D(^("DIC(""DR"")")) S ^("MODE")="A"_"^"_$P(^("MODE"),U,2)

X2 K DIFGFLUS Q

 ;

KILLVAR0 ;KILL VARIABLES AFTER LOOKUP FOR FILE ON THE WAY TO FIELDS

 K DIFGALNK,DIFGO(DIFGMULT),DIFGFLD,DIFGPC,DIFGVAL,DIFGDOL,DIFGNUMF,DIFGNOLK,DIFGLAGO,Y,DIFG("NOLKUP")

 Q

 ;

KILLVAR ;KILL VARIABLES AFTER EACH CONTEXT SWITCH

 ;----- BEGIN IHS MODIFICATION

 ;THE LINE BELOW IS COMMENTED OUT AND REPLACED BY THE NEXT TWO LINES

 ;THE 2ND PIECE OF DIFGMO(DIFGMULT) IS SOMETIMES NULL, CAUSING A

 ;SUBSCRIPT ERROR IN FILEGRAM INSTALLS. ORIGINAL MODIFICATION BY

 ;IHS/TUCSON/LAB 3/13/96

 ;K DIFGDA,DIFGDIC,DIFGDOL,DIFGFIND,DIFGFIRP,DIFGFLDN,DIFGHAT,DIFGMLND,DIFGNODE,DIFGNUM,DIFGNUMF,DIFGPC,DIFGPTER,DIFGSECP,DIFGSTRT,DIFGVAL,DIFGNDC,DIFGM,DIFGFLD,DIFGNOLK($P(DIFGMO(DIFGMULT),U,2)),DIFGDIC,DIFGSAVE,DIFGSVVL

 K DIFGDA,DIFGDIC,DIFGDOL,DIFGFIND,DIFGFIRP,DIFGFLDN,DIFGHAT,DIFGMLND,DIFGNODE,DIFGNUM,DIFGNUMF,DIFGPC,DIFGPTER,DIFGSECP,DIFGSTRT,DIFGVAL,DIFGNDC,DIFGM,DIFGFLD,DIFGDIC,DIFGSAVE,DIFGSVVL

 K:$P($G(DIFGMO(DIFGMULT)),U,2)]"" DIFGMOLK($P(DIFGMO(DIFGMULT),U,2))

 ;----- END IHS MODIFICATION

 K DIFGSKIP

 Q

 ;

DIFG0A    ;SFISC/DG(OHPRD)-CALLED FOR CONTEXT SWITCH ;6/5/92  12:32 PM [ 04/02/2003   8:25 AM ]

 +1       ;;22.0;VA FileMan;**1001**;APR 1, 2003

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

 +3       ;THIS ROUTINE CONTAINS AN IHS MODIFICATION BY IHS/TUCSON/LAB 3/13/96

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

SWITCH    ;CONTEXT SWITCH

 +1        NEW DIC,DIFGM,DIFGNDC,DA,DIFGINCR,DIFGSKIP,DIFGDI,DIFGMO,DIFGPOIN

 +2        SET DIFG=DIFG+1

           SET (DIFGNDC,DIFGLAGO)=0

 +3        SET DIFGTYPE="FILE"

 +4        DO BASE^DIFG0

 +5        IF DIFGER

               GOTO X1

 +6        DO FUNC^DIFG0

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

               DO BEGEND

 +8        IF DIFGER

               GOTO X1

 +9        DO SET

 +10       DO KILLVAR0

 +11       DO FILE^DIFG

 +12       SET DIFG=DIFG-1

 +13       DO KILLVAR

X1         QUIT 

 +1       ;

BEGEND    ;CALL DIFG3 TO PROCESS BEGIN-END BLOCK

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

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

               IF DIFGSECP["P"

                   SET DIFGPOIN=""

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

                   SET DIFGLAGO=1

 +2        DO ^DIFG3

 +3        QUIT 

 +4       ;

SET       ;

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

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

                   IF '$DATA(^(DIC,"DA"))

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

                       SET ^("DR")=""

 +2        IF $DATA(DIFGSKIP(DIFGMULT))

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

               IF '$DATA(DIFGFLUS)

                   SET ^("X")=$SELECT($EXTRACT(X)="`":$EXTRACT(X,2,245)_"^N",X[("^UTILITY(""DIFG@"","_$JOB):X_"^N",1:X)

 +3        IF $DATA(DIFGFLUS)

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

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

 +4        SET ^UTILITY("DIFG",$JOB,DIFGINCR,DIC,"GL")=^DIC(DIC,0,"GL")

           SET (DA,DIFGDA(0))=DIFGALNK

           IF $DATA(^("DIC(""DR"")"))

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

X2         KILL DIFGFLUS

           QUIT 

 +1       ;

KILLVAR0  ;KILL VARIABLES AFTER LOOKUP FOR FILE ON THE WAY TO FIELDS

 +1        KILL DIFGALNK,DIFGO(DIFGMULT),DIFGFLD,DIFGPC,DIFGVAL,DIFGDOL,DIFGNUMF,DIFGNOLK,DIFGLAGO,Y,DIFG("NOLKUP")

 +2        QUIT 

 +3       ;

KILLVAR   ;KILL VARIABLES AFTER EACH CONTEXT SWITCH

 +1       ;----- BEGIN IHS MODIFICATION

 +2       ;THE LINE BELOW IS COMMENTED OUT AND REPLACED BY THE NEXT TWO LINES

 +3       ;THE 2ND PIECE OF DIFGMO(DIFGMULT) IS SOMETIMES NULL, CAUSING A

 +4       ;SUBSCRIPT ERROR IN FILEGRAM INSTALLS. ORIGINAL MODIFICATION BY

 +5       ;IHS/TUCSON/LAB 3/13/96

 +6       ;K DIFGDA,DIFGDIC,DIFGDOL,DIFGFIND,DIFGFIRP,DIFGFLDN,DIFGHAT,DIFGMLND,DIFGNODE,DIFGNUM,DIFGNUMF,DIFGPC,DIFGPTER,DIFGSECP,DIFGSTRT,DIFGVAL,DIFGNDC,DIFGM,DIFGFLD,DIFGNOLK($P(DIFGMO(DIFGMULT),U,2)),DIFGDIC,DIFGSAVE,DIFGSVVL

 +7        KILL DIFGDA,DIFGDIC,DIFGDOL,DIFGFIND,DIFGFIRP,DIFGFLDN,DIFGHAT,DIFGMLND,DIFGNODE,DIFGNUM,DIFGNUMF,DIFGPC,DIFGPTER,DIFGSECP,DIFGSTRT,DIFGVAL,DIFGNDC,DIFGM,DIFGFLD,DIFGDIC,DIFGSAVE,DIFGSVVL

 +8        IF $PIECE($GET(DIFGMO(DIFGMULT)),U,2)]""

               KILL DIFGMOLK($PIECE(DIFGMO(DIFGMULT),U,2))

 +9       ;----- END IHS MODIFICATION

 +10       KILL DIFGSKIP

 +11       QUIT 

 +12      ;