BNIGVL0 ; IHS/CMI/LAB - SCREEN LOGIC ;
;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006
;
;
Q ;EP
K ^XTMP("BNIGVL",$J,"QMAN"),^UTILITY("AMQQ TAX",$J)
K DIC,X,Y,DD S X=$P(^BNIGRI(BNIGCRIT,0),U,3),DIC="^AMQQ(5,",DIC(0)="EQXM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA,DINUM,DICR I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" Q
S BNIGQMAN=+Y
I $P(^BNIGRI(BNIGCRIT,0),U)="Cause of Injury" S AMQQSQNM="CAUSE OF INJURY"
D ^AMQQGTX0(BNIGQMAN,"^XTMP(""BNIGVL"",$J,""QMAN"",")
I '$D(^XTMP("BNIGVL",$J,"QMAN")) W !!,$C(7),"** No ",$P(^BNIGRI(BNIGCRIT,0),U)," selected, all will be included." Q
I $D(^XTMP("BNIGVL",$J,"QMAN","*")) K ^XTMP("BNIGVL",$J,"QMAN")
S ^BNIRTMP(BNIGRPT,11,BNIGCRIT,0)=BNIGCRIT,^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT,BNIGCRIT)=""
S X="",Y=0 F S X=$O(^XTMP("BNIGVL",$J,"QMAN",X)) Q:X="" S Y=Y+1,^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,Y,0)=X,^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,"B",X,Y)="",^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,0)="^90512.8110101A^"_Y_"^"_Y
K X,Y,Z,BNIGQMAN,V,AMQQSQNM
K ^XTMP("BNIGVL",$J,"QMAN")
Q
R ;EP
S DIR(0)=$P(^BNIGRI(BNIGCRIT,0),U,4)_"O",DIR("A")="ENTER "_$P(^(0),U) D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
I Y="" Q
I Y=-1 Q
S ^BNIRTMP(BNIGRPT,11,BNIGCRIT,0)=BNIGCRIT,^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT,BNIGCRIT)=""
S BNIGCNT=BNIGCNT+1,^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,BNIGCNT,0)=$P(Y,U),^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,"B",$P(Y,U),BNIGCNT)="",^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,0)="^90512.8910101A^"_BNIGCNT_"^"_BNIGCNT
G R
Q
D ;DATE RANGE
BD ;get beginning date
W ! S DIR(0)="D^::EP",DIR("A")="Enter beginning "_BNIGTEXT_" for Search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) Q
S BNIGBDAT=Y
ED ;get ending date
W ! S DIR(0)="D^"_BNIGBDAT_"::EP",DIR("A")="Enter ending "_BNIGTEXT_" for Search" S Y=BNIGBDAT D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S BNIGEDAT=Y
S X1=BNIGBDAT,X2=-1 D C^%DTC S BNIGSDAT=X
;
S ^BNIRTMP(BNIGRPT,11,BNIGCRIT,0)=BNIGCRIT,^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT,BNIGCRIT)=""
S BNIGCNT=0,^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,BNIGCNT,0)="^90512.8910101A^1^1" S BNIGCNT=BNIGCNT+1,^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,1,0)=BNIGBDAT_U_BNIGEDAT,^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,"B",BNIGBDAT,BNIGCNT)=""
Q
N ;EP
K ^BNIRTMP(BNIGRPT,11,BNIGCRIT),^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT)
S DIR(0)="FO^1:11",DIR("A")="Enter a Range of numbers (e.g. 5-12,1-1)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !!,"No numeric range entered. All numerics will be included." Q
I $D(^BNIGRI(BNIGCRIT,25)) S X=Y X ^(25) I '$D(X),$D(^BNIGRI(BNIGCRIT,26)) W !! X ^(26) G N ;if input tx exists and fails G N
I '$D(^BNIGRI(BNIGCRIT,25)),Y'?1.3N1"-"1.3N W !!,$C(7),$C(7),"Enter a numeric range in the format nnn-nnn. E.g. 0-5, 0-99, 5-20." G N
S ^BNIRTMP(BNIGRPT,11,BNIGCRIT,0)=BNIGCRIT,^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT,BNIGCRIT)=""
S ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,0)="^90512.8910101A^1^1" S ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,1,0)=$P(Y,"-"),^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,"B",$P(Y,"-"),1)=""
S $P(^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,1,0),U,2)=$P(Y,"-",2)
Q
J ;EP - JUST A HIT
S ^BNIRTMP(BNIGRPT,11,BNIGCRIT,0)=BNIGCRIT,^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT,BNIGCRIT)=""
S ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,1,0)=1,^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,"B",1,1)="",^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,0)="^90512.8910101A^"_1_"^"_1
Q
Y ;EP - called from apclvl0
S DIR(0)="S^1:"_BNIGTEXT_";0:NO "_BNIGTEXT_"",DIR("A")="Should "_$S(BNIGPTVS="P":"patient",1:"procedure")_" have",DIR("B")="1" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
Q:Y=""
S ^BNIRTMP(BNIGRPT,11,BNIGCRIT,0)=BNIGCRIT,^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT,BNIGCRIT)=""
S ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,1,0)=Y,^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,"B",Y,1)="",^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,0)="^90512.8910101A^"_1_"^"_1
Q
F ;FREE TEXT RANGE
K ^BNIRTMP(BNIGRPT,11,BNIGCRIT),^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT)
S DIR(0)="FO^1:20",DIR("A")="Enter a Range of Characters for Search (e.g. A:B) " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !!,"No range entered. All ",BNIGTEXT," will be included." Q
I $D(^BNIGRI(BNIGCRIT,21)) S X=Y X ^(21) I '$D(X),$D(^BNIGRI(BNIGCRIT,22)) W !! X ^(22) G F ;if input tx exists and fails G N
I '$D(^BNIGRI(BNIGCRIT,21)),Y'?1.ANP1":"1.ANP W !!,$C(7),$C(7),"Enter an free text range in the format AAA:AAA. E.g. 94-01:94-200,CA:CZ, A:Z." G F
S ^BNIRTMP(BNIGRPT,11,BNIGCRIT,0)=BNIGCRIT,^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT,BNIGCRIT)=""
S BNIGCNT=0,^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,BNIGCNT,0)="^90512.8910101A^1^1" S BNIGCNT=BNIGCNT+1,^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,1,0)=$P(X,":")_U_$P(X,":",2),^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,"B",$P(X,":"),BNIGCNT)=""
Q
BNIGVL0 ; IHS/CMI/LAB - SCREEN LOGIC ;
+1 ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006
+2 ;
+3 ;
Q ;EP
+1 KILL ^XTMP("BNIGVL",$JOB,"QMAN"),^UTILITY("AMQQ TAX",$JOB)
+2 KILL DIC,X,Y,DD
SET X=$PIECE(^BNIGRI(BNIGCRIT,0),U,3)
SET DIC="^AMQQ(5,"
SET DIC(0)="EQXM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA,DINUM,DICR
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
QUIT
+3 SET BNIGQMAN=+Y
+4 IF $PIECE(^BNIGRI(BNIGCRIT,0),U)="Cause of Injury"
SET AMQQSQNM="CAUSE OF INJURY"
+5 DO ^AMQQGTX0(BNIGQMAN,"^XTMP(""BNIGVL"",$J,""QMAN"",")
+6 IF '$DATA(^XTMP("BNIGVL",$JOB,"QMAN"))
WRITE !!,$CHAR(7),"** No ",$PIECE(^BNIGRI(BNIGCRIT,0),U)," selected, all will be included."
QUIT
+7 IF $DATA(^XTMP("BNIGVL",$JOB,"QMAN","*"))
KILL ^XTMP("BNIGVL",$JOB,"QMAN")
+8 SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,0)=BNIGCRIT
SET ^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT,BNIGCRIT)=""
+9 SET X=""
SET Y=0
FOR
SET X=$ORDER(^XTMP("BNIGVL",$JOB,"QMAN",X))
IF X=""
QUIT
SET Y=Y+1
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,Y,0)=X
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,"B",X,Y)=""
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,0)="^90512.8110101A^"_Y_"^"_Y
+10 KILL X,Y,Z,BNIGQMAN,V,AMQQSQNM
+11 KILL ^XTMP("BNIGVL",$JOB,"QMAN")
+12 QUIT
R ;EP
+1 SET DIR(0)=$PIECE(^BNIGRI(BNIGCRIT,0),U,4)_"O"
SET DIR("A")="ENTER "_$PIECE(^(0),U)
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
QUIT
+3 IF Y=""
QUIT
+4 IF Y=-1
QUIT
+5 SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,0)=BNIGCRIT
SET ^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT,BNIGCRIT)=""
+6 SET BNIGCNT=BNIGCNT+1
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,BNIGCNT,0)=$PIECE(Y,U)
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,"B",$PIECE(Y,U),BNIGCNT)=""
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,0)="^90512.8910101A^"_BNIGCNT_"^"_BNIGCNT
+7 GOTO R
+8 QUIT
D ;DATE RANGE
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^::EP"
SET DIR("A")="Enter beginning "_BNIGTEXT_" for Search"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
QUIT
+3 SET BNIGBDAT=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="D^"_BNIGBDAT_"::EP"
SET DIR("A")="Enter ending "_BNIGTEXT_" for Search"
SET Y=BNIGBDAT
DO DD^%DT
SET DIR("B")=Y
SET Y=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET BNIGEDAT=Y
+4 SET X1=BNIGBDAT
SET X2=-1
DO C^%DTC
SET BNIGSDAT=X
+5 ;
+6 SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,0)=BNIGCRIT
SET ^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT,BNIGCRIT)=""
+7 SET BNIGCNT=0
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,BNIGCNT,0)="^90512.8910101A^1^1"
SET BNIGCNT=BNIGCNT+1
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,1,0)=BNIGBDAT_U_BNIGEDAT
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,"B",BNIGBDAT,BNIGCNT)=""
+8 QUIT
N ;EP
+1 KILL ^BNIRTMP(BNIGRPT,11,BNIGCRIT),^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT)
+2 SET DIR(0)="FO^1:11"
SET DIR("A")="Enter a Range of numbers (e.g. 5-12,1-1)"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF Y=""
WRITE !!,"No numeric range entered. All numerics will be included."
QUIT
+4 ;if input tx exists and fails G N
IF $DATA(^BNIGRI(BNIGCRIT,25))
SET X=Y
XECUTE ^(25)
IF '$DATA(X)
IF $DATA(^BNIGRI(BNIGCRIT,26))
WRITE !!
XECUTE ^(26)
GOTO N
+5 IF '$DATA(^BNIGRI(BNIGCRIT,25))
IF Y'?1.3N1"-"1.3N
WRITE !!,$CHAR(7),$CHAR(7),"Enter a numeric range in the format nnn-nnn. E.g. 0-5, 0-99, 5-20."
GOTO N
+6 SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,0)=BNIGCRIT
SET ^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT,BNIGCRIT)=""
+7 SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,0)="^90512.8910101A^1^1"
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,1,0)=$PIECE(Y,"-")
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,"B",$PIECE(Y,"-"),1)=""
+8 SET $PIECE(^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,1,0),U,2)=$PIECE(Y,"-",2)
+9 QUIT
J ;EP - JUST A HIT
+1 SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,0)=BNIGCRIT
SET ^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT,BNIGCRIT)=""
+2 SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,1,0)=1
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,"B",1,1)=""
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,0)="^90512.8910101A^"_1_"^"_1
+3 QUIT
Y ;EP - called from apclvl0
+1 SET DIR(0)="S^1:"_BNIGTEXT_";0:NO "_BNIGTEXT_""
SET DIR("A")="Should "_$SELECT(BNIGPTVS="P":"patient",1:"procedure")_" have"
SET DIR("B")="1"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
QUIT
+3 IF Y=""
QUIT
+4 SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,0)=BNIGCRIT
SET ^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT,BNIGCRIT)=""
+5 SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,1,0)=Y
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,"B",Y,1)=""
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,0)="^90512.8910101A^"_1_"^"_1
+6 QUIT
F ;FREE TEXT RANGE
+1 KILL ^BNIRTMP(BNIGRPT,11,BNIGCRIT),^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT)
+2 SET DIR(0)="FO^1:20"
SET DIR("A")="Enter a Range of Characters for Search (e.g. A:B) "
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF Y=""
WRITE !!,"No range entered. All ",BNIGTEXT," will be included."
QUIT
+4 ;if input tx exists and fails G N
IF $DATA(^BNIGRI(BNIGCRIT,21))
SET X=Y
XECUTE ^(21)
IF '$DATA(X)
IF $DATA(^BNIGRI(BNIGCRIT,22))
WRITE !!
XECUTE ^(22)
GOTO F
+5 IF '$DATA(^BNIGRI(BNIGCRIT,21))
IF Y'?1.ANP1":"1.ANP
WRITE !!,$CHAR(7),$CHAR(7),"Enter an free text range in the format AAA:AAA. E.g. 94-01:94-200,CA:CZ, A:Z."
GOTO F
+6 SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,0)=BNIGCRIT
SET ^BNIRTMP(BNIGRPT,11,"B",BNIGCRIT,BNIGCRIT)=""
+7 SET BNIGCNT=0
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,BNIGCNT,0)="^90512.8910101A^1^1"
SET BNIGCNT=BNIGCNT+1
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,1,0)=$PIECE(X,":")_U_$PIECE(X,":",2)
SET ^BNIRTMP(BNIGRPT,11,BNIGCRIT,11,"B",$PIECE(X,":"),BNIGCNT)=""
+8 QUIT
