- BMCRL0 ; IHS/PHXAO/TMJ - SCREEN LOGIC ;
- ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
- ;IHS/ITSC/FCJ ADDED TO TEST FOR CANNED REPORT
- ;
- ;
- Q ;EP
- K ^XTMP("BMCRL",$J,"QMAN"),^UTILITY("AMQQ TAX",$J),DIC,X,Y,DD
- S X=$P(^BMCTSORT(BMCCRIT,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 BMCQMAN=+Y
- D ^AMQQGTX0(BMCQMAN,"^XTMP(""BMCRL"",$J,""QMAN"",")
- I '$D(^XTMP("BMCRL",$J,"QMAN")) W !!,$C(7),"** No ",$P(^BMCTSORT(BMCCRIT,0),U)," selected, all will be included." Q
- I $D(^XTMP("BMCRL",$J,"QMAN","*")) K ^XTMP("BMCRL",$J,"QMAN")
- S ^BMCRTMP(BMCRPT,11,BMCCRIT,0)=BMCCRIT,^BMCRTMP(BMCRPT,11,"B",BMCCRIT,BMCCRIT)=""
- S X="",Y=0
- F S X=$O(^XTMP("BMCRL",$J,"QMAN",X)) Q:X="" S Y=Y+1,^BMCRTMP(BMCRPT,11,BMCCRIT,11,Y,0)=X,^BMCRTMP(BMCRPT,11,BMCCRIT,11,"B",X,Y)="",^BMCRTMP(BMCRPT,11,BMCCRIT,11,0)="^90001.82110101A^"_Y_"^"_Y
- K X,Y,Z,BMCQMAN,V
- K ^XTMP("BMCRL",$J,"QMAN")
- Q
- R ;EP
- S DIR(0)=$P(^BMCTSORT(BMCCRIT,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 ^BMCRTMP(BMCRPT,11,BMCCRIT,0)=BMCCRIT,^BMCRTMP(BMCRPT,11,"B",BMCCRIT,BMCCRIT)=""
- S BMCCNT=BMCCNT+1,^BMCRTMP(BMCRPT,11,BMCCRIT,11,BMCCNT,0)=$P(Y,U)
- S ^BMCRTMP(BMCRPT,11,BMCCRIT,11,"B",$P(Y,U),BMCCNT)=""
- S ^BMCRTMP(BMCRPT,11,BMCCRIT,11,0)="^90001.82110101A^"_BMCCNT_"^"_BMCCNT
- G R
- Q
- D ;EP;DATE RANGE
- BD ;get beginning date
- W ! S DIR(0)="D^::EP",DIR("A")="Enter beginning "_BMCTEXT_" for Search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) Q
- S BMCBD=Y
- ED ;get ending date
- W ! S DIR(0)="D^"_BMCBD_"::EP",DIR("A")="Enter ending "_BMCTEXT_" for Search"
- S Y=BMCBD D DD^%DT S Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) G BD
- S BMCED=Y
- S X1=BMCBD,X2=-1 D C^%DTC S BMCSD=X
- ;
- Q:$D(BMCCAND)
- S ^BMCRTMP(BMCRPT,11,BMCCRIT,0)=BMCCRIT,^BMCRTMP(BMCRPT,11,"B",BMCCRIT,BMCCRIT)=""
- S BMCCNT=0,^BMCRTMP(BMCRPT,11,BMCCRIT,11,BMCCNT,0)="^90001.82110101A^1^1" S BMCCNT=BMCCNT+1,^BMCRTMP(BMCRPT,11,BMCCRIT,11,1,0)=BMCBD_U_BMCED,^BMCRTMP(BMCRPT,11,BMCCRIT,11,"B",BMCBD,BMCCNT)=""
- Q
- N ;
- D N^BMCRL01
- Q
- F ;FREE TEXT RANGE
- K ^BMCRTMP(BMCRPT,11,BMCCRIT),^BMCRTMP(BMCRPT,11,"B",BMCCRIT)
- 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 ",BMCTEXT," will be included." Q
- I $D(^BMCTSORT(BMCCRIT,21)) S X=Y X ^(21) I '$D(X),$D(^BMCTSORT(BMCCRIT,22)) W !! X ^(22) G F ;if input tx exists and fails G N
- I '$D(^BMCTSORT(BMCCRIT,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 ^BMCRTMP(BMCRPT,11,BMCCRIT,0)=BMCCRIT,^BMCRTMP(BMCRPT,11,"B",BMCCRIT,BMCCRIT)=""
- S BMCCNT=0,^BMCRTMP(BMCRPT,11,BMCCRIT,11,BMCCNT,0)="^90001.82110101A^1^1" S BMCCNT=BMCCNT+1,^BMCRTMP(BMCRPT,11,BMCCRIT,11,1,0)=$P(X,":")_U_$P(X,":",2),^BMCRTMP(BMCRPT,11,BMCCRIT,11,"B",$P(X,":"),BMCCNT)=""
- Q
- J ;
- D J^BMCRL01
- Q
- Y ;
- D Y^BMCRL01
- Q
- W ;EP - contains
- K DIR,DTOUT,DUOUT,DIRUT
- W !!,?5,"What phrase do you want to search for in the ",$P(^BMCTSORT(BMCCRIT,0),U),"?",!
- S DIR(0)="FO^2:40",DIR("A")=$P(^BMCTSORT(BMCCRIT,0),U)_" - CONTAIN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- Q:$D(DIRUT)
- Q:Y=""
- S ^BMCRTMP(BMCRPT,11,BMCCRIT,0)=BMCCRIT,^BMCRTMP(BMCRPT,11,"B",BMCCRIT,BMCCRIT)=""
- S BMCCNT=BMCCNT+1,^BMCRTMP(BMCRPT,11,BMCCRIT,11,BMCCNT,0)=$P(Y,U),^BMCRTMP(BMCRPT,11,BMCCRIT,11,"B",$P(Y,U),BMCCNT)="",^BMCRTMP(BMCRPT,11,BMCCRIT,11,0)="^90001.82110101A^"_BMCCNT_"^"_BMCCNT
- G W
- Q
- BMCRL0 ; IHS/PHXAO/TMJ - SCREEN LOGIC ;
- +1 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
- +2 ;IHS/ITSC/FCJ ADDED TO TEST FOR CANNED REPORT
- +3 ;
- +4 ;
- Q ;EP
- +1 KILL ^XTMP("BMCRL",$JOB,"QMAN"),^UTILITY("AMQQ TAX",$JOB),DIC,X,Y,DD
- +2 SET X=$PIECE(^BMCTSORT(BMCCRIT,0),U,3)
- SET DIC="^AMQQ(5,"
- SET DIC(0)="EQXM"
- SET DIC("S")="I $P(^(0),U,14)"
- +3 DO ^DIC
- +4 KILL DIC,DA,DINUM,DICR
- IF Y=-1
- WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
- QUIT
- +5 SET BMCQMAN=+Y
- +6 DO ^AMQQGTX0(BMCQMAN,"^XTMP(""BMCRL"",$J,""QMAN"",")
- +7 IF '$DATA(^XTMP("BMCRL",$JOB,"QMAN"))
- WRITE !!,$CHAR(7),"** No ",$PIECE(^BMCTSORT(BMCCRIT,0),U)," selected, all will be included."
- QUIT
- +8 IF $DATA(^XTMP("BMCRL",$JOB,"QMAN","*"))
- KILL ^XTMP("BMCRL",$JOB,"QMAN")
- +9 SET ^BMCRTMP(BMCRPT,11,BMCCRIT,0)=BMCCRIT
- SET ^BMCRTMP(BMCRPT,11,"B",BMCCRIT,BMCCRIT)=""
- +10 SET X=""
- SET Y=0
- +11 FOR
- SET X=$ORDER(^XTMP("BMCRL",$JOB,"QMAN",X))
- IF X=""
- QUIT
- SET Y=Y+1
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,Y,0)=X
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,"B",X,Y)=""
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,0)="^90001.82110101A^"_Y_"^"_Y
- +12 KILL X,Y,Z,BMCQMAN,V
- +13 KILL ^XTMP("BMCRL",$JOB,"QMAN")
- +14 QUIT
- R ;EP
- +1 SET DIR(0)=$PIECE(^BMCTSORT(BMCCRIT,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 ^BMCRTMP(BMCRPT,11,BMCCRIT,0)=BMCCRIT
- SET ^BMCRTMP(BMCRPT,11,"B",BMCCRIT,BMCCRIT)=""
- +5 SET BMCCNT=BMCCNT+1
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,BMCCNT,0)=$PIECE(Y,U)
- +6 SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,"B",$PIECE(Y,U),BMCCNT)=""
- +7 SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,0)="^90001.82110101A^"_BMCCNT_"^"_BMCCNT
- +8 GOTO R
- +9 QUIT
- D ;EP;DATE RANGE
- BD ;get beginning date
- +1 WRITE !
- SET DIR(0)="D^::EP"
- SET DIR("A")="Enter beginning "_BMCTEXT_" for Search"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +2 IF $DATA(DIRUT)
- QUIT
- +3 SET BMCBD=Y
- ED ;get ending date
- +1 WRITE !
- SET DIR(0)="D^"_BMCBD_"::EP"
- SET DIR("A")="Enter ending "_BMCTEXT_" for Search"
- +2 SET Y=BMCBD
- DO DD^%DT
- SET Y=""
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +3 IF $DATA(DIRUT)
- GOTO BD
- +4 SET BMCED=Y
- +5 SET X1=BMCBD
- SET X2=-1
- DO C^%DTC
- SET BMCSD=X
- +6 ;
- +7 IF $DATA(BMCCAND)
- QUIT
- +8 SET ^BMCRTMP(BMCRPT,11,BMCCRIT,0)=BMCCRIT
- SET ^BMCRTMP(BMCRPT,11,"B",BMCCRIT,BMCCRIT)=""
- +9 SET BMCCNT=0
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,BMCCNT,0)="^90001.82110101A^1^1"
- SET BMCCNT=BMCCNT+1
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,1,0)=BMCBD_U_BMCED
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,"B",BMCBD,BMCCNT)=""
- +10 QUIT
- N ;
- +1 DO N^BMCRL01
- +2 QUIT
- F ;FREE TEXT RANGE
- +1 KILL ^BMCRTMP(BMCRPT,11,BMCCRIT),^BMCRTMP(BMCRPT,11,"B",BMCCRIT)
- +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 ",BMCTEXT," will be included."
- QUIT
- +4 ;if input tx exists and fails G N
- IF $DATA(^BMCTSORT(BMCCRIT,21))
- SET X=Y
- XECUTE ^(21)
- IF '$DATA(X)
- IF $DATA(^BMCTSORT(BMCCRIT,22))
- WRITE !!
- XECUTE ^(22)
- GOTO F
- +5 IF '$DATA(^BMCTSORT(BMCCRIT,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 ^BMCRTMP(BMCRPT,11,BMCCRIT,0)=BMCCRIT
- SET ^BMCRTMP(BMCRPT,11,"B",BMCCRIT,BMCCRIT)=""
- +7 SET BMCCNT=0
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,BMCCNT,0)="^90001.82110101A^1^1"
- SET BMCCNT=BMCCNT+1
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,1,0)=$PIECE(X,":")_U_$PIECE(X,":",2)
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,"B",$PIECE(X,":"),BMCCNT)=""
- +8 QUIT
- J ;
- +1 DO J^BMCRL01
- +2 QUIT
- Y ;
- +1 DO Y^BMCRL01
- +2 QUIT
- W ;EP - contains
- +1 KILL DIR,DTOUT,DUOUT,DIRUT
- +2 WRITE !!,?5,"What phrase do you want to search for in the ",$PIECE(^BMCTSORT(BMCCRIT,0),U),"?",!
- +3 SET DIR(0)="FO^2:40"
- SET DIR("A")=$PIECE(^BMCTSORT(BMCCRIT,0),U)_" - CONTAIN"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +4 IF $DATA(DIRUT)
- QUIT
- +5 IF Y=""
- QUIT
- +6 SET ^BMCRTMP(BMCRPT,11,BMCCRIT,0)=BMCCRIT
- SET ^BMCRTMP(BMCRPT,11,"B",BMCCRIT,BMCCRIT)=""
- +7 SET BMCCNT=BMCCNT+1
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,BMCCNT,0)=$PIECE(Y,U)
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,"B",$PIECE(Y,U),BMCCNT)=""
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,0)="^90001.82110101A^"_BMCCNT_"^"_BMCCNT
- +8 GOTO W
- +9 QUIT
