- 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 Mar 13, 2025@21:52:27 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 ;
