BNIGVLP8.m

BNIGVLP8 ; IHS/CMI/LAB - print delimited ;

 ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006

 ;IHS/TUCSON/LAB - added killing of BNIGPRNT to V subroutine 05/19/97

 ;IHS/TUCSON/LAB - modified subroutine FLAT - patch 1 - 05/27/97

DELIMIT ;EP - Set up header line, dash line

 S BNIGFCNT=0,BNIGUIC=1

 K ^TMP($J,"BNIGDELIMITED")

 S BNIGDELC=0,BNIGPIEC=0

 I BNIGPTVS="R" S BNIGHDR="RECORD IEN",BNIGPIEC=1

 S X=0,BNIGHEAD="" F  S X=$O(^BNIRTMP(BNIGRPT,12,X)) Q:X'=+X  D

 .S BNIGPIEC=BNIGPIEC+1

 .S H=$P(^BNIGRI($P(^BNIRTMP(BNIGRPT,12,X,0),U),0),U,6)

 .S $P(BNIGHDR,U,BNIGPIEC)=H

 .Q

 I '$G(BNIGUI) D COVPAGE^BNIGVLP1 ;print cover page - note: if user ^'s out of cover page, processing continues

 I $G(BNIGUI) D COVPAGE^BNIGVLP3

PROC ;process printing of report

 I $G(BNIGUI) S BNIGUIC=BNIC S ^BNIGUI(BNIIEN,12,BNIGUIC,0)=BNIGHDR G PROC1

 S Y=0 I BNIGDELT="F" D OPEN Q:Y=1

 W !,BNIGHDR,!

PROC1 ;

 I '$D(^XTMP("BNIGVL",BNIGJOB,BNIGBTH)) W !,"NO DATA TO REPORT" G DONE

 S (BNIGSRTV,BNIGFRST)="" K BNIGQUIT

 F  S BNIGSRTV=$O(^XTMP("BNIGVL",BNIGJOB,BNIGBTH,"DATA HITS",BNIGSRTV)) Q:BNIGSRTV=""!($D(BNIGQUIT))  D V

DONE ;

 ;write out delimited file

 I '$G(BNIGUI),BNIGDELT="F" D ^%ZISC

 K ^XTMP("BNIGVL",BNIGJOB,BNIGBT),^TMP($J,"BNIGDELIMITED")

 D DEL^BNIGVL

 K BNIGBD,BNIGSD,BNIGED,BNIGEDD,BNIGBDD,BNIGRPT,BNIGHEAD,BNIGLINE,BNIGL,BNIGRCNT,BNIGI,BNIGCRIT,BNIGVIEN,BNIGVREC,BNIGJOB,BNIGBT,BNIGBTH,BNIGQUIT,BNIGHDR,BNIGDASH,BNIGLENG,BNIGPCNT,BNIGTCW,BNIGODAT,BNIGPG,AUPNDAYS,AUPNPAT,AUPNDOD,AUPNDOB,AUPNSEX

 K BNIGSORT,BNIGSRT,BNIGSORX,BNIGFILE,BNIGFIEL,BNIGPRNT,BNIGX,BNIGTYPE,BNIGFOUN,D0,J,K,L,BNIGPRNM,BNIGTEST,BNIGSEAT,BNIGLHDR,BNIGFRST

 D EN^XBVK("BNIG")

 Q

V ;GETS DATA HITS

 S BNIGCNT=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

 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

PRINT ;

 K ^XTMP("BNIGLINE",$J) S ^XTMP("BNIGLINE",$J,1)=""

 K BNIGDELD

 S BNIGPIEC=0,BNIGLINE=1,BNIGCNT=BNIGCNT+1

 I BNIGPTVS="R" S BNIGDELD(1,"S")=BNIGVIEN,BNIGPIEC=1

 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

 .S BNIGPIEC=BNIGPIEC+1

 .I '$P(^BNIGRI(BNIGCRIT,0),U,8) D SINGLE Q

 .D MULT

 .Q

 K BNIGDELP

 F X=1:1:BNIGLINE D

 .S BNIGCNT=BNIGCNT+1

 .F P=1:1:BNIGPIEC D

 ..S V=$O(BNIGDELD(P,""))

 ..I V="S" S D=BNIGDELD(P,V),$P(BNIGDELP(BNIGCNT),U,P)=D

 ..I V="M" S D=$S($P(BNIGDELD(P,V),"|",X)]"":$P(BNIGDELD(P,V),"|",X),1:"--"),$P(BNIGDELP(BNIGCNT),U,P)=D

 I '$G(BNIGUI) S X=0 F  S X=$O(BNIGDELP(X)) Q:X'=+X  W BNIGDELP(X),!

 I $G(BNIGUI) D

 .S (C,X)=0 F  S X=$O(BNIGDELP(X)) Q:X'=+X  S BNIGUIC=BNIGUIC+1,^BNIGUI(BNIIEN,12,BNIGUIC,0)=BNIGDELP(X)

 .S ^BNIGUI(BNIIEN,12,0)="^90512.0812^"_BNIGUIC_"^"_BNIGUIC_"^"_DT

 Q

SINGLE ;process single valued item

 K BNIGPRNT

 S BNIGX=0

 X:$D(^BNIGRI(BNIGCRIT,3)) ^(3)

 I BNIGPRNT="" S BNIGPRNT="--"

 S BNIGDELD(BNIGPIEC,"S")=BNIGPRNT

 Q

MULT ;

 K BNIGPRNT,BNIGPRNM,BNIGY S (BNIGX,BNIGPCNT)=0

 X:$D(^BNIGRI(BNIGCRIT,3)) ^(3)

 ;if 13th, then $o through delete bad ones and then reorder/number

 ;new logic here to screen if user wants to screen

 I $P(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,3) D

 .;does this one match selected ones?

 .S X=0 F  S X=$O(BNIGPRNM(X)) Q:X'=+X  D

 ..S Z=$G(BNIGPRNM(X,"I")) I Z="" K BNIGPRNM(X) Q

 ..I '$D(^BNIGRTMP(BNIGRPT,11,BNIGCRIT,11,"B",Z)) K BNIGPRNM(X)

 K Y S (X,C)=0 F  S X=$O(BNIGPRNM(X)) Q:X'=+X  S C=C+1,Y(C)=BNIGPRNM(X)

 I C>BNIGLINE S BNIGLINE=C

 K BNIGPRNM S X=0 F  S X=$O(Y(X)) Q:X'=+X  S BNIGPRNM(X)=Y(X)

 I '$D(BNIGPRNM) S BNIGPRNT="--" D

 .S BNIGDELD(BNIGPIEC,"M")=BNIGPRNT

 S X=0 F  S X=$O(BNIGPRNM(X)) Q:X'=+X  D

 .S $P(BNIGDELD(BNIGPIEC,"M"),"|",X)=BNIGPRNM(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

OPEN ;write flat file from global

 ;if screen selected do screen

 ;USE GS FROM GPRA TO OPEN AND WRITE FILE

 ;I BNIGDELT="S" D SCREEN Q

 I $G(BNIGUI) Q

 S Y=$$OPEN^%ZISH(BNIGHDIR,BNIGDELF,"W")

 I Y=1 W:'$D(ZTQUEUED) !!,"Cannot open host file to write out DELIMITED data.  Notify programmer." Q

 U IO

 Q

BNIGVLP8  ; IHS/CMI/LAB - print delimited ;

 +1       ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006

 +2       ;IHS/TUCSON/LAB - added killing of BNIGPRNT to V subroutine 05/19/97

 +3       ;IHS/TUCSON/LAB - modified subroutine FLAT - patch 1 - 05/27/97

DELIMIT   ;EP - Set up header line, dash line

 +1        SET BNIGFCNT=0

           SET BNIGUIC=1

 +2        KILL ^TMP($JOB,"BNIGDELIMITED")

 +3        SET BNIGDELC=0

           SET BNIGPIEC=0

 +4        IF BNIGPTVS="R"

               SET BNIGHDR="RECORD IEN"

               SET BNIGPIEC=1

 +5        SET X=0

           SET BNIGHEAD=""

           FOR 

               SET X=$ORDER(^BNIRTMP(BNIGRPT,12,X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +6                SET BNIGPIEC=BNIGPIEC+1

 +7                SET H=$PIECE(^BNIGRI($PIECE(^BNIRTMP(BNIGRPT,12,X,0),U),0),U,6)

 +8                SET $PIECE(BNIGHDR,U,BNIGPIEC)=H

 +9                QUIT 

               End DoDot:1

 +10      ;print cover page - note: if user ^'s out of cover page, processing continues

           IF '$GET(BNIGUI)

               DO COVPAGE^BNIGVLP1

 +11       IF $GET(BNIGUI)

               DO COVPAGE^BNIGVLP3

PROC      ;process printing of report

 +1        IF $GET(BNIGUI)

               SET BNIGUIC=BNIC

               SET ^BNIGUI(BNIIEN,12,BNIGUIC,0)=BNIGHDR

               GOTO PROC1

 +2        SET Y=0

           IF BNIGDELT="F"

               DO OPEN

               IF Y=1

                   QUIT 

 +3        WRITE !,BNIGHDR,!

PROC1     ;

 +1        IF '$DATA(^XTMP("BNIGVL",BNIGJOB,BNIGBTH))

               WRITE !,"NO DATA TO REPORT"

               GOTO DONE

 +2        SET (BNIGSRTV,BNIGFRST)=""

           KILL BNIGQUIT

 +3        FOR 

               SET BNIGSRTV=$ORDER(^XTMP("BNIGVL",BNIGJOB,BNIGBTH,"DATA HITS",BNIGSRTV))

               IF BNIGSRTV=""!($DATA(BNIGQUIT))

                   QUIT 

               DO V

DONE      ;

 +1       ;write out delimited file

 +2        IF '$GET(BNIGUI)

               IF BNIGDELT="F"

                   DO ^%ZISC

 +3        KILL ^XTMP("BNIGVL",BNIGJOB,BNIGBT),^TMP($JOB,"BNIGDELIMITED")

 +4        DO DEL^BNIGVL

 +5        KILL BNIGBD,BNIGSD,BNIGED,BNIGEDD,BNIGBDD,BNIGRPT,BNIGHEAD,BNIGLINE,BNIGL,BNIGRCNT,BNIGI,BNIGCRIT,BNIGVIEN,BNIGVREC,BNIGJOB,BNIGBT,BNIGBTH,BNIGQUIT,BNIGHDR,BNIGDASH,BNIGLENG,BNIGPCNT,BNIGTCW,BNIGODAT,BNIGPG,AUPNDAYS,AUPNPAT,AUPNDOD,AUPNDOB,AUPN

SEX

 +6        KILL BNIGSORT,BNIGSRT,BNIGSORX,BNIGFILE,BNIGFIEL,BNIGPRNT,BNIGX,BNIGTYPE,BNIGFOUN,D0,J,K,L,BNIGPRNM,BNIGTEST,BNIGSEAT,BNIGLHDR,BNIGFRST

 +7        DO EN^XBVK("BNIG")

 +8        QUIT 

V         ;GETS DATA HITS

 +1        SET BNIGCNT=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        KILL BNIGFRST

 +7        SET BNIGVIEN=0

           FOR 

               SET BNIGVIEN=$ORDER(^XTMP("BNIGVL",BNIGJOB,BNIGBTH,"DATA HITS",BNIGSRTV,BNIGVIEN))

               IF BNIGVIEN'=+BNIGVIEN!($DATA(BNIGQUIT))

                   QUIT 

               Begin DoDot:1

 +8                IF BNIGPTVS="R"

                       SET BNIGVREC=^BNIREC(BNIGVIEN,0)

                       DO PRINT

                       QUIT 

 +9                QUIT 

               End DoDot:1

 +10       QUIT 

PRINT     ;

 +1        KILL ^XTMP("BNIGLINE",$JOB)

           SET ^XTMP("BNIGLINE",$JOB,1)=""

 +2        KILL BNIGDELD

 +3        SET BNIGPIEC=0

           SET BNIGLINE=1

           SET BNIGCNT=BNIGCNT+1

 +4        IF BNIGPTVS="R"

               SET BNIGDELD(1,"S")=BNIGVIEN

               SET BNIGPIEC=1

 +5        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

 +6                SET BNIGPIEC=BNIGPIEC+1

 +7                IF '$PIECE(^BNIGRI(BNIGCRIT,0),U,8)

                       DO SINGLE

                       QUIT 

 +8                DO MULT

 +9                QUIT 

               End DoDot:1

 +10       KILL BNIGDELP

 +11       FOR X=1:1:BNIGLINE

               Begin DoDot:1

 +12               SET BNIGCNT=BNIGCNT+1

 +13               FOR P=1:1:BNIGPIEC

                       Begin DoDot:2

 +14                       SET V=$ORDER(BNIGDELD(P,""))

 +15                       IF V="S"

                               SET D=BNIGDELD(P,V)

                               SET $PIECE(BNIGDELP(BNIGCNT),U,P)=D

 +16                       IF V="M"

                               SET D=$SELECT($PIECE(BNIGDELD(P,V),"|",X)]"":$PIECE(BNIGDELD(P,V),"|",X),1:"--")

                               SET $PIECE(BNIGDELP(BNIGCNT),U,P)=D

                       End DoDot:2

               End DoDot:1

 +17       IF '$GET(BNIGUI)

               SET X=0

               FOR 

                   SET X=$ORDER(BNIGDELP(X))

                   IF X'=+X

                       QUIT 

                   WRITE BNIGDELP(X),!

 +18       IF $GET(BNIGUI)

               Begin DoDot:1

 +19               SET (C,X)=0

                   FOR 

                       SET X=$ORDER(BNIGDELP(X))

                       IF X'=+X

                           QUIT 

                       SET BNIGUIC=BNIGUIC+1

                       SET ^BNIGUI(BNIIEN,12,BNIGUIC,0)=BNIGDELP(X)

 +20               SET ^BNIGUI(BNIIEN,12,0)="^90512.0812^"_BNIGUIC_"^"_BNIGUIC_"^"_DT

               End DoDot:1

 +21       QUIT 

SINGLE    ;process single valued item

 +1        KILL BNIGPRNT

 +2        SET BNIGX=0

 +3        IF $DATA(^BNIGRI(BNIGCRIT,3))

               XECUTE ^(3)

 +4        IF BNIGPRNT=""

               SET BNIGPRNT="--"

 +5        SET BNIGDELD(BNIGPIEC,"S")=BNIGPRNT

 +6        QUIT 

MULT      ;

 +1        KILL BNIGPRNT,BNIGPRNM,BNIGY

           SET (BNIGX,BNIGPCNT)=0

 +2        IF $DATA(^BNIGRI(BNIGCRIT,3))

               XECUTE ^(3)

 +3       ;if 13th, then $o through delete bad ones and then reorder/number

 +4       ;new logic here to screen if user wants to screen

 +5        IF $PIECE(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,3)

               Begin DoDot:1

 +6       ;does this one match selected ones?

 +7                SET X=0

                   FOR 

                       SET X=$ORDER(BNIGPRNM(X))

                       IF X'=+X

                           QUIT 

                       Begin DoDot:2

 +8                        SET Z=$GET(BNIGPRNM(X,"I"))

                           IF Z=""

                               KILL BNIGPRNM(X)

                               QUIT 

 +9                        IF '$DATA(^BNIGRTMP(BNIGRPT,11,BNIGCRIT,11,"B",Z))

                               KILL BNIGPRNM(X)

                       End DoDot:2

               End DoDot:1

 +10       KILL Y

           SET (X,C)=0

           FOR 

               SET X=$ORDER(BNIGPRNM(X))

               IF X'=+X

                   QUIT 

               SET C=C+1

               SET Y(C)=BNIGPRNM(X)

 +11       IF C>BNIGLINE

               SET BNIGLINE=C

 +12       KILL BNIGPRNM

           SET X=0

           FOR 

               SET X=$ORDER(Y(X))

               IF X'=+X

                   QUIT 

               SET BNIGPRNM(X)=Y(X)

 +13       IF '$DATA(BNIGPRNM)

               SET BNIGPRNT="--"

               Begin DoDot:1

 +14               SET BNIGDELD(BNIGPIEC,"M")=BNIGPRNT

               End DoDot:1

 +15       SET X=0

           FOR 

               SET X=$ORDER(BNIGPRNM(X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +16               SET $PIECE(BNIGDELD(BNIGPIEC,"M"),"|",X)=BNIGPRNM(X)

               End DoDot:1

 +17       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 

OPEN      ;write flat file from global

 +1       ;if screen selected do screen

 +2       ;USE GS FROM GPRA TO OPEN AND WRITE FILE

 +3       ;I BNIGDELT="S" D SCREEN Q

 +4        IF $GET(BNIGUI)

               QUIT 

 +5        SET Y=$$OPEN^%ZISH(BNIGHDIR,BNIGDELF,"W")

 +6        IF Y=1

               IF '$DATA(ZTQUEUED)

                   WRITE !!,"Cannot open host file to write out DELIMITED data.  Notify programmer."

               QUIT 

 +7        USE IO

 +8        QUIT