DIFG7.m

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 ---DIFG7   2596     printed  Apr 09, 2024@21:54:32                                                                                                                                                                                                       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       ;