Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIOZ

DIOZ.m

Go to the documentation of this file.
  1. DIOZ ;SFISC/TKW - COMPILED SORT TEMPLATE ;30NOV2012
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. ENCU ;MARK A SORT TEMPLATE FOR ROUTINE COMPILATION
  1. I $G(DUZ(0))'="@" W !,$C(7),$$EZBLD^DIALOG(101) Q
  1. EN1 N DDH,DIC,DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y,DIOZ
  1. ; NB: next 2 lines same in ENC. Need to make shared.
  1. D OS^DII:'$D(DISYS)
  1. I $G(^DD("OS",DISYS,"ZS"))="" D BLD^DIALOG(820) G QSV
  1. D DIC Q:Y<0 S DIOZ=+Y
  1. S DIR(0)="Y"
  1. I $G(^DIBT(+Y,"ROU"))="" D Q
  1. .D BLD^DIALOG(8029,$$EZBLD^DIALOG(8035),"","DIR(""A"")")
  1. .S DIR("B")="YES" D BLD^DIALOG(9014,"","","DIR(""?"")"),^DIR Q:'Y
  1. .S ^DIBT(DIOZ,"ROU")="^DISZ",^("ROUOLD")="DISZ"
  1. .W !!,$C(7),DIR("?",2),!,DIR("?")
  1. .Q
  1. S X(1)=$$EZBLD^DIALOG(8035),X(2)="DISZ" D BLD^DIALOG(8028,.X,"","DIR(""A"")")
  1. S DIR("B")="NO" D BLD^DIALOG(9019,"","","DIR(""?"")"),^DIR Q:'Y
  1. K ^DIBT(DIOZ,"ROU")
  1. W !!,$C(7),DIR("?",2),!,DIR("?")
  1. Q
  1. ;
  1. DIC S DIC="^DIBT(",DIC(0)="AEIQ",DIC("W")="W ?40,""FILE #"",$P(^(0),U,4) W:$D(^(""ROU"")) ?60,""Compiled"""
  1. S DIC("S")="I '$P(^(0),U,8),Y'<1,$O(^DIBT(+Y,2,0))"
  1. D ^DIC Q
  1. ;
  1. ENC ;CREATE COMPILED SORT ROUTINE
  1. ; NB: next 2 lines same in EN. Need to make shared.
  1. D OS^DII:'$D(DISYS)
  1. I $G(^DD("OS",DISYS,"ZS"))="" D BLD^DIALOG(820) G QSV
  1. I $O(^TMP("DIBTC",$J,""))="" D BLD^DIALOG(1501) G QSV
  1. N %,%H,%I,DIROUT,DIRUT,DTOUT,DUOUT,DRN,I,J,K,X,Y,DIR
  1. D NEW G:$D(DIERR) QSV
  1. S K=2,I="" F S I=$O(^TMP("DIBTC",$J,I)) Q:I="" F J=0:0 S J=$O(^TMP("DIBTC",$J,I,J)) Q:'J S X=^(J) I X]"" S K=K+1,^UTILITY($J,0,K)=X
  1. F I=1:1 S X=$P($T(TXT+I),";",3) Q:X="" S K=K+1,^UTILITY($J,0,K)=X
  1. S X=$P(DIBTPGM,U,2) X ^DD("OS",DISYS,"ZS")
  1. K ^TMP("DIBTC",$J)
  1. Q
  1. ;
  1. NEW I DIBTPGM'?1"^"1.7U1.4N D NXTNO(.DRN) Q:$D(DIERR) S DIBTPGM=DIBTPGM_$E("000",1,(4-$L(DRN)))_DRN
  1. D NOW^%DTC,YX^%DTC
  1. K ^UTILITY($J,0)
  1. S ^UTILITY($J,0,1)=$P(DIBTPGM,U,2)_" ; GENERATED FROM '"_$P(^DIBT(DIBT1,0),U,1)_"' SORT TEMPLATE (#"_DIBT1_"), FILE:"_DP_", USER:"_$S($G(^VA(200,+DUZ,0))]"":$P(^(0),U),1:$P($G(^DIC(3,+DUZ,0)),U))_" ; "_Y
  1. S ^UTILITY($J,0,2)=$T(DIOZ+1)
  1. Q
  1. ;
  1. NXTNO(DRN) ; GET NEXT AVAILABLE ROUTINE NUMBER
  1. N DILOCK S DRN=0 D Q:DRN
  1. N1 . S DILOCK=0,DRN=$O(^DI(.83,"C","n",DRN)) Q:'DRN D N3 G:DILOCK N1
  1. N2 S DILOCK=0,DRN=$$NXTNO^DICLIB("^DI(.83,","","U") I DRN>9999 D BLD^DIALOG(1502) Q
  1. D N3 G:DILOCK N2
  1. Q
  1. N3 L +^DI(.83,DRN,0):10 I '$T S DILOCK=1 Q
  1. S ^DI(.83,DRN,0)=DRN_"^y",^DI(.83,"B",DRN,DRN)="",^DI(.83,"C","y",DRN)="" K ^DI(.83,"C","n",DRN) L -^DI(.83,DRN,0) Q
  1. Q
  1. ;
  1. ENRLS(DRN) ; MAKE ROUTINE NUMBER AVAILABLE FOR REUSE & DELETE ROUTINE
  1. N DICLEAN,X S DRN=+$G(DRN),DICLEAN='DRN G:DRN R1
  1. R S DRN=$O(^DI(.83,DRN)) Q:'DRN
  1. R1 I $G(^DI(.83,DRN,0))]"" S $P(^(0),U,2)="n",^DI(.83,"C","n",DRN)="" K ^DI(.83,"C","y",DRN)
  1. S X="DISZ"_$E("000",1,(4-$L(DRN)))_DRN X $G(^DD("OS",DISYS,"DEL"))
  1. G:DICLEAN R
  1. Q
  1. ;
  1. QSV D:$G(DRN) ENRLS(DRN) K DIBTPGM
  1. QER Q:$G(DIQUIET)
  1. D MSG^DIALOG("W") S DIERR=1 Q
  1. ;
  1. ;DIALOG #101 'only those with programmer's access'
  1. ; #820 'no way to save routines on the system'
  1. ; #1501 'There is no code to save for this compiled...'
  1. ; #1502 'All available routine numbers...are in use...'
  1. ; #8028 '...currently compiled under namespace...'
  1. ; #8029 '...not currently compiled.'
  1. ; #8035 'Sort template'
  1. ; #9014 (help) 'if YES...Sort logic will be compiled...'
  1. ; #9019 (help) 'if YES...Sort logic...will NOT be compiled...'
  1. ;
  1. TXT ;;
  1. ;;M X $S($D(DPQ):DX(DIXX),1:^UTILITY($J,99,DIXX))