source: IHS-VA_UTILITIES-XB/trunk/XBDHDSV.m@ 1166

XBDHDSV ; IHS/ADC/GTH - COMPILES HEADER INFO FOR AUTO ENTRY INTO DIP ; [ 02/07/97   3:02 PM ]

        ;;4.0;XB;;Jul 20, 2009;Build 2

        ;

        I '$D(^TMP("XBDH",$J,"HEADER")) Q

NEW     ;

        NEW XBDHC,XBDHHDX,DIRPIPE,XBDHI,XBDHLJ,XBDHLPTH,XBDHMORE,XBDHN,XBDHNN,XBDHL,XBDHPDFN,XBDHRJ,XBDHSTG,XBDHTPTH,XBDHWW,XBDHX,XBDHY,I,J,L,P,X,Y,BY,DALL,DIC,DIJ,DP,DPP,FR,IOP,IOX,IOY,TO,XBDHCHLW,XBDHPDNA,%

INIT    ;

        S ^TMP("XBDH",$J,"HELPR",0)="]",^(99)="",X=^TMP("XBDH",$J,"HEADER"),XBDHCHLW=1,XBDHPDFN=$P(X,U),XBDHPDNA=$P(X,U,2),XBDHTHLW=$P(X,U,3),V="|"

        KILL X

        S XBDHLPTH="",(XBDHN,XBDHI)=0

INCN    ;

        S XBDHN=XBDHN+1

        G:'$D(^TMP("XBDH",$J,"HEADER",XBDHN)) CLOSE S XBDHX=^(XBDHN)

        D MUMPS,PRELIM

        S XBDHLPTH=XBDHTPTH

        D NORMAL

        G INCN

        ;

CLOSE   ;

        I XBDHTPTH]"" S X=$L(XBDHTPTH,";")-1,Y="" F X=1:1:X D SET

        D STD

        S DIR(0)="YO",DIR("A")="Want to make any more changes",DIR("B")="NO"

        D ^DIR

        KILL DIR

        I Y=1 G EXIT

        I Y=U S XBDHQUIT="" Q

        KILL ^TMP("XBDH",$J,"SAVE")

EXIT    ;

        Q

        ;

SET     ;

        S XBDHI=XBDHI+1,^TMP("XBDH",$J,"HELPR",XBDHI)=Y

        Q

        ;

MUMPS   ;

        S XBDHJ=""

        F L=0:0 S XBDHJ=$O(^TMP("XBDH",$J,"HEADER",XBDHN,XBDHJ)) Q:XBDHJ=""  S XBDHI=XBDHI+1,^TMP("XBDH",$J,"HELPR",XBDHI)=^TMP("XBDH",$J,"HEADER",XBDHN,XBDHJ)

        KILL XBDHJ

        Q

        ;

PRELIM  ;

        S X=$P(^TMP("XBDH",$J,"HEADER",XBDHN),V),XBDHTPTH=$P(X,"~",4)

        I XBDHLPTH=XBDHTPTH Q

        I $E(XBDHTPTH,1,$L(XBDHLPTH))=XBDHLPTH D DOWN Q

        I $E(XBDHLPTH,1,$L(XBDHTPTH))=XBDHTPTH D UP Q

        D PATH

        Q

        ;

DOWN    ;

        S X=$L(XBDHLPTH,";")

        F I=X:1 S Y=$P(XBDHTPTH,";",I) Q:Y=""  D SET

        Q

        ;

UP      ;

        S X=$L(XBDHTPTH,";"),Y=$L(XBDHLPTH,";"),X=Y-X,Y=""

        F I=1:1:X D SET

        Q

        ;

PATH    ;

        F I=1:1 I $P(XBDHLPTH,";",I)="" S A=I-1 Q

        F I=1:1 I $P(XBDHTPTH,";",I)="" S B=I-1 Q

        F I=1:1:A Q:$P(XBDHLPTH,";",1,I)'=$P(XBDHTPTH,";",1,I)

        S C=I-1,N=A-C,Y=""

        F I=1:1:N D SET

        S C=C+1

        F I=C:1:B S Y=$P(XBDHTPTH,";",I) D SET

        KILL A,B,C,I,N

        Q

        ;

NORMAL  ;

        S XBDHC=XBDHCHLW,XBDHNN=$J("",$P(XBDHX,V,5))_$P(XBDHX,V,3),XBDHLJ=$P(XBDHX,V,4),XBDHRJ=$P(XBDHX,V,6),XBDHWW=$P(XBDHX,V,7),XBDHCHLW=XBDHCHLW+$P(XBDHX,V,4)+$P(XBDHX,V,8)

        S XBDHSTG=$P($P(XBDHX,V),"~",2)

        I XBDHNN'=$P(XBDHX,V,2) S XBDHSTG=XBDHSTG_";"""_XBDHNN_""""

        S XBDHSTG=XBDHSTG_";C"_XBDHC

        I XBDHLJ S XBDHSTG=XBDHSTG_$S(XBDHWW="+":";W",1:";L")_XBDHLJ

        I XBDHRJ="+" S XBDHSTG=XBDHSTG_";R"_$P(XBDHX,V,4)

        S XBDHI=XBDHI+1,^TMP("XBDH",$J,"HELPR",XBDHI)=XBDHSTG

        Q

        ;

STD     ;

        W !!,"I AM ABOUT TO PRINT A SAMPLE REPORT.",!

        S DIR(0)="YO",DIR("A")="For this demo, do you want the 'standard' print options",DIR("B")="YES",DIR("?")="Standard options: SORT BY '@NUMBER', DEVICE = 'HOME'"

        D ^DIR

        KILL DIR

        I Y=U S XBDHQUIT="" Q

        W !!,"HMMM, LET ME THINK ABOUT THIS...",!!

        I Y=1 S BY="NUMBER;@",FR="",TO="",IOP=$I,DUZ(0)="@"

DIP     ;

        S DIC=^DIC(XBDHPDFN,0,"GL")

        S DIRPIPE="D ^XBDHDIP",L="]"

        KILL XBDHHDX

        D EN1^DIP

        Q

        ; 

NOTES   ; 

        ; CONVERTS THE INFO FROM THE "HEADER" GLOBAL INTO FM SYNATX FOR THE "HELPR" GLOBAL

        ; INPUT = ^TMP("XBDH",$J,"HEADER",XBDHCHN)

        ; OUTPUT = ^TMP("XBDH",$J,"HELPR",N)

        ; ";L" IS SUPERCEEDED BY ";W" IF WORDWRAP IS IN EFFECT

        ; EN1^DIP LEAVES SOME LOCALS HANGING AROUND WHICH ARE KILLED IN DIP+2

        ;