DIFG4 ;SFISC/DG(OHPRD)-HANDLES FAILED IDENTIFIER, SPECIFIER, AND FIELD LOOKUPS ;07/15/91 1:30 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 ;
I DIFGTYP="FILE"!(DIFGTYP="MV FIELD") S DIFGPARM=$P(DIFGMO(DIFGMULT),U) I "DM"[DIFGPARM S DIFGER=9_U_DIFGY D ERROR^DIFG G X1
I DIFGTYP="MV FIELD" G X1 ;Call ENADD^DIFG4 from SET^DIFG2 if a MV FIELD
I DIFGTYP="",'DIFGLAGO,'$D(DIFGCOND) S DIFGER=10_U_DIFGY D ERROR^DIFG G X1
I DIFGTYP="",DIFGLAGO,$D(DIFG("CONDSET")),'$D(DIFGCOND) S DIFGER=24_U_DIFGY D ERROR^DIFG G X1
I DIFGTYP="",DIFGLAGO,'$D(DIFG("CONDSET"))
I DIFGTYP="",'DIFGLAGO,$D(DIFGCOND) D ^DIFG4A G X1
I DIFGTYP="SV FIELD",'DIFGLAGO,'$D(DIFGCOND(DIFG,DIFGDIC)) S DIFGER=11_U_DIFGY D ERROR^DIFG G X1 ;END for the BEGIN-END block for a SV FIELD; must have laygo to the pointed to file from the field allowed OR conditional
I DIFGTYP="SV FIELD",DIFGLAGO,$D(DIFG("CONDSET")),'$D(DIFGCOND(DIFG,DIFGDIC)) S DIFGER=24_U_DIFGY D ERROR^DIFG G X1
I DIFGTYP="SV FIELD",DIFGLAGO,'$D(DIFG("CONDSET"))
E I DIFGTYP="SV FIELD",'DIFGLAGO D ^DIFG4A G X1
D ENADD
I $D(DIFGSVN) S DIFGADD=DIFGSVN K DIFGSVN
X1 K %,DIFGPARM,DIFGADFL Q
;
ENADD ;
I DIFGTYP]"",DIFGTYP'="SV FIELD" S DIFGSVN=DIFGADD,DIFGADD=DIFGINCR,DIFGSKIP(DIFGMULT)=""
E S DIFGADD=DIFGADD+.0001
I DIFGTYP'="MV FIELD",DIFGTYP'="FILE" D ENADD2
I $D(DIFGKEY),DIFGFIRP="KEY" S ^UTILITY("DIFG",$J,DIFGADD,DIFGDIC,"DIC(""DR"")")=$S(DIFG("PARAM")["N":+$P(DIFGDIX,U,2),1:$O(^DD(DIC,"B",$P(DIFGDIX,U),"")))_"////"_$P(DIFGDIX,"=",2) G X3
I '$D(^UTILITY("DIFG",$J,DIFGADD,DIFGDIC,"DIC(""DR"")")) S ^("DIC(""DR"")")=""
S DIFGDRCT=0 F DIFGI=1:1 Q:'$D(DIFGDIC(DIFGDIC,DIFGI)) S DIFGDIGT=+$P(DIFGDIC(DIFGDIC,DIFGI),"DIFGPC(",2) D:$D(DIFGNUMF(DIFGDIGT)) DICDR
K DIFGDR,DIFGDRT,DIFGDRVL,DIFGDIGT,DIFGDRCT
X3 Q
;
ENADD2 ;SET VARS IF NOT MV FIELD OR FILE
S ^UTILITY("DIFG",$J,DIFGADD,DIFGDIC,"DA")="^UTILITY(""DIFG@"","_$J_","""_DIFGSAVE(DIFG,"@NUM")_""")",^("X")=$S($E(X)="`":$E(X,2,245)_"^N",(X["DIFG(""@")!($D(DIFG("ACGRV"))):X_"^N",1:X)
S ^UTILITY("DIFG",$J,DIFGADD,DIFGDIC,"GL")=^DIC(DIFGDIC,0,"GL"),^("MODE")="A"_"^"_DIFGY
Q
;
DICDR ;SAVE FLD NUMBERS AND VALUES IN DIC("DR")
I DIFGSVVL(DIFGDIGT)[("^UTILITY(""DIFG@"","_$J) S DIFGDRVL=$S(+@DIFGSVVL(DIFGDIGT):"/"_@DIFGSVVL(DIFGDIGT),1:"^S X="_"""`""_"_DIFGSVVL(DIFGDIGT))
E S DIFGDRVL="/"_DIFGSVVL(DIFGDIGT)
I '$D(^UTILITY("DIFG",$J,DIFGADD,DIFGDIC,"DIC(""DR"")")) S ^("DIC(""DR"")")=""
I $L(^UTILITY("DIFG",$J,DIFGADD,DIFGDIC,"DIC(""DR"")"))+$L(DIFGNUMF(DIFGDIGT)_"///"_DIFGDRVL_";")<241 S ^("DIC(""DR"")")=^("DIC(""DR"")")_DIFGNUMF(DIFGDIGT)_"///"_DIFGDRVL_";" G X2
I $D(^UTILITY("DIFG",$J,DIFGADD,DIFGDIC,"DIC(""DR"")",DIFGDRCT)),$L(^(DIFGDRCT))+$L(DIFGNUMF(DIFGDIGT)_"///"_DIFGDRVL_";")<241 S ^(DIFGDRCT)=^(DIFGDRCT)_DIFGNUMF(DIFGDIGT)_"///"_DIFGDRVL_";"
E S DIFGDRCT=DIFGDRCT+1,^UTILITY("DIFG",$J,DIFGADD,DIFGDIC,"DIC(""DR"")",DIFGDRCT)=DIFGNUMF(DIFGDIGT)_"///"_DIFGDRVL_";"
X2 K DIFGDRVL
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIFG4 3233 printed Oct 16, 2024@18:48:13 Page 2
DIFG4 ;SFISC/DG(OHPRD)-HANDLES FAILED IDENTIFIER, SPECIFIER, AND FIELD LOOKUPS ;07/15/91 1:30 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 IF DIFGTYP="FILE"!(DIFGTYP="MV FIELD")
SET DIFGPARM=$PIECE(DIFGMO(DIFGMULT),U)
IF "DM"[DIFGPARM
SET DIFGER=9_U_DIFGY
DO ERROR^DIFG
GOTO X1
+2 ;Call ENADD^DIFG4 from SET^DIFG2 if a MV FIELD
IF DIFGTYP="MV FIELD"
GOTO X1
+3 IF DIFGTYP=""
IF 'DIFGLAGO
IF '$DATA(DIFGCOND)
SET DIFGER=10_U_DIFGY
DO ERROR^DIFG
GOTO X1
+4 IF DIFGTYP=""
IF DIFGLAGO
IF $DATA(DIFG("CONDSET"))
IF '$DATA(DIFGCOND)
SET DIFGER=24_U_DIFGY
DO ERROR^DIFG
GOTO X1
+5 IF DIFGTYP=""
IF DIFGLAGO
IF '$DATA(DIFG("CONDSET"))
+6 IF DIFGTYP=""
IF 'DIFGLAGO
IF $DATA(DIFGCOND)
DO ^DIFG4A
GOTO X1
+7 ;END for the BEGIN-END block for a SV FIELD; must have laygo to the pointed to file from the field allowed OR conditional
IF DIFGTYP="SV FIELD"
IF 'DIFGLAGO
IF '$DATA(DIFGCOND(DIFG,DIFGDIC))
SET DIFGER=11_U_DIFGY
DO ERROR^DIFG
GOTO X1
+8 IF DIFGTYP="SV FIELD"
IF DIFGLAGO
IF $DATA(DIFG("CONDSET"))
IF '$DATA(DIFGCOND(DIFG,DIFGDIC))
SET DIFGER=24_U_DIFGY
DO ERROR^DIFG
GOTO X1
+9 IF DIFGTYP="SV FIELD"
IF DIFGLAGO
IF '$DATA(DIFG("CONDSET"))
+10 IF '$TEST
IF DIFGTYP="SV FIELD"
IF 'DIFGLAGO
DO ^DIFG4A
GOTO X1
+11 DO ENADD
+12 IF $DATA(DIFGSVN)
SET DIFGADD=DIFGSVN
KILL DIFGSVN
X1 KILL %,DIFGPARM,DIFGADFL
QUIT
+1 ;
ENADD ;
+1 IF DIFGTYP]""
IF DIFGTYP'="SV FIELD"
SET DIFGSVN=DIFGADD
SET DIFGADD=DIFGINCR
SET DIFGSKIP(DIFGMULT)=""
+2 IF '$TEST
SET DIFGADD=DIFGADD+.0001
+3 IF DIFGTYP'="MV FIELD"
IF DIFGTYP'="FILE"
DO ENADD2
+4 IF $DATA(DIFGKEY)
IF DIFGFIRP="KEY"
SET ^UTILITY("DIFG",$JOB,DIFGADD,DIFGDIC,"DIC(""DR"")")=$SELECT(DIFG("PARAM")["N":+$PIECE(DIFGDIX,U,2),1:$ORDER(^DD(DIC,"B",$PIECE(DIFGDIX,U),"")))_"////"_$PIECE(DIFGDIX,"=",2)
GOTO X3
+5 IF '$DATA(^UTILITY("DIFG",$JOB,DIFGADD,DIFGDIC,"DIC(""DR"")"))
SET ^("DIC(""DR"")")=""
+6 SET DIFGDRCT=0
FOR DIFGI=1:1
if '$DATA(DIFGDIC(DIFGDIC,DIFGI))
QUIT
SET DIFGDIGT=+$PIECE(DIFGDIC(DIFGDIC,DIFGI),"DIFGPC(",2)
if $DATA(DIFGNUMF(DIFGDIGT))
DO DICDR
+7 KILL DIFGDR,DIFGDRT,DIFGDRVL,DIFGDIGT,DIFGDRCT
X3 QUIT
+1 ;
ENADD2 ;SET VARS IF NOT MV FIELD OR FILE
+1 SET ^UTILITY("DIFG",$JOB,DIFGADD,DIFGDIC,"DA")="^UTILITY(""DIFG@"","_$JOB_","""_DIFGSAVE(DIFG,"@NUM")_""")"
SET ^("X")=$SELECT($EXTRACT(X)="`":$EXTRACT(X,2,245)_"^N",(X["DIFG(""@")!($DATA(DIFG("ACGRV"))):X_"^N",1:X)
+2 SET ^UTILITY("DIFG",$JOB,DIFGADD,DIFGDIC,"GL")=^DIC(DIFGDIC,0,"GL")
SET ^("MODE")="A"_"^"_DIFGY
+3 QUIT
+4 ;
DICDR ;SAVE FLD NUMBERS AND VALUES IN DIC("DR")
+1 IF DIFGSVVL(DIFGDIGT)[("^UTILITY(""DIFG@"","_$JOB)
SET DIFGDRVL=$SELECT(+@DIFGSVVL(DIFGDIGT):"/"_@DIFGSVVL(DIFGDIGT),1:"^S X="_"""`""_"_DIFGSVVL(DIFGDIGT))
+2 IF '$TEST
SET DIFGDRVL="/"_DIFGSVVL(DIFGDIGT)
+3 IF '$DATA(^UTILITY("DIFG",$JOB,DIFGADD,DIFGDIC,"DIC(""DR"")"))
SET ^("DIC(""DR"")")=""
+4 IF $LENGTH(^UTILITY("DIFG",$JOB,DIFGADD,DIFGDIC,"DIC(""DR"")"))+$LENGTH(DIFGNUMF(DIFGDIGT)_"///"_DIFGDRVL_";")<241
SET ^("DIC(""DR"")")=^("DIC(""DR"")")_DIFGNUMF(DIFGDIGT)_"///"_DIFGDRVL_";"
GOTO X2
+5 IF $DATA(^UTILITY("DIFG",$JOB,DIFGADD,DIFGDIC,"DIC(""DR"")",DIFGDRCT))
IF $LENGTH(^(DIFGDRCT))+$LENGTH(DIFGNUMF(DIFGDIGT)_"///"_DIFGDRVL_";")<241
SET ^(DIFGDRCT)=^(DIFGDRCT)_DIFGNUMF(DIFGDIGT)_"///"_DIFGDRVL_";"
+6 IF '$TEST
SET DIFGDRCT=DIFGDRCT+1
SET ^UTILITY("DIFG",$JOB,DIFGADD,DIFGDIC,"DIC(""DR"")",DIFGDRCT)=DIFGNUMF(DIFGDIGT)_"///"_DIFGDRVL_";"
X2 KILL DIFGDRVL
+1 QUIT
+2 ;
