BNIGVLP ; IHS/CMI/LAB - print bni general retrieval ;
;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006
START ;EP - Set up header line, dash line
S BNIGFCNT=0
S BNIIOSL=$S($G(BNIGUI):55,1:$G(IOSL))
I BNIGCTYP="L" D DELIMIT^BNIGVLP8 Q
S X=0,BNIGHEAD="" F S X=$O(^BNIRTMP(BNIGRPT,12,X)) Q:X'=+X S BNIGHDR=$P(^BNIGRI($P(^BNIRTMP(BNIGRPT,12,X,0),U),0),U,6),BNIGLENG=$P(^BNIRTMP(BNIGRPT,12,X,0),U,2),BNIGHDR=$E(BNIGHDR,1,BNIGLENG) D
.S J=$L(BNIGHDR),BNIGHEAD=BNIGHEAD_BNIGHDR,K=$P(^BNIRTMP(BNIGRPT,12,X,0),U,2)+1 F I=J:1:K S BNIGHEAD=BNIGHEAD_" "
.Q
S BNIGDASH="",$P(BNIGDASH,"-",BNIGTCW)="-"
D COVPAGE^BNIGVLP1 ;print cover page - note: if user ^'s out of cover page, processing continues
PROC ;process printing of report
I BNIGCTYP="T" G DONE ;--- if displaying only total, that was done in the cover page - go to done
I BNIGCTYP="C" G DONE ;--- if doing a template, that's already done so goto done
S BNIGPG=0 I '$D(^XTMP("BNIGVL",BNIGJOB,BNIGBTH)) G DONE
S (BNIGSRTV,BNIGFRST)="" K BNIGQUIT
D HEAD F S BNIGSRTV=$O(^XTMP("BNIGVL",BNIGJOB,BNIGBTH,"DATA HITS",BNIGSRTV)) Q:BNIGSRTV=""!($D(BNIGQUIT)) D V
G:$D(BNIGQUIT) DONE
I $Y>(BNIIOSL-4) D HEAD G:$D(BNIGQUIT) DONE
I $D(BNIGRCNT) W !!!,"Total CPHAD Activity records: ",BNIGRCNT
DONE ;
D DONE^BNIGVLP2
Q
V ;GETS DATA HITS
S BNIGSCNT=0
;get readable sort value
K BNIGPRNT
S BNIGSRTR="",BNIGVIEN=$O(^XTMP("BNIGVL",BNIGJOB,BNIGBTH,"DATA HITS",BNIGSRTV,0)) I BNIGVIEN]"" S BNIGCRIT=BNIGSORT D
.I BNIGPTVS="R" S BNIGVREC=^BNIREC(BNIGVIEN,0) X:$D(^BNIGRI(BNIGSORT,3)) ^(3) S BNIGSRTR=BNIGPRNT
I $G(BNIGSPAG)!($D(BNIGFRST)) D HEAD Q:$D(BNIGQUIT)
K BNIGFRST
S BNIGVIEN=0 F S BNIGVIEN=$O(^XTMP("BNIGVL",BNIGJOB,BNIGBTH,"DATA HITS",BNIGSRTV,BNIGVIEN)) Q:BNIGVIEN'=+BNIGVIEN!($D(BNIGQUIT)) D
.I BNIGPTVS="R" S BNIGVREC=^BNIREC(BNIGVIEN,0) D PRINT Q
.Q
Q:$D(BNIGQUIT)
I $Y>(BNIIOSL-3) D HEAD Q:$D(BNIGQUIT)
I $G(BNIGSPAG) W !!,"SUB-TOTAL for ",BNIGSORV," ",BNIGSRTR,": ",BNIGSCNT I BNIGCTYP="S",(BNIGPTVS="R") W !,?10,$E(BNIGSRTR,1,30),?45,$J(BNIGSCNT,8)
I BNIGCTYP="S" W !,?10,$E(BNIGSRTR,1,30),?45,$J(BNIGSCNT,8)
Q
PRINT ;
S BNIGSCNT=BNIGSCNT+1 Q:BNIGCTYP="S"
K ^XTMP("BNIGLINE",$J) S ^XTMP("BNIGLINE",$J,1)=""
I $Y>(BNIIOSL-5) D HEAD Q:$D(BNIGQUIT)
S BNIGI=0 F S BNIGI=$O(^BNIRTMP(BNIGRPT,12,BNIGI)) Q:BNIGI'=+BNIGI!($D(BNIGQUIT)) S BNIGCRIT=$P(^BNIRTMP(BNIGRPT,12,BNIGI,0),U) D
.I '$P(^BNIGRI(BNIGCRIT,0),U,8) D SINGLE Q
.D MULT
.Q
S BNIGX=0 F S BNIGX=$O(^XTMP("BNIGLINE",$J,BNIGX)) Q:BNIGX'=+BNIGX!($D(BNIGQUIT)) D
.I $Y>(BNIIOSL-4) D HEAD Q:$D(BNIGQUIT)
.W !,^XTMP("BNIGLINE",$J,BNIGX)
Q
SINGLE ;process single valued item
K BNIGPRNT
S BNIGX=0
X:$D(^BNIGRI(BNIGCRIT,3)) ^(3)
S BNIGLENG=$P(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2),BNIGPRNT=$E(BNIGPRNT,1,BNIGLENG) D
.S J=$L(BNIGPRNT),^XTMP("BNIGLINE",$J,1)=^XTMP("BNIGLINE",$J,1)_BNIGPRNT,K=$P(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2)+1 F I=J:1:K S ^XTMP("BNIGLINE",$J,1)=^XTMP("BNIGLINE",$J,1)_" "
.S X=1 F S X=$O(^XTMP("BNIGLINE",$J,X)) Q:X'=+X I $L(^XTMP("BNIGLINE",$J,X))<$L(^XTMP("BNIGLINE",$J,1)) S K=$L(^XTMP("BNIGLINE",$J,X))+1,J=$L(^XTMP("BNIGLINE",$J,1)) F I=K:1:J S ^XTMP("BNIGLINE",$J,X)=^XTMP("BNIGLINE",$J,X)_" "
Q
MULT ;
K BNIGPRNT,BNIGPRNM,BNIGY S (BNIGX,BNIGPCNT)=0
X:$D(^BNIGRI(BNIGCRIT,3)) ^(3)
I '$D(BNIGPRNM) S BNIGPRNT="--" D
.S BNIGLENG=$P(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2),BNIGPRNT=$E(BNIGPRNT,1,BNIGLENG) D
..S J=$L(BNIGPRNT),^XTMP("BNIGLINE",$J,1)=^XTMP("BNIGLINE",$J,1)_BNIGPRNT,K=$P(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2)+1 F I=J:1:K S ^XTMP("BNIGLINE",$J,1)=^XTMP("BNIGLINE",$J,1)_" "
S X=0 F S X=$O(BNIGPRNM(X)) Q:X'=+X D
.I X=1 D Q
..S BNIGLENG=$P(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2),BNIGPRNT=$E(BNIGPRNM(1),1,BNIGLENG) D
...S J=$L(BNIGPRNT),^XTMP("BNIGLINE",$J,1)=^XTMP("BNIGLINE",$J,1)_BNIGPRNT,K=$P(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2)+1 F I=J:1:K S ^XTMP("BNIGLINE",$J,1)=^XTMP("BNIGLINE",$J,1)_" "
.S BNIGLENG=$P(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2),BNIGPRNT=$E(BNIGPRNM(X),1,BNIGLENG) D
..I '$D(^XTMP("BNIGLINE",$J,X)) S ^XTMP("BNIGLINE",$J,X)="",K=$P(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2)+1,$P(^XTMP("BNIGLINE",$J,X)," ",($L(^XTMP("BNIGLINE",$J,1))-K))=""
..S J=$L(BNIGPRNT),^XTMP("BNIGLINE",$J,X)=^XTMP("BNIGLINE",$J,X)_BNIGPRNT,K=$P(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2)+1 F I=J:1:K S ^XTMP("BNIGLINE",$J,X)=^XTMP("BNIGLINE",$J,X)_" "
S X=1 F S X=$O(^XTMP("BNIGLINE",$J,X)) Q:X'=+X I $L(^XTMP("BNIGLINE",$J,X))<$L(^XTMP("BNIGLINE",$J,1)) S K=$L(^XTMP("BNIGLINE",$J,X))+1,J=$L(^XTMP("BNIGLINE",$J,1)) F I=K:1:J S ^XTMP("BNIGLINE",$J,X)=^XTMP("BNIGLINE",$J,X)_" "
Q
DIQ ;
K BNIGPRNT,BNIGFILE,BNIGFIEL
S BNIGFILE=$P($P(^BNIGRI(BNIGCRIT,0),U,4),","),BNIGFIEL=$P($P(^(0),U,4),",",2)
S DIQ(0)="EN",DIQ="BNIGPRNT(",DIC=BNIGFILE,DR=BNIGFIEL D EN^DIQ1 K DIC,DR,DIQ
I '$D(BNIGPRNT(BNIGFILE,DA,BNIGFIEL,"E")) S BNIGPRNT(BNIGFILE,DA,BNIGFIEL,"E")="--"
S BNIGPRNT=BNIGPRNT(BNIGFILE,DA,BNIGFIEL,"E")
Q
HEAD ;ENTRY POINT
D HEAD^BNIGVLP2
Q
BNIGVLP ; IHS/CMI/LAB - print bni general retrieval ;
+1 ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006
START ;EP - Set up header line, dash line
+1 SET BNIGFCNT=0
+2 SET BNIIOSL=$SELECT($GET(BNIGUI):55,1:$GET(IOSL))
+3 IF BNIGCTYP="L"
DO DELIMIT^BNIGVLP8
QUIT
+4 SET X=0
SET BNIGHEAD=""
FOR
SET X=$ORDER(^BNIRTMP(BNIGRPT,12,X))
IF X'=+X
QUIT
SET BNIGHDR=$PIECE(^BNIGRI($PIECE(^BNIRTMP(BNIGRPT,12,X,0),U),0),U,6)
SET BNIGLENG=$PIECE(^BNIRTMP(BNIGRPT,12,X,0),U,2)
SET BNIGHDR=$EXTRACT(BNIGHDR,1,BNIGLENG)
Begin DoDot:1
+5 SET J=$LENGTH(BNIGHDR)
SET BNIGHEAD=BNIGHEAD_BNIGHDR
SET K=$PIECE(^BNIRTMP(BNIGRPT,12,X,0),U,2)+1
FOR I=J:1:K
SET BNIGHEAD=BNIGHEAD_" "
+6 QUIT
End DoDot:1
+7 SET BNIGDASH=""
SET $PIECE(BNIGDASH,"-",BNIGTCW)="-"
+8 ;print cover page - note: if user ^'s out of cover page, processing continues
DO COVPAGE^BNIGVLP1
PROC ;process printing of report
+1 ;--- if displaying only total, that was done in the cover page - go to done
IF BNIGCTYP="T"
GOTO DONE
+2 ;--- if doing a template, that's already done so goto done
IF BNIGCTYP="C"
GOTO DONE
+3 SET BNIGPG=0
IF '$DATA(^XTMP("BNIGVL",BNIGJOB,BNIGBTH))
GOTO DONE
+4 SET (BNIGSRTV,BNIGFRST)=""
KILL BNIGQUIT
+5 DO HEAD
FOR
SET BNIGSRTV=$ORDER(^XTMP("BNIGVL",BNIGJOB,BNIGBTH,"DATA HITS",BNIGSRTV))
IF BNIGSRTV=""!($DATA(BNIGQUIT))
QUIT
DO V
+6 IF $DATA(BNIGQUIT)
GOTO DONE
+7 IF $Y>(BNIIOSL-4)
DO HEAD
IF $DATA(BNIGQUIT)
GOTO DONE
+8 IF $DATA(BNIGRCNT)
WRITE !!!,"Total CPHAD Activity records: ",BNIGRCNT
DONE ;
+1 DO DONE^BNIGVLP2
+2 QUIT
V ;GETS DATA HITS
+1 SET BNIGSCNT=0
+2 ;get readable sort value
+3 KILL BNIGPRNT
+4 SET BNIGSRTR=""
SET BNIGVIEN=$ORDER(^XTMP("BNIGVL",BNIGJOB,BNIGBTH,"DATA HITS",BNIGSRTV,0))
IF BNIGVIEN]""
SET BNIGCRIT=BNIGSORT
Begin DoDot:1
+5 IF BNIGPTVS="R"
SET BNIGVREC=^BNIREC(BNIGVIEN,0)
IF $DATA(^BNIGRI(BNIGSORT,3))
XECUTE ^(3)
SET BNIGSRTR=BNIGPRNT
End DoDot:1
+6 IF $GET(BNIGSPAG)!($DATA(BNIGFRST))
DO HEAD
IF $DATA(BNIGQUIT)
QUIT
+7 KILL BNIGFRST
+8 SET BNIGVIEN=0
FOR
SET BNIGVIEN=$ORDER(^XTMP("BNIGVL",BNIGJOB,BNIGBTH,"DATA HITS",BNIGSRTV,BNIGVIEN))
IF BNIGVIEN'=+BNIGVIEN!($DATA(BNIGQUIT))
QUIT
Begin DoDot:1
+9 IF BNIGPTVS="R"
SET BNIGVREC=^BNIREC(BNIGVIEN,0)
DO PRINT
QUIT
+10 QUIT
End DoDot:1
+11 IF $DATA(BNIGQUIT)
QUIT
+12 IF $Y>(BNIIOSL-3)
DO HEAD
IF $DATA(BNIGQUIT)
QUIT
+13 IF $GET(BNIGSPAG)
WRITE !!,"SUB-TOTAL for ",BNIGSORV," ",BNIGSRTR,": ",BNIGSCNT
IF BNIGCTYP="S"
IF (BNIGPTVS="R")
WRITE !,?10,$EXTRACT(BNIGSRTR,1,30),?45,$JUSTIFY(BNIGSCNT,8)
+14 IF BNIGCTYP="S"
WRITE !,?10,$EXTRACT(BNIGSRTR,1,30),?45,$JUSTIFY(BNIGSCNT,8)
+15 QUIT
PRINT ;
+1 SET BNIGSCNT=BNIGSCNT+1
IF BNIGCTYP="S"
QUIT
+2 KILL ^XTMP("BNIGLINE",$JOB)
SET ^XTMP("BNIGLINE",$JOB,1)=""
+3 IF $Y>(BNIIOSL-5)
DO HEAD
IF $DATA(BNIGQUIT)
QUIT
+4 SET BNIGI=0
FOR
SET BNIGI=$ORDER(^BNIRTMP(BNIGRPT,12,BNIGI))
IF BNIGI'=+BNIGI!($DATA(BNIGQUIT))
QUIT
SET BNIGCRIT=$PIECE(^BNIRTMP(BNIGRPT,12,BNIGI,0),U)
Begin DoDot:1
+5 IF '$PIECE(^BNIGRI(BNIGCRIT,0),U,8)
DO SINGLE
QUIT
+6 DO MULT
+7 QUIT
End DoDot:1
+8 SET BNIGX=0
FOR
SET BNIGX=$ORDER(^XTMP("BNIGLINE",$JOB,BNIGX))
IF BNIGX'=+BNIGX!($DATA(BNIGQUIT))
QUIT
Begin DoDot:1
+9 IF $Y>(BNIIOSL-4)
DO HEAD
IF $DATA(BNIGQUIT)
QUIT
+10 WRITE !,^XTMP("BNIGLINE",$JOB,BNIGX)
End DoDot:1
+11 QUIT
SINGLE ;process single valued item
+1 KILL BNIGPRNT
+2 SET BNIGX=0
+3 IF $DATA(^BNIGRI(BNIGCRIT,3))
XECUTE ^(3)
+4 SET BNIGLENG=$PIECE(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2)
SET BNIGPRNT=$EXTRACT(BNIGPRNT,1,BNIGLENG)
Begin DoDot:1
+5 SET J=$LENGTH(BNIGPRNT)
SET ^XTMP("BNIGLINE",$JOB,1)=^XTMP("BNIGLINE",$JOB,1)_BNIGPRNT
SET K=$PIECE(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2)+1
FOR I=J:1:K
SET ^XTMP("BNIGLINE",$JOB,1)=^XTMP("BNIGLINE",$JOB,1)_" "
+6 SET X=1
FOR
SET X=$ORDER(^XTMP("BNIGLINE",$JOB,X))
IF X'=+X
QUIT
IF $LENGTH(^XTMP("BNIGLINE",$JOB,X))<$LENGTH(^XTMP("BNIGLINE",$JOB,1))
SET K=$LENGTH(^XTMP("BNIGLINE",$JOB,X))+1
SET J=$LENGTH(^XTMP("BNIGLINE",$JOB,1))
FOR I=K:1:J
SET ^XTMP("BNIGLINE",$JOB,X)=^XTMP("BNIGLINE",$JOB,X)_" "
End DoDot:1
+7 QUIT
MULT ;
+1 KILL BNIGPRNT,BNIGPRNM,BNIGY
SET (BNIGX,BNIGPCNT)=0
+2 IF $DATA(^BNIGRI(BNIGCRIT,3))
XECUTE ^(3)
+3 IF '$DATA(BNIGPRNM)
SET BNIGPRNT="--"
Begin DoDot:1
+4 SET BNIGLENG=$PIECE(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2)
SET BNIGPRNT=$EXTRACT(BNIGPRNT,1,BNIGLENG)
Begin DoDot:2
+5 SET J=$LENGTH(BNIGPRNT)
SET ^XTMP("BNIGLINE",$JOB,1)=^XTMP("BNIGLINE",$JOB,1)_BNIGPRNT
SET K=$PIECE(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2)+1
FOR I=J:1:K
SET ^XTMP("BNIGLINE",$JOB,1)=^XTMP("BNIGLINE",$JOB,1)_" "
End DoDot:2
End DoDot:1
+6 SET X=0
FOR
SET X=$ORDER(BNIGPRNM(X))
IF X'=+X
QUIT
Begin DoDot:1
+7 IF X=1
Begin DoDot:2
+8 SET BNIGLENG=$PIECE(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2)
SET BNIGPRNT=$EXTRACT(BNIGPRNM(1),1,BNIGLENG)
Begin DoDot:3
+9 SET J=$LENGTH(BNIGPRNT)
SET ^XTMP("BNIGLINE",$JOB,1)=^XTMP("BNIGLINE",$JOB,1)_BNIGPRNT
SET K=$PIECE(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2)+1
FOR I=J:1:K
SET ^XTMP("BNIGLINE",$JOB,1)=^XTMP("BNIGLINE",$JOB,1)_" "
End DoDot:3
End DoDot:2
QUIT
+10 SET BNIGLENG=$PIECE(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2)
SET BNIGPRNT=$EXTRACT(BNIGPRNM(X),1,BNIGLENG)
Begin DoDot:2
+11 IF '$DATA(^XTMP("BNIGLINE",$JOB,X))
SET ^XTMP("BNIGLINE",$JOB,X)=""
SET K=$PIECE(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2)+1
SET $PIECE(^XTMP("BNIGLINE",$JOB,X)," ",($LENGTH(^XTMP("BNIGLINE",$JOB,1))-K))=""
+12 SET J=$LENGTH(BNIGPRNT)
SET ^XTMP("BNIGLINE",$JOB,X)=^XTMP("BNIGLINE",$JOB,X)_BNIGPRNT
SET K=$PIECE(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2)+1
FOR I=J:1:K
SET ^XTMP("BNIGLINE",$JOB,X)=^XTMP("BNIGLINE",$JOB,X)_" "
End DoDot:2
End DoDot:1
+13 SET X=1
FOR
SET X=$ORDER(^XTMP("BNIGLINE",$JOB,X))
IF X'=+X
QUIT
IF $LENGTH(^XTMP("BNIGLINE",$JOB,X))<$LENGTH(^XTMP("BNIGLINE",$JOB,1))
SET K=$LENGTH(^XTMP("BNIGLINE",$JOB,X))+1
SET J=$LENGTH(^XTMP("BNIGLINE",$JOB,1))
FOR I=K:1:J
SET ^XTMP("BNIGLINE",$JOB,X)=^XTMP("BNIGLINE",$JOB,X)_" "
+14 QUIT
DIQ ;
+1 KILL BNIGPRNT,BNIGFILE,BNIGFIEL
+2 SET BNIGFILE=$PIECE($PIECE(^BNIGRI(BNIGCRIT,0),U,4),",")
SET BNIGFIEL=$PIECE($PIECE(^(0),U,4),",",2)
+3 SET DIQ(0)="EN"
SET DIQ="BNIGPRNT("
SET DIC=BNIGFILE
SET DR=BNIGFIEL
DO EN^DIQ1
KILL DIC,DR,DIQ
+4 IF '$DATA(BNIGPRNT(BNIGFILE,DA,BNIGFIEL,"E"))
SET BNIGPRNT(BNIGFILE,DA,BNIGFIEL,"E")="--"
+5 SET BNIGPRNT=BNIGPRNT(BNIGFILE,DA,BNIGFIEL,"E")
+6 QUIT
HEAD ;ENTRY POINT
+1 DO HEAD^BNIGVLP2
+2 QUIT
