- DIFG4 ;SFISC/DG(OHPRD)-HANDLES FAILED IDENTIFIER, SPECIFIER, AND FIELD LOOKUPS ; [ 07/15/91 1:30 PM ]
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- 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
- ;
- DIFG4 ;SFISC/DG(OHPRD)-HANDLES FAILED IDENTIFIER, SPECIFIER, AND FIELD LOOKUPS ; [ 07/15/91 1:30 PM ]
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- 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 ;
