Routine: DIFROM6

DIFROM6 ;SFISC/XAK-CREATES RTN ENDING IN 'INIT' ;03:06 PM  28 Nov 1994

 ;;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.

 S DH=" ;",Q=" K DIF,DIFQ,DIFQR,DIFQN,DIK,DDF,DDT,DTO,D0,DLAYGO,DIC,DIDUZ,DIR,DA,DIFROM,DFR,DTN,DIX,DZ,DIRUT,DTOUT,DUOUT"

 S ^UTILITY($J,.3,0)=" S DIOVRD=1,U=""^"",DIFQ=0,DIFROM="""_$S($D(DPK(1)):DPK(1),1:0)_""" W !,""This version"_$S($D(DPK(1)):" (#"_DPK(1)_")",1:"")_" of '"_DTL_"INIT' was created on "_DIFROM(1)_""""

 S ^UTILITY($J,1,0)=" I $D(^DD(""VERSION"")),^(""VERSION"")'<"_+DRN_" G GO"

 S ^UTILITY($J,2,0)=" ;W !,""FIRST, I'LL FRESHEN UP YOUR VA FILEMAN...."" D N^DINIT"

 S ^UTILITY($J,2.9,0)=" I ^DD(""VERSION"")<"_+DRN_" W !,""but I need version "_+DRN_" of the VA FileMan!"" G Q"

 S ^UTILITY($J,3,0)="GO ;"

 S ^UTILITY($J,3.5,0)="EN ; ENTER HERE TO BYPASS THE PRE-INIT PROGRAM"

 S ^UTILITY($J,3.6,0)=" S DIFQ=0 K DIRUT,DTOUT,DUOUT"

 S ^UTILITY($J,3.7,0)=" F DIFRIR=1:1:"_DIFRIR_" S DIFRRTN="_""""_U_DIFRRN_""""_"_$E("_""""_$E(DIFRRXT,1,DIFRIR)_""""_",DIFRIR) D @DIFRRTN"

 S ^UTILITY($J,3.8,0)=" W:"_(DIFRTX>0)_" !,""I AM GOING TO SET UP THE FOLLOWING FILE"_$E("S",X>1)_":"" F I=1:2:"_DIFRTX_" S DIF(I)=^UTILITY(""DIF"",$J,I) D 1 G Q:DIFQ!$D(DIRUT) K DIF(I)"

 S X=$E(DTL_"INIT",1,7)

 S ^UTILITY($J,4,0)=" S DIFROM="""_$S($D(DPK(1)):DPK(1),1:0)_""" D PKG:'$D(DIFROM(0)),^"_X_"1 G Q:'$D(DIFQ) S DIK(0)=""AB"""

 S ^UTILITY($J,6,0)=" K DIFQR D ^"_X_"2,^"_X_3,X=0

 D VERSION^DI

 S ^UTILITY($J,.6,0)=" W !?9,""("_$S($D(^DD("SITE")):"at "_^("SITE")_",",1:"")_" by "_X_")"",!"

 I DPK>0,$D(^DIC(9.4,DPK,"PRE")),$P(^("PRE"),U)]"" S ^UTILITY($J,3.1,0)=" W !,""I HAVE TO RUN AN ENVIRONMENT CHECK ROUTINE."" D PKG,^"_$P(^("PRE"),U)_" Q:'$D(DIFQ)  D NOW^%DTC S DIFROM(""PRE"")=%"

 K ^UTILITY(U,$J),E S D=-9999,DNAME=DTL_"INIT",DL=0 D 2^DIFROM3

 I $G(DPK)>0,$D(^%ZOSF),$D(^%ZTSK) N DIFRINIS D SETUP^DIFROM7(DTL_"INIT",.DIFRINIS) W:$G(DIFRINIS)["INIS" !,DTL,"INIS HAS BEEN FILED..."

INTEG W !,"..." S X=0,%X="F %Y=1:1:DD S D=$A(DNAME,%Y)*%Y+D"

 F XCNP=XCNP:0 S X=$O(^UTILITY($J,X)) Q:X=""  W "." X "ZL @X S D=0 F Y=1:1 S DNAME=$T(+Y),DD=$L(DNAME) X %X I 'DD S ^UTILITY(""DINTEG"",$J,X)=D ZL DIFROM6 Q"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIFROM6   2412     printed  Apr 09, 2024@21:47:57                                                                                                                                                                                                     Page 2

DIFROM6   ;SFISC/XAK-CREATES RTN ENDING IN 'INIT' ;03:06 PM  28 Nov 1994

 +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        SET DH=" ;"

           SET Q=" K DIF,DIFQ,DIFQR,DIFQN,DIK,DDF,DDT,DTO,D0,DLAYGO,DIC,DIDUZ,DIR,DA,DIFROM,DFR,DTN,DIX,DZ,DIRUT,DTOUT,DUOUT"

 +8        SET ^UTILITY($JOB,.3,0)=" S DIOVRD=1,U=""^"",DIFQ=0,DIFROM="""_$SELECT($DATA(DPK(1)):DPK(1),1:0)_""" W !,""This version"_$SELECT($DATA(DPK(1)):" (#"_DPK(1)_")",1:"")_" of '"_DTL_"INIT' was created on "_DIFROM(1)_""""

 +9        SET ^UTILITY($JOB,1,0)=" I $D(^DD(""VERSION"")),^(""VERSION"")'<"_+DRN_" G GO"

 +10       SET ^UTILITY($JOB,2,0)=" ;W !,""FIRST, I'LL FRESHEN UP YOUR VA FILEMAN...."" D N^DINIT"

 +11       SET ^UTILITY($JOB,2.9,0)=" I ^DD(""VERSION"")<"_+DRN_" W !,""but I need version "_+DRN_" of the VA FileMan!"" G Q"

 +12       SET ^UTILITY($JOB,3,0)="GO ;"

 +13       SET ^UTILITY($JOB,3.5,0)="EN ; ENTER HERE TO BYPASS THE PRE-INIT PROGRAM"

 +14       SET ^UTILITY($JOB,3.6,0)=" S DIFQ=0 K DIRUT,DTOUT,DUOUT"

 +15       SET ^UTILITY($JOB,3.7,0)=" F DIFRIR=1:1:"_DIFRIR_" S DIFRRTN="_""""_U_DIFRRN_""""_"_$E("_""""_$EXTRACT(DIFRRXT,1,DIFRIR)_""""_",DIFRIR) D @DIFRRTN"

 +16       SET ^UTILITY($JOB,3.8,0)=" W:"_(DIFRTX>0)_" !,""I AM GOING TO SET UP THE FOLLOWING FILE"_$EXTRACT("S",X>1)_":"" F I=1:2:"_DIFRTX_" S DIF(I)=^UTILITY(""DIF"",$J,I) D 1 G Q:DIFQ!$D(DIRUT) K DIF(I)"

 +17       SET X=$EXTRACT(DTL_"INIT",1,7)

 +18       SET ^UTILITY($JOB,4,0)=" S DIFROM="""_$SELECT($DATA(DPK(1)):DPK(1),1:0)_""" D PKG:'$D(DIFROM(0)),^"_X_"1 G Q:'$D(DIFQ) S DIK(0)=""AB"""

 +19       SET ^UTILITY($JOB,6,0)=" K DIFQR D ^"_X_"2,^"_X_3

           SET X=0

 +20       DO VERSION^DI

 +21       SET ^UTILITY($JOB,.6,0)=" W !?9,""("_$SELECT($DATA(^DD("SITE")):"at "_^("SITE")_",",1:"")_" by "_X_")"",!"

 +22       IF DPK>0

               IF $DATA(^DIC(9.4,DPK,"PRE"))

                   IF $PIECE(^("PRE"),U)]""

                       SET ^UTILITY($JOB,3.1,0)=" W !,""I HAVE TO RUN AN ENVIRONMENT CHECK ROUTINE."" D PKG,^"_$PIECE(^("PRE"),U)_" Q:'$D(DIFQ)  D NOW^%DTC S DIFROM(""PRE"")=%"

 +23       KILL ^UTILITY(U,$JOB),E

           SET D=-9999

           SET DNAME=DTL_"INIT"

           SET DL=0

           DO 2^DIFROM3

 +24       IF $GET(DPK)>0

               IF $DATA(^%ZOSF)

                   IF $DATA(^%ZTSK)

                       NEW DIFRINIS

                       DO SETUP^DIFROM7(DTL_"INIT",.DIFRINIS)

                       if $GET(DIFRINIS)["INIS"

                           WRITE !,DTL,"INIS HAS BEEN FILED..."

 +25       QUIT

 +26      ;

INTEG      WRITE !,"..."

           SET X=0

           SET %X="F %Y=1:1:DD S D=$A(DNAME,%Y)*%Y+D"

 +1        FOR XCNP=XCNP:0

               SET X=$ORDER(^UTILITY($JOB,X))

               if X=""

                   QUIT

               WRITE "."

               XECUTE "ZL @X S D=0 F Y=1:1 S DNAME=$T(+Y),DD=$L(DNAME) X %X I 'DD S ^UTILITY(""DINTEG"",$J,X)=D ZL DIFROM6 Q"

 +2        QUIT

DIFROM6.m