XBDHDSV ; IHS/ADC/GTH - COMPILES HEADER INFO FOR AUTO ENTRY INTO DIP ; [ 02/07/97 3:02 PM ]
;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
;
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
;
XBDHDSV ; IHS/ADC/GTH - COMPILES HEADER INFO FOR AUTO ENTRY INTO DIP ; [ 02/07/97 3:02 PM ]
+1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
+2 ;
+3 IF '$DATA(^TMP("XBDH",$JOB,"HEADER"))
QUIT
NEW ;
+1 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 ;
+1 SET ^TMP("XBDH",$JOB,"HELPR",0)="]"
SET ^(99)=""
SET X=^TMP("XBDH",$JOB,"HEADER")
SET XBDHCHLW=1
SET XBDHPDFN=$PIECE(X,U)
SET XBDHPDNA=$PIECE(X,U,2)
SET XBDHTHLW=$PIECE(X,U,3)
SET V="|"
+2 KILL X
+3 SET XBDHLPTH=""
SET (XBDHN,XBDHI)=0
INCN ;
+1 SET XBDHN=XBDHN+1
+2 IF '$DATA(^TMP("XBDH",$JOB,"HEADER",XBDHN))
GOTO CLOSE
SET XBDHX=^(XBDHN)
+3 DO MUMPS
DO PRELIM
+4 SET XBDHLPTH=XBDHTPTH
+5 DO NORMAL
+6 GOTO INCN
+7 ;
CLOSE ;
+1 IF XBDHTPTH]""
SET X=$LENGTH(XBDHTPTH,";")-1
SET Y=""
FOR X=1:1:X
DO SET
+2 DO STD
+3 SET DIR(0)="YO"
SET DIR("A")="Want to make any more changes"
SET DIR("B")="NO"
+4 DO ^DIR
+5 KILL DIR
+6 IF Y=1
GOTO EXIT
+7 IF Y=U
SET XBDHQUIT=""
QUIT
+8 KILL ^TMP("XBDH",$JOB,"SAVE")
EXIT ;
+1 QUIT
+2 ;
SET ;
+1 SET XBDHI=XBDHI+1
SET ^TMP("XBDH",$JOB,"HELPR",XBDHI)=Y
+2 QUIT
+3 ;
MUMPS ;
+1 SET XBDHJ=""
+2 FOR L=0:0
SET XBDHJ=$ORDER(^TMP("XBDH",$JOB,"HEADER",XBDHN,XBDHJ))
IF XBDHJ=""
QUIT
SET XBDHI=XBDHI+1
SET ^TMP("XBDH",$JOB,"HELPR",XBDHI)=^TMP("XBDH",$JOB,"HEADER",XBDHN,XBDHJ)
+3 KILL XBDHJ
+4 QUIT
+5 ;
PRELIM ;
+1 SET X=$PIECE(^TMP("XBDH",$JOB,"HEADER",XBDHN),V)
SET XBDHTPTH=$PIECE(X,"~",4)
+2 IF XBDHLPTH=XBDHTPTH
QUIT
+3 IF $EXTRACT(XBDHTPTH,1,$LENGTH(XBDHLPTH))=XBDHLPTH
DO DOWN
QUIT
+4 IF $EXTRACT(XBDHLPTH,1,$LENGTH(XBDHTPTH))=XBDHTPTH
DO UP
QUIT
+5 DO PATH
+6 QUIT
+7 ;
DOWN ;
+1 SET X=$LENGTH(XBDHLPTH,";")
+2 FOR I=X:1
SET Y=$PIECE(XBDHTPTH,";",I)
IF Y=""
QUIT
DO SET
+3 QUIT
+4 ;
UP ;
+1 SET X=$LENGTH(XBDHTPTH,";")
SET Y=$LENGTH(XBDHLPTH,";")
SET X=Y-X
SET Y=""
+2 FOR I=1:1:X
DO SET
+3 QUIT
+4 ;
PATH ;
+1 FOR I=1:1
IF $PIECE(XBDHLPTH,";",I)=""
SET A=I-1
QUIT
+2 FOR I=1:1
IF $PIECE(XBDHTPTH,";",I)=""
SET B=I-1
QUIT
+3 FOR I=1:1:A
IF $PIECE(XBDHLPTH,";",1,I)'=$PIECE(XBDHTPTH,";",1,I)
QUIT
+4 SET C=I-1
SET N=A-C
SET Y=""
+5 FOR I=1:1:N
DO SET
+6 SET C=C+1
+7 FOR I=C:1:B
SET Y=$PIECE(XBDHTPTH,";",I)
DO SET
+8 KILL A,B,C,I,N
+9 QUIT
+10 ;
NORMAL ;
+1 SET XBDHC=XBDHCHLW
SET XBDHNN=$JUSTIFY("",$PIECE(XBDHX,V,5))_$PIECE(XBDHX,V,3)
SET XBDHLJ=$PIECE(XBDHX,V,4)
SET XBDHRJ=$PIECE(XBDHX,V,6)
SET XBDHWW=$PIECE(XBDHX,V,7)
SET XBDHCHLW=XBDHCHLW+$PIECE(XBDHX,V,4)+$PIECE(XBDHX,V,8)
+2 SET XBDHSTG=$PIECE($PIECE(XBDHX,V),"~",2)
+3 IF XBDHNN'=$PIECE(XBDHX,V,2)
SET XBDHSTG=XBDHSTG_";"""_XBDHNN_""""
+4 SET XBDHSTG=XBDHSTG_";C"_XBDHC
+5 IF XBDHLJ
SET XBDHSTG=XBDHSTG_$SELECT(XBDHWW="+":";W",1:";L")_XBDHLJ
+6 IF XBDHRJ="+"
SET XBDHSTG=XBDHSTG_";R"_$PIECE(XBDHX,V,4)
+7 SET XBDHI=XBDHI+1
SET ^TMP("XBDH",$JOB,"HELPR",XBDHI)=XBDHSTG
+8 QUIT
+9 ;
STD ;
+1 WRITE !!,"I AM ABOUT TO PRINT A SAMPLE REPORT.",!
+2 SET DIR(0)="YO"
SET DIR("A")="For this demo, do you want the 'standard' print options"
SET DIR("B")="YES"
SET DIR("?")="Standard options: SORT BY '@NUMBER', DEVICE = 'HOME'"
+3 DO ^DIR
+4 KILL DIR
+5 IF Y=U
SET XBDHQUIT=""
QUIT
+6 WRITE !!,"HMMM, LET ME THINK ABOUT THIS...",!!
+7 IF Y=1
SET BY="NUMBER;@"
SET FR=""
SET TO=""
SET IOP=$IO
SET DUZ(0)="@"
DIP ;
+1 SET DIC=^DIC(XBDHPDFN,0,"GL")
+2 SET DIRPIPE="D ^XBDHDIP"
SET L="]"
+3 KILL XBDHHDX
+4 DO EN1^DIP
+5 QUIT
+6 ;
NOTES ;
+1 ; CONVERTS THE INFO FROM THE "HEADER" GLOBAL INTO FM SYNATX FOR THE "HELPR" GLOBAL
+2 ; INPUT = ^TMP("XBDH",$J,"HEADER",XBDHCHN)
+3 ; OUTPUT = ^TMP("XBDH",$J,"HELPR",N)
+4 ; ";L" IS SUPERCEEDED BY ";W" IF WORDWRAP IS IN EFFECT
+5 ; EN1^DIP LEAVES SOME LOCALS HANGING AROUND WHICH ARE KILLED IN DIP+2
+6 ;
