- DIFG6 ;SFISC/DG(OHPRD)-UPDATE FILES ;2/3/93 12:23 PM
- ;;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.
- ;
- START ;
- S DIFGORDR=0
- F DIFGL=0:0 S DIFGORDR=$O(^UTILITY("DIFG",$J,DIFGORDR)) Q:DIFGORDR=""!(DIFGER) D SETVAR D:'$D(DIFGNODL) PROCESS K DIFGNODL
- D EOJ
- Q
- ;
- SETVAR ;SET UP VARIABLES FOR DI* CALLS FOR A GIVEN ENTRY IN ^UTILITY("DIFG",$J,...)
- S DIFGFILE=$O(^UTILITY("DIFG",$J,DIFGORDR,0))
- S DIFGMODE=$P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"MODE"),U)
- I DIFGMODE="D",^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DA")=-1 S DIFGNODL="" G X3
- I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"X")) S:^("X")["^UTILITY" ^("X")="~"_$E(^("X"),2,$L(^("X"))) S X=$S($P(^("X"),U,2)'="N"!(+^("X")):$P(^("X"),U),1:@($TR($P(^("X"),U),"~","^")))
- I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DA(1)")) F DIFGI=1:1 Q:'$D(^("DA("_DIFGI_")")) S @("DA("_DIFGI_")="_^("DA("_DIFGI_")"))
- I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DIC(""P"")")) S DIC("P")=^("DIC(""P"")") ;Exists if a multiple and calling DIC to add
- I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DIC(""DR"")")) S DIC("DR")=^("DIC(""DR"")")
- ;I $D(DIC("DR")) S DIFGZRO=0 F DIFGL=0:0 S DIFGZRO=$O(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DIC(""DR"")",DIFGZRO)) Q:'DIFGZRO S DIC("DR"
- X3 Q
- ;
- PROCESS ;DETERMINE WHICH DI* ROUTINE(S) TO CALL FOR A GIVEN ENTRY
- I DIFGMODE="A" S DIC=^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"GL") D CALLDIC^DIFG7 S:'DIFGER DIFGAVAL=+Y D:'DIFGER ADDCONT G X1
- D BUILDDR
- S DIE=^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"GL"),@("DA="_^("DA")) I $D(DR),DR]"" D CALLDIE^DIFG7 I $D(Y) S DIFGER=14_U_$P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"MODE"),U,2) D ERROR^DIFG G X1
- I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"WP")) D WP^DIFG7 I $D(Y) S DIFGER=17_"^"_$P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"MODE"),U,2) D ERROR^DIFG G X1
- I DIFGMODE="D",'DIFGER S DIK=DIE D CALLDIK^DIFG7
- I 'DIFGER S $P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DA"),"^",2)="I"
- X1 K DIC,DIE,DIK,DA,DR,DIFGAVAL
- Q
- ;
- ADDCONT ;CONTINUATION OF MODE="A" PROCESSING UPON RETURN FROM ^DIC
- S DA=DIFGAVAL,DIE=DIC
- I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"WP")) D WP^DIFG7 I $D(Y) S DIK=DIE,@(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DA"))="" D CALLDIK^DIFG7 S DIFGER=17_"^"_$P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"MODE"),U,2)_"^I" D ERROR^DIFG G X1
- D BUILDDR
- I $D(DR),DR]"" S DA=DIFGAVAL D CALLDIE^DIFG7 I $D(Y) S DIK=DIE,@(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DA"))="" D CALLDIK^DIFG7 S DIFGER=15_U_$P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"MODE"),U,2) D ERROR^DIFG
- I 'DIFGER S @(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DA"))=DIFGAVAL,^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DA")=DIFGAVAL_"^I" D RESET
- Q
- ;
- BUILDDR ;SET DR (BUILD DR ARRAY IF APPROPRIATE)
- I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DR")) S DR=^("DR")
- I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DR"))=11 S DIFGZRO=0 F DIFGL=0:0 S DIFGZRO=$O(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DR",DIFGZRO)) Q:'DIFGZRO S DR(1,DIFGFILE,DIFGZRO)=^(DIFGZRO)
- Q
- ;
- RESET ;RESETS MODE INDICATOR IN FILEGRAM FROM "A" TO "M"
- I DIFGORDR'<1 S DIFGTMP=DIFGLO_$P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"MODE"),U,2)_",0)",DIFGVL0=@DIFGTMP,DIFGVL1=$P(DIFGVL0,"="),DIFGVL2=$P(DIFGVL0,"=",2,3),$P(DIFGVL1,U,3)="M"
- E G X2
- S DIFGTMP="^UTILITY(""DIFGFG"",$J,$P(^UTILITY(""DIFG"",$J,DIFGORDR,DIFGFILE,""MODE""),U,2))"
- S @(DIFGTMP_"=DIFGVL1_""=""_DIFGVL2")
- ;
- X2 Q
- ;
- EOJ K DIFGI,DIFGORDR,DIFGFILE,DIFGMODE,DIFGTMP,DIFGVL0,DIFGVL1,DIFGVL2,DIFGDRVL,DIFGDRPT,DIFGZRO
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIFG6 3724 printed Feb 19, 2025@00:13:57 Page 2
- DIFG6 ;SFISC/DG(OHPRD)-UPDATE FILES ;2/3/93 12:23 PM
- +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 ;
- START ;
- +1 SET DIFGORDR=0
- +2 FOR DIFGL=0:0
- SET DIFGORDR=$ORDER(^UTILITY("DIFG",$JOB,DIFGORDR))
- if DIFGORDR=""!(DIFGER)
- QUIT
- DO SETVAR
- if '$DATA(DIFGNODL)
- DO PROCESS
- KILL DIFGNODL
- +3 DO EOJ
- +4 QUIT
- +5 ;
- SETVAR ;SET UP VARIABLES FOR DI* CALLS FOR A GIVEN ENTRY IN ^UTILITY("DIFG",$J,...)
- +1 SET DIFGFILE=$ORDER(^UTILITY("DIFG",$JOB,DIFGORDR,0))
- +2 SET DIFGMODE=$PIECE(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"MODE"),U)
- +3 IF DIFGMODE="D"
- IF ^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"DA")=-1
- SET DIFGNODL=""
- GOTO X3
- +4 IF $DATA(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"X"))
- if ^("X")["^UTILITY"
- SET ^("X")="~"_$EXTRACT(^("X"),2,$LENGTH(^("X")))
- SET X=$SELECT($PIECE(^("X"),U,2)'="N"!(+^("X")):$PIECE(^("X"),U),1:@($TRANSLATE($PIECE(^("X"),U),"~","^")))
- +5 IF $DATA(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"DA(1)"))
- FOR DIFGI=1:1
- if '$DATA(^("DA("_DIFGI_")"))
- QUIT
- SET @("DA("_DIFGI_")="_^("DA("_DIFGI_")"))
- +6 ;Exists if a multiple and calling DIC to add
- IF $DATA(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"DIC(""P"")"))
- SET DIC("P")=^("DIC(""P"")")
- +7 IF $DATA(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"DIC(""DR"")"))
- SET DIC("DR")=^("DIC(""DR"")")
- +8 ;I $D(DIC("DR")) S DIFGZRO=0 F DIFGL=0:0 S DIFGZRO=$O(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DIC(""DR"")",DIFGZRO)) Q:'DIFGZRO S DIC("DR"
- X3 QUIT
- +1 ;
- PROCESS ;DETERMINE WHICH DI* ROUTINE(S) TO CALL FOR A GIVEN ENTRY
- +1 IF DIFGMODE="A"
- SET DIC=^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"GL")
- DO CALLDIC^DIFG7
- if 'DIFGER
- SET DIFGAVAL=+Y
- if 'DIFGER
- DO ADDCONT
- GOTO X1
- +2 DO BUILDDR
- +3 SET DIE=^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"GL")
- SET @("DA="_^("DA"))
- IF $DATA(DR)
- IF DR]""
- DO CALLDIE^DIFG7
- IF $DATA(Y)
- SET DIFGER=14_U_$PIECE(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"MODE"),U,2)
- DO ERROR^DIFG
- GOTO X1
- +4 IF $DATA(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"WP"))
- DO WP^DIFG7
- IF $DATA(Y)
- SET DIFGER=17_"^"_$PIECE(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"MODE"),U,2)
- DO ERROR^DIFG
- GOTO X1
- +5 IF DIFGMODE="D"
- IF 'DIFGER
- SET DIK=DIE
- DO CALLDIK^DIFG7
- +6 IF 'DIFGER
- SET $PIECE(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"DA"),"^",2)="I"
- X1 KILL DIC,DIE,DIK,DA,DR,DIFGAVAL
- +1 QUIT
- +2 ;
- ADDCONT ;CONTINUATION OF MODE="A" PROCESSING UPON RETURN FROM ^DIC
- +1 SET DA=DIFGAVAL
- SET DIE=DIC
- +2 IF $DATA(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"WP"))
- DO WP^DIFG7
- IF $DATA(Y)
- SET DIK=DIE
- SET @(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"DA"))=""
- DO CALLDIK^DIFG7
- SET DIFGER=17_"^"_$PIECE(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"MODE"),U,2)_"^I"
- DO ERROR^DIFG
- GOTO X1
- +3 DO BUILDDR
- +4 IF $DATA(DR)
- IF DR]""
- SET DA=DIFGAVAL
- DO CALLDIE^DIFG7
- IF $DATA(Y)
- SET DIK=DIE
- SET @(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"DA"))=""
- DO CALLDIK^DIFG7
- SET DIFGER=15_U_$PIECE(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"MODE"),U,2)
- DO ERROR^DIFG
- +5 IF 'DIFGER
- SET @(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"DA"))=DIFGAVAL
- SET ^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"DA")=DIFGAVAL_"^I"
- DO RESET
- +6 QUIT
- +7 ;
- BUILDDR ;SET DR (BUILD DR ARRAY IF APPROPRIATE)
- +1 IF $DATA(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"DR"))
- SET DR=^("DR")
- +2 IF $DATA(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"DR"))=11
- SET DIFGZRO=0
- FOR DIFGL=0:0
- SET DIFGZRO=$ORDER(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"DR",DIFGZRO))
- if 'DIFGZRO
- QUIT
- SET DR(1,DIFGFILE,DIFGZRO)=^(DIFGZRO)
- +3 QUIT
- +4 ;
- RESET ;RESETS MODE INDICATOR IN FILEGRAM FROM "A" TO "M"
- +1 IF DIFGORDR'<1
- SET DIFGTMP=DIFGLO_$PIECE(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"MODE"),U,2)_",0)"
- SET DIFGVL0=@DIFGTMP
- SET DIFGVL1=$PIECE(DIFGVL0,"=")
- SET DIFGVL2=$PIECE(DIFGVL0,"=",2,3)
- SET $PIECE(DIFGVL1,U,3)="M"
- +2 IF '$TEST
- GOTO X2
- +3 SET DIFGTMP="^UTILITY(""DIFGFG"",$J,$P(^UTILITY(""DIFG"",$J,DIFGORDR,DIFGFILE,""MODE""),U,2))"
- +4 SET @(DIFGTMP_"=DIFGVL1_""=""_DIFGVL2")
- +5 ;
- X2 QUIT
- +1 ;
- EOJ KILL DIFGI,DIFGORDR,DIFGFILE,DIFGMODE,DIFGTMP,DIFGVL0,DIFGVL1,DIFGVL2,DIFGDRVL,DIFGDRPT,DIFGZRO
- +1 QUIT
