DIFG7 ;SFISC/DG(OHPRD)-CALLS TO DIC,DIE,DIK ;9MAR2006
;;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.
;
;;22.0;VA FileMan;;Mar 30, 1999
;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/TUCSON/LAB 3/13/96
;This routine is modified to pass back to the caller, an array,
;DIFGYFE(file,da) of all entries that were either added or edited
;during the filegram install. It is the responsibility of the
;caller to kill DIFGYFE
;
CALLDIC ;
I $D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"DINUM")) S DINUM=^("DINUM")
S DIADD=1,DIC(0)="FLI" I $P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"X"),U,2)]"" S X="`"_X
S DLAYGO=DIFGFILE
S DITC=""
D ^DIC
K DITC
;----- BEGIN IHS MODIFICATIONS
;ORIGINAL MODIFICATIONS BY IHS/TUCSON/LAB 3/13/96
;COMMENTED OUT LINE BELOW AND REPLACED WITH NEXT LINE TO ADD ,K Q
;SO THAT IF THERE IS AN ERROR VARS WILL GET KILLED THEN QUIT
;I Y<1 S DIFGER=16_U_$P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"MODE"),U,2) D ERROR^DIFG
I Y<1 S DIFGER=16_U_$P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"MODE"),U,2) D ERROR^DIFG,K Q
;ADDED NEXT LINE TO PASS BACK TO CALLER, THE IEN,FILE OF ENTRY ADDED
S DIFGYFE(DIFGFILE,+Y)=$P(Y,U,3)
;COMMENTED LINE BELOW AND REPLACED BY NEXT LINE TO ADD LINE LABEL K
;SO IT COULD BE CALLED
;K DIADD,DLAYGO,DR,DINUM
K K DIADD,DLAYGO,DR,DINUM
;----- END IHS MODIFICATIONS
Q
;
CALLDIE ;
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)
NEW I F I=0:1 Q:'$D(@("D"_I)) K @("D"_I)
S DITC=""
D ^DIE K DITC
;----- BEGIN IHS MODIFICATION
;ORIGINAL MODIFICATION BY IHS/TUCSON/LAB 3/13/96
;NEW LINE ADDED TO PASS BACK IEN,FILE THAT WAS EDITED
I $G(DA),'$D(DIFGYFE(DIFGFILE,DA)) S DIFGYFE(DIFGFILE,DA)=""
;----- END IHS MODIFICATION
Q
;
WP ;PROCESS WORD PROCESSING FIELD
S DIFG("FIELD")=^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"WP",0)
F DIFGI=1:1 Q:'$D(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"WP",DIFGI)) D:^(DIFGI)[";" CHANGE S DR=DIFG("FIELD")_"///+"_^(DIFGI) D ^DIE
K DR
Q
;
CHANGE ;TEXT CONTAINS A ";"
S DIFGSECP=^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"WP",DIFGI) D PARSE^DIFG1 S ^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"WP",DIFGI)="^S X="_DIFGSECP
Q
;
CALLDIK ;
D ^DIK
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIFG7 2596 printed Dec 13, 2024@02:47:43 Page 2
DIFG7 ;SFISC/DG(OHPRD)-CALLS TO DIC,DIE,DIK ;9MAR2006
+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 ;
+7 ;;22.0;VA FileMan;;Mar 30, 1999
+8 ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/TUCSON/LAB 3/13/96
+9 ;This routine is modified to pass back to the caller, an array,
+10 ;DIFGYFE(file,da) of all entries that were either added or edited
+11 ;during the filegram install. It is the responsibility of the
+12 ;caller to kill DIFGYFE
+13 ;
CALLDIC ;
+1 IF $DATA(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"DINUM"))
SET DINUM=^("DINUM")
+2 SET DIADD=1
SET DIC(0)="FLI"
IF $PIECE(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"X"),U,2)]""
SET X="`"_X
+3 SET DLAYGO=DIFGFILE
+4 SET DITC=""
+5 DO ^DIC
+6 KILL DITC
+7 ;----- BEGIN IHS MODIFICATIONS
+8 ;ORIGINAL MODIFICATIONS BY IHS/TUCSON/LAB 3/13/96
+9 ;COMMENTED OUT LINE BELOW AND REPLACED WITH NEXT LINE TO ADD ,K Q
+10 ;SO THAT IF THERE IS AN ERROR VARS WILL GET KILLED THEN QUIT
+11 ;I Y<1 S DIFGER=16_U_$P(^UTILITY("DIFG",$J,DIFGORDR,DIFGFILE,"MODE"),U,2) D ERROR^DIFG
+12 IF Y<1
SET DIFGER=16_U_$PIECE(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"MODE"),U,2)
DO ERROR^DIFG
DO K
QUIT
+13 ;ADDED NEXT LINE TO PASS BACK TO CALLER, THE IEN,FILE OF ENTRY ADDED
+14 SET DIFGYFE(DIFGFILE,+Y)=$PIECE(Y,U,3)
+15 ;COMMENTED LINE BELOW AND REPLACED BY NEXT LINE TO ADD LINE LABEL K
+16 ;SO IT COULD BE CALLED
+17 ;K DIADD,DLAYGO,DR,DINUM
K KILL DIADD,DLAYGO,DR,DINUM
+1 ;----- END IHS MODIFICATIONS
+2 QUIT
+3 ;
CALLDIE ;
+1 IF DR[".01///"&($PIECE(^DD(DIFGFILE,.01,0),U,5,99)["DINUM"!$DATA(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"DINUM")))
SET DIFGDRVL=$PIECE($PIECE(DR,".01///",2),";")
SET DR=$PIECE(DR,".01///"_DIFGDRVL)_$PIECE(DR,".01///"_DIFGDRVL_";",2)
+2 NEW I
FOR I=0:1
if '$DATA(@("D"_I))
QUIT
KILL @("D"_I)
+3 SET DITC=""
+4 DO ^DIE
KILL DITC
+5 ;----- BEGIN IHS MODIFICATION
+6 ;ORIGINAL MODIFICATION BY IHS/TUCSON/LAB 3/13/96
+7 ;NEW LINE ADDED TO PASS BACK IEN,FILE THAT WAS EDITED
+8 IF $GET(DA)
IF '$DATA(DIFGYFE(DIFGFILE,DA))
SET DIFGYFE(DIFGFILE,DA)=""
+9 ;----- END IHS MODIFICATION
+10 QUIT
+11 ;
WP ;PROCESS WORD PROCESSING FIELD
+1 SET DIFG("FIELD")=^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"WP",0)
+2 FOR DIFGI=1:1
if '$DATA(^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"WP",DIFGI))
QUIT
if ^(DIFGI)[";"
DO CHANGE
SET DR=DIFG("FIELD")_"///+"_^(DIFGI)
DO ^DIE
+3 KILL DR
+4 QUIT
+5 ;
CHANGE ;TEXT CONTAINS A ";"
+1 SET DIFGSECP=^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"WP",DIFGI)
DO PARSE^DIFG1
SET ^UTILITY("DIFG",$JOB,DIFGORDR,DIFGFILE,"WP",DIFGI)="^S X="_DIFGSECP
+2 QUIT
+3 ;
CALLDIK ;
+1 DO ^DIK
+2 QUIT
+3 ;
