DIFROM12 ;SFISC/XAK-CREATES RTN ENDING IN INIT1 ;12:50 PM 28 Sep 1998
;;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.
;
VER ;
W !!?5,"Now you must enter the information that goes on the second line",!?5,"of the INIT routines.",!
G:DPK<1 V2
S DIE=9.4,DA=Q,DR=22,DR(2,9.49)=1 D ^DIE I $D(Y) S (DUOUT,DIRUT)=1 Q
G V2:'$D(D1) S X=^DIC(9.4,DPK,22,D1,0),DPK(1)=$P(X,U,1),DILN2=" ;;"_DPK(1)_";"_$P(^DIC(9.4,DPK,0),U,1)_";;",Y=$P(X,U,2) D DD^%DT S DILN2=DILN2_Y
W !! Q
V2 K DIR S DIR(0)="F^4:30",DIR("A")="Package Name",DIR("?")="^D PNM^DIFROMH1" D ^DIR Q:$D(DIRUT) S DILN2=Y
K DIR S DIR(0)="F^1:9^K:'(X?1.3N.1""."".2N.1A.2N) X",DIR("A")="Version",DIR("?")="^D VER^DIFROMH1" D ^DIR Q:$D(DIRUT) S DPK(1)=Y,DILN2=" ;;"_Y_";"_DILN2_";;"
K DIR S DIR(0)="D^::EX",DIR("A")="Date Distributed",DIR("?")="^D VDT^DIFROMH1" D ^DIR Q:$D(DIRUT) D DD^%DT S DILN2=DILN2_Y
W !! Q
PKG ;
Q:DTL="DIPK"!(DTL="DI")
S %Y="^UTILITY(U,$J,""PKG"",DPK,",%X="^DIC(9.4,"_DPK_","
W !,"Moving "_$P(^DIC(9.4,DPK,0),U)_" Entry into Init's."
S D=%X_"""22""," D %XY^%RCR K DR S:$D(^DISV(DUZ,D)) DR=^(D)
I $P(^DIC(9.4,DPK,0),U,4) S DL=$S($D(^DIC(9.2,+$P(^(0),U,4),0))#2:$P(^(0),U),1:""),$P(^UTILITY(U,$J,"PKG",DPK,0),U,4)=DL
F %="PRE","INI","INIT" S:$D(^UTILITY(U,$J,"PKG",DPK,%)) $P(^(%),U,2)=""
K ^UTILITY(U,$J,"PKG",DPK,"VERSION"),DIE Q:'$D(^ORD(100.99,1,5,DPK,0))
OR ;
S %X="^ORD(100.99,1,5,DPK,",%Y="^UTILITY(U,$J,""OR"",DPK," D %XY^%RCR
S %=$P(^ORD(100.99,1,5,DPK,0),U,4)
I %]"" S %=$S($D(^ORD(100.98,%,0)):$P(^(0),U),1:"") I %]"" S $P(^UTILITY(U,$J,"OR",DPK,0),U,4)=%
F I=0:0 S I=$O(^ORD(100.99,1,5,DPK,1,I)) Q:'I I $D(^(I,0)) S %=+$P(^(0),U) I $D(^ORD(101,%,0)) S $P(^UTILITY(U,$J,"OR",DPK,1,I,0),U)=$P(^(0),U) D OR1
F I=0:0 S I=$O(^ORD(100.99,1,5,DPK,5,I)) Q:'I I $D(^(I,0)) S %=+$P(^(0),U,3) I $D(^ORD(101,%,0)) S $P(^UTILITY(U,$J,"OR",DPK,5,I,0),U,3)=$P(^(0),U)
K ^UTILITY(U,$J,"OR",DPK,"B")
Q
OR1 F J=0:0 S J=$O(^ORD(100.99,1,5,DPK,1,I,1,J)) Q:'J I $D(^(J,0)) S %=+$P(^(0),U) I $D(^ORD(101,%,0)) S $P(^UTILITY(U,$J,"OR",DPK,1,I,1,J,0),U)=$P(^(0),U)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIFROM12 2339 printed Sep 23, 2025@20:24:07 Page 2
DIFROM12 ;SFISC/XAK-CREATES RTN ENDING IN INIT1 ;12:50 PM 28 Sep 1998
+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 ;
VER ;
+1 WRITE !!?5,"Now you must enter the information that goes on the second line",!?5,"of the INIT routines.",!
+2 if DPK<1
GOTO V2
+3 SET DIE=9.4
SET DA=Q
SET DR=22
SET DR(2,9.49)=1
DO ^DIE
IF $DATA(Y)
SET (DUOUT,DIRUT)=1
QUIT
+4 if '$DATA(D1)
GOTO V2
SET X=^DIC(9.4,DPK,22,D1,0)
SET DPK(1)=$PIECE(X,U,1)
SET DILN2=" ;;"_DPK(1)_";"_$PIECE(^DIC(9.4,DPK,0),U,1)_";;"
SET Y=$PIECE(X,U,2)
DO DD^%DT
SET DILN2=DILN2_Y
+5 WRITE !!
QUIT
V2 KILL DIR
SET DIR(0)="F^4:30"
SET DIR("A")="Package Name"
SET DIR("?")="^D PNM^DIFROMH1"
DO ^DIR
if $DATA(DIRUT)
QUIT
SET DILN2=Y
+1 KILL DIR
SET DIR(0)="F^1:9^K:'(X?1.3N.1""."".2N.1A.2N) X"
SET DIR("A")="Version"
SET DIR("?")="^D VER^DIFROMH1"
DO ^DIR
if $DATA(DIRUT)
QUIT
SET DPK(1)=Y
SET DILN2=" ;;"_Y_";"_DILN2_";;"
+2 KILL DIR
SET DIR(0)="D^::EX"
SET DIR("A")="Date Distributed"
SET DIR("?")="^D VDT^DIFROMH1"
DO ^DIR
if $DATA(DIRUT)
QUIT
DO DD^%DT
SET DILN2=DILN2_Y
+3 WRITE !!
QUIT
PKG ;
+1 if DTL="DIPK"!(DTL="DI")
QUIT
+2 SET %Y="^UTILITY(U,$J,""PKG"",DPK,"
SET %X="^DIC(9.4,"_DPK_","
+3 WRITE !,"Moving "_$PIECE(^DIC(9.4,DPK,0),U)_" Entry into Init's."
+4 SET D=%X_"""22"","
DO %XY^%RCR
KILL DR
if $DATA(^DISV(DUZ,D))
SET DR=^(D)
+5 IF $PIECE(^DIC(9.4,DPK,0),U,4)
SET DL=$SELECT($DATA(^DIC(9.2,+$PIECE(^(0),U,4),0))#2:$PIECE(^(0),U),1:"")
SET $PIECE(^UTILITY(U,$JOB,"PKG",DPK,0),U,4)=DL
+6 FOR %="PRE","INI","INIT"
if $DATA(^UTILITY(U,$JOB,"PKG",DPK,%))
SET $PIECE(^(%),U,2)=""
+7 KILL ^UTILITY(U,$JOB,"PKG",DPK,"VERSION"),DIE
if '$DATA(^ORD(100.99,1,5,DPK,0))
QUIT
OR ;
+1 SET %X="^ORD(100.99,1,5,DPK,"
SET %Y="^UTILITY(U,$J,""OR"",DPK,"
DO %XY^%RCR
+2 SET %=$PIECE(^ORD(100.99,1,5,DPK,0),U,4)
+3 IF %]""
SET %=$SELECT($DATA(^ORD(100.98,%,0)):$PIECE(^(0),U),1:"")
IF %]""
SET $PIECE(^UTILITY(U,$JOB,"OR",DPK,0),U,4)=%
+4 FOR I=0:0
SET I=$ORDER(^ORD(100.99,1,5,DPK,1,I))
if 'I
QUIT
IF $DATA(^(I,0))
SET %=+$PIECE(^(0),U)
IF $DATA(^ORD(101,%,0))
SET $PIECE(^UTILITY(U,$JOB,"OR",DPK,1,I,0),U)=$PIECE(^(0),U)
DO OR1
+5 FOR I=0:0
SET I=$ORDER(^ORD(100.99,1,5,DPK,5,I))
if 'I
QUIT
IF $DATA(^(I,0))
SET %=+$PIECE(^(0),U,3)
IF $DATA(^ORD(101,%,0))
SET $PIECE(^UTILITY(U,$JOB,"OR",DPK,5,I,0),U,3)=$PIECE(^(0),U)
+6 KILL ^UTILITY(U,$JOB,"OR",DPK,"B")
+7 QUIT
OR1 FOR J=0:0
SET J=$ORDER(^ORD(100.99,1,5,DPK,1,I,1,J))
if 'J
QUIT
IF $DATA(^(J,0))
SET %=+$PIECE(^(0),U)
IF $DATA(^ORD(101,%,0))
SET $PIECE(^UTILITY(U,$JOB,"OR",DPK,1,I,1,J,0),U)=$PIECE(^(0),U)
+1 QUIT
