- BWGRVL0 ; IHS/CMI/LAB - SCREEN LOGIC ;03-Sep-2003 20:09;PLS
- ;;2.0;WOMEN'S HEALTH;**6,8,9**;MAY 16, 1996
- ;
- ;IHS/CMI/LAB - modified file numbers
- ;
- Q ;EP
- K ^XTMP("BWGRVL",$J,"QMAN"),^UTILITY("AMQQ TAX",$J)
- K DIC,X,Y,DD S X=$P(^BWGRI(BWGRCRIT,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 BWGRQMAN=+Y
- I $P(^BWGRI(BWGRCRIT,0),U)="Cause of Injury" S AMQQSQNM="CAUSE OF INJURY"
- D ^AMQQGTX0(BWGRQMAN,"^XTMP(""BWGRVL"",$J,""QMAN"",")
- I '$D(^XTMP("BWGRVL",$J,"QMAN")) W !!,$C(7),"** No ",$P(^BWGRI(BWGRCRIT,0),U)," selected, all will be included." Q
- I $D(^XTMP("BWGRVL",$J,"QMAN","*")) K ^XTMP("BWGRVL",$J,"QMAN")
- S ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,0)=BWGRCRIT,^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT,BWGRCRIT)=""
- S X="",Y=0 F S X=$O(^XTMP("BWGRVL",$J,"QMAN",X)) Q:X="" S Y=Y+1,^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,Y,0)=X,^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,"B",X,Y)="",^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,0)="^9002086.8910101A^"_Y_"^"_Y
- K X,Y,Z,BWGRQMAN,V,AMQQSQNM
- K ^XTMP("BWGRVL",$J,"QMAN")
- Q
- R ;EP
- S DIR(0)=$P(^BWGRI(BWGRCRIT,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
- S ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,0)=BWGRCRIT,^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT,BWGRCRIT)=""
- S BWGRCNT=BWGRCNT+1,^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,BWGRCNT,0)=$P(Y,U),^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,"B",$P(Y,U),BWGRCNT)="",^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,0)="^9002086.8910101A^"_BWGRCNT_"^"_BWGRCNT
- G R
- Q
- D ;DATE RANGE
- BD ;get beginning date
- W ! S DIR(0)="D^::EP",DIR("A")="Enter beginning "_BWGRTEXT_" for Search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) Q
- S BWGRBDAT=Y
- ED ;get ending date
- W ! S DIR(0)="D^"_BWGRBDAT_"::EP",DIR("A")="Enter ending "_BWGRTEXT_" for Search" S Y=BWGRBDAT D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) G BD
- S BWGREDAT=Y
- S X1=BWGRBDAT,X2=-1 D C^%DTC S BWGRSDAT=X
- ;
- S ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,0)=BWGRCRIT,^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT,BWGRCRIT)=""
- S BWGRCNT=0,^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,BWGRCNT)="^9002086.8910101A^1^1" S BWGRCNT=BWGRCNT+1,^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,1,0)=BWGRBDAT_U_BWGREDAT,^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,"B",BWGRBDAT,BWGRCNT)=""
- Q
- N ;EP
- K ^BWGRTRPT(BWGRRPT,11,BWGRCRIT),^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT)
- 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(^BWGRI(BWGRCRIT,25)) S X=Y X ^(25) I '$D(X),$D(^BWGRI(BWGRCRIT,26)) W !! X ^(26) G N ;if input tx exists and fails G N
- I '$D(^BWGRI(BWGRCRIT,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 ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,0)=BWGRCRIT,^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT,BWGRCRIT)=""
- S ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,0)="^9002086.8910101A^1^1" S ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,1,0)=$P(Y,"-"),^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,"B",$P(Y,"-"),1)=""
- S $P(^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,1,0),U,2)=$P(Y,"-",2)
- Q
- J ;EP - JUST A HIT
- S ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,0)=BWGRCRIT,^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT,BWGRCRIT)=""
- S ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,1,0)=1,^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,"B",1,1)="",^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,0)="^9002086.8910101A^"_1_"^"_1
- Q
- Y ;EP - called from apclvl0
- S DIR(0)="S^1:"_BWGRTEXT_";0:NO "_BWGRTEXT_"",DIR("A")="Should "_$S(BWGRPTVS="P":"patient",1:"procedure")_" have",DIR("B")="1" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- Q:$D(DIRUT)
- Q:Y=""
- S ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,0)=BWGRCRIT,^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT,BWGRCRIT)=""
- S ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,1,0)=Y,^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,"B",Y,1)="",^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,0)="^9002086.8910101A^"_1_"^"_1
- Q
- F ;FREE TEXT RANGE
- K ^BWGRTRPT(BWGRRPT,11,BWGRCRIT),^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT)
- 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 ",BWGRTEXT," will be included." Q
- I $D(^BWGRI(BWGRCRIT,21)) S X=Y X ^(21) I '$D(X),$D(^BWGRI(BWGRCRIT,22)) W !! X ^(22) G F ;if input tx exists and fails G N
- I '$D(^BWGRI(BWGRCRIT,21)),Y'?1.ANP1":"1.ANP W !!,$C(7),$C(7),"Enter a free text range in the format AAA:AAA. E.g. 94-01:94-200,CA:CZ, A:Z." G F
- S ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,0)=BWGRCRIT,^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT,BWGRCRIT)=""
- S BWGRCNT=0,^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,BWGRCNT,0)="^9002086.8910101A^1^1" S BWGRCNT=BWGRCNT+1,^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,1,0)=$P(X,":")_U_$P(X,":",2),^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,"B",$P(X,":"),BWGRCNT)=""
- Q
- BWGRVL0 ; IHS/CMI/LAB - SCREEN LOGIC ;03-Sep-2003 20:09;PLS
- +1 ;;2.0;WOMEN'S HEALTH;**6,8,9**;MAY 16, 1996
- +2 ;
- +3 ;IHS/CMI/LAB - modified file numbers
- +4 ;
- Q ;EP
- +1 KILL ^XTMP("BWGRVL",$JOB,"QMAN"),^UTILITY("AMQQ TAX",$JOB)
- +2 KILL DIC,X,Y,DD
- SET X=$PIECE(^BWGRI(BWGRCRIT,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 BWGRQMAN=+Y
- +4 IF $PIECE(^BWGRI(BWGRCRIT,0),U)="Cause of Injury"
- SET AMQQSQNM="CAUSE OF INJURY"
- +5 DO ^AMQQGTX0(BWGRQMAN,"^XTMP(""BWGRVL"",$J,""QMAN"",")
- +6 IF '$DATA(^XTMP("BWGRVL",$JOB,"QMAN"))
- WRITE !!,$CHAR(7),"** No ",$PIECE(^BWGRI(BWGRCRIT,0),U)," selected, all will be included."
- QUIT
- +7 IF $DATA(^XTMP("BWGRVL",$JOB,"QMAN","*"))
- KILL ^XTMP("BWGRVL",$JOB,"QMAN")
- +8 SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,0)=BWGRCRIT
- SET ^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT,BWGRCRIT)=""
- +9 SET X=""
- SET Y=0
- FOR
- SET X=$ORDER(^XTMP("BWGRVL",$JOB,"QMAN",X))
- IF X=""
- QUIT
- SET Y=Y+1
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,Y,0)=X
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,"B",X,Y)=""
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,0)="^9002086.8910101A^"_Y_"^"_Y
- +10 KILL X,Y,Z,BWGRQMAN,V,AMQQSQNM
- +11 KILL ^XTMP("BWGRVL",$JOB,"QMAN")
- +12 QUIT
- R ;EP
- +1 SET DIR(0)=$PIECE(^BWGRI(BWGRCRIT,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 SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,0)=BWGRCRIT
- SET ^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT,BWGRCRIT)=""
- +5 SET BWGRCNT=BWGRCNT+1
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,BWGRCNT,0)=$PIECE(Y,U)
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,"B",$PIECE(Y,U),BWGRCNT)=""
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,0)="^9002086.8910101A^"_BWGRCNT_"^"_BWGRCNT
- +6 GOTO R
- +7 QUIT
- D ;DATE RANGE
- BD ;get beginning date
- +1 WRITE !
- SET DIR(0)="D^::EP"
- SET DIR("A")="Enter beginning "_BWGRTEXT_" for Search"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +2 IF $DATA(DIRUT)
- QUIT
- +3 SET BWGRBDAT=Y
- ED ;get ending date
- +1 WRITE !
- SET DIR(0)="D^"_BWGRBDAT_"::EP"
- SET DIR("A")="Enter ending "_BWGRTEXT_" for Search"
- SET Y=BWGRBDAT
- 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 BWGREDAT=Y
- +4 SET X1=BWGRBDAT
- SET X2=-1
- DO C^%DTC
- SET BWGRSDAT=X
- +5 ;
- +6 SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,0)=BWGRCRIT
- SET ^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT,BWGRCRIT)=""
- +7 SET BWGRCNT=0
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,BWGRCNT)="^9002086.8910101A^1^1"
- SET BWGRCNT=BWGRCNT+1
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,1,0)=BWGRBDAT_U_BWGREDAT
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,"B",BWGRBDAT,BWGRCNT)=""
- +8 QUIT
- N ;EP
- +1 KILL ^BWGRTRPT(BWGRRPT,11,BWGRCRIT),^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT)
- +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(^BWGRI(BWGRCRIT,25))
- SET X=Y
- XECUTE ^(25)
- IF '$DATA(X)
- IF $DATA(^BWGRI(BWGRCRIT,26))
- WRITE !!
- XECUTE ^(26)
- GOTO N
- +5 IF '$DATA(^BWGRI(BWGRCRIT,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 ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,0)=BWGRCRIT
- SET ^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT,BWGRCRIT)=""
- +7 SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,0)="^9002086.8910101A^1^1"
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,1,0)=$PIECE(Y,"-")
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,"B",$PIECE(Y,"-"),1)=""
- +8 SET $PIECE(^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,1,0),U,2)=$PIECE(Y,"-",2)
- +9 QUIT
- J ;EP - JUST A HIT
- +1 SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,0)=BWGRCRIT
- SET ^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT,BWGRCRIT)=""
- +2 SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,1,0)=1
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,"B",1,1)=""
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,0)="^9002086.8910101A^"_1_"^"_1
- +3 QUIT
- Y ;EP - called from apclvl0
- +1 SET DIR(0)="S^1:"_BWGRTEXT_";0:NO "_BWGRTEXT_""
- SET DIR("A")="Should "_$SELECT(BWGRPTVS="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 ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,0)=BWGRCRIT
- SET ^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT,BWGRCRIT)=""
- +5 SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,1,0)=Y
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,"B",Y,1)=""
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,0)="^9002086.8910101A^"_1_"^"_1
- +6 QUIT
- F ;FREE TEXT RANGE
- +1 KILL ^BWGRTRPT(BWGRRPT,11,BWGRCRIT),^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT)
- +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 ",BWGRTEXT," will be included."
- QUIT
- +4 ;if input tx exists and fails G N
- IF $DATA(^BWGRI(BWGRCRIT,21))
- SET X=Y
- XECUTE ^(21)
- IF '$DATA(X)
- IF $DATA(^BWGRI(BWGRCRIT,22))
- WRITE !!
- XECUTE ^(22)
- GOTO F
- +5 IF '$DATA(^BWGRI(BWGRCRIT,21))
- IF Y'?1.ANP1":"1.ANP
- WRITE !!,$CHAR(7),$CHAR(7),"Enter a free text range in the format AAA:AAA. E.g. 94-01:94-200,CA:CZ, A:Z."
- GOTO F
- +6 SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,0)=BWGRCRIT
- SET ^BWGRTRPT(BWGRRPT,11,"B",BWGRCRIT,BWGRCRIT)=""
- +7 SET BWGRCNT=0
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,BWGRCNT,0)="^9002086.8910101A^1^1"
- SET BWGRCNT=BWGRCNT+1
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,1,0)=$PIECE(X,":")_U_$PIECE(X,":",2)
- SET ^BWGRTRPT(BWGRRPT,11,BWGRCRIT,11,"B",$PIECE(X,":"),BWGRCNT)=""
- +8 QUIT
