File:  [Coherent Logic Development] / freem_fileman / USER / DIFG7.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:20 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DIFG7	;SFISC/DG(OHPRD)-CALLS TO DIC,DIE,DIK ;1/7/92  2:47 PM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: CALLDIC	;
    5: 	I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DINUM")) S DINUM=^("DINUM")
    6: 	S DIADD=1,DIC(0)="FLI" I $P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"X"),U,2)]"" S X="`"_X
    7: 	S DLAYGO=DIFGFILE
    8: 	S DITC=""
    9: 	D ^DIC
   10: 	K DITC
   11: 	I Y<1 S DIFGER=16_U_$P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"MODE"),U,2) D ERROR^DIFG
   12: 	K DIADD,DLAYGO,DR,DINUM
   13: 	Q
   14: 	;
   15: CALLDIE	;
   16: 	I DR[".01///"&($P(^DD(DIFGFILE,.01,0),U,5,99)["DINUM"!$D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DINUM"))) S DIFGDRVL=$P($P(DR,".01///",2),";"),DR=$P(DR,".01///"_DIFGDRVL)_$P(DR,".01///"_DIFGDRVL_";",2)
   17: 	NEW I F I=0:1 Q:'$D(@("D"_I))  K @("D"_I)
   18: 	S DITC=""
   19: 	D ^DIE K DITC
   20: 	Q
   21: 	;
   22: WP	;PROCESS WORD PROCESSING FIELD
   23: 	S DIFG("FIELD")=^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"WP",0)
   24: 	F DIFGI=1:1 Q:'$D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"WP",DIFGI))  D:^(DIFGI)[";" CHANGE S DR=DIFG("FIELD")_"///+"_^(DIFGI) D ^DIE
   25: 	K DR
   26: 	Q
   27: 	;
   28: CHANGE	;TEXT CONTAINS A ";"
   29: 	S DIFGSECP=^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"WP",DIFGI) D PARSE^DIFG1 S ^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"WP",DIFGI)="^S X="_DIFGSECP
   30: 	Q
   31: 	;
   32: CALLDIK	;
   33: 	D ^DIK
   34: 	Q
   35: 	;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>