- BMCRL01 ; IHS/PHXAO/TMJ - SCREEN LOGIC ;
- ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
- ;
- ;
- INFORM ;EP
- S BMCTCW=0
- W:$D(IOF) @IOF
- S BMCLHDR="REFERRED CARE INFORMATION SYSTEM (RCIS) GENERAL RETRIEVAL"
- W ?((80-$L(BMCLHDR))/2),BMCLHDR
- W !!!,"This report will list or count referrals based on selection criteria"
- W !,"entered by the user. You will be asked, in 3 separate steps, to identify"
- W !,"your selection criteria, what you wish displayed for each referral",!,"and the sorting order for your list. You may save the logic used to produce"
- W !,"the list for future use. If you design a report that is 80 characters or less",!,"it can be displayed on your screen or printed. If your report is 81-132",!,"characters wide, it must be printed - and only on a printer capable of "
- W !,"producing 132 character lines. ",!
- S (BMCPCNT,BMCPTCT)=0 ;BMCPTCT -- pt total for # of "R"eferrals
- K BMCRDTR,BMCBDD,BMCBD,BMCEDD,BMCED
- K BMCTYPE ;--- just in case variable left around
- Q
- ;
- ADD ;EP
- W !
- I '$D(BMCCAND) G ADD1
- S DIC="^BMCRTMP(",DIC("S")="I $P(^(0),U,2)&($P(^(0),U,6)=BMCPTVS)" S:$D(BMCEP1) DIC("S")=DIC("S")_"&($P(^(0),U,9)=BMCPACK)" S DIC(0)="AEQ",DIC("A")="REPORT NAME: ",D="C" D IX^DIC K DIC,DA,DR
- I Y=-1 S BMCQUIT=1 Q
- S BMCRPT=+Y,BMCCAND=1
- ;--- set up sorting and report control variables
- S BMCSORT=$P(^BMCRTMP(BMCRPT,0),U,7),BMCSORV=$P(^(0),U,8),BMCSPAG=$P(^(0),U,4),BMCCTYP=$P(^(0),U,5)
- S X=0 F S X=$O(^BMCRTMP(BMCRPT,12,X)) Q:X'=+X S BMCTCW=BMCTCW+$P(^BMCRTMP(BMCRPT,12,X,0),U,2)+2
- Q
- ADD1 ;
- ;CREATE REPORT ENTRY IN FILEMAN FILE
- S %H=$H D YX^%DTC S X=$P(^VA(200,DUZ,0),U)_"-"_Y,DIC(0)="L",DIC="^BMCRTMP(",DLAYGO=90001.82,DIADD=1,DIC("DR")=".13////"_DUZ D ^DIC K DIC,DA,DR,DIADD,DLAYGO I Y=-1 W !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!" S BMCQUIT=1 Q
- S BMCRPT=+Y
- K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
- ;DELETE ALL 11 MULTIPLE HERE
- K ^BMCRTMP(BMCRPT,11)
- Q
- PAUSE ;EP
- Q:$E(IOST)'="C"!(IO'=IO(0))
- W ! S DIR(0)="EO",DIR("A")="Hit return to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- Q
- ;
- N ;EP
- K ^BMCRTMP(BMCRPT,11,BMCCRIT),^BMCRTMP(BMCRPT,11,"B",BMCCRIT)
- S DIR(0)="FO^1:11",DIR("A")="Enter a Range of numbers (e.g. 5-12,1-1,10000-99000)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I Y="" W !!,"No numeric range entered. All numerics will be included." Q
- I $D(^BMCTSORT(BMCCRIT,25)) S X=Y X ^(25) I '$D(X) G N ;if input tx exists and fails G N
- I '$D(^BMCTSORT(BMCCRIT,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 ^BMCRTMP(BMCRPT,11,BMCCRIT,0)=BMCCRIT,^BMCRTMP(BMCRPT,11,"B",BMCCRIT,BMCCRIT)=""
- S ^BMCRTMP(BMCRPT,11,BMCCRIT,11,0)="^90001.82110101A^1^1" S ^BMCRTMP(BMCRPT,11,BMCCRIT,11,1,0)=$P(Y,"-"),^BMCRTMP(BMCRPT,11,BMCCRIT,11,"B",$P(Y,"-"),1)=""
- S $P(^BMCRTMP(BMCRPT,11,BMCCRIT,11,1,0),U,2)=$P(Y,"-",2)
- Q
- J ;EP - JUST A HIT
- S ^BMCRTMP(BMCRPT,11,BMCCRIT,0)=BMCCRIT,^BMCRTMP(BMCRPT,11,"B",BMCCRIT,BMCCRIT)=""
- S ^BMCRTMP(BMCRPT,11,BMCCRIT,11,1,0)=1,^BMCRTMP(BMCRPT,11,BMCCRIT,11,"B",1,1)="",^BMCRTMP(BMCRPT,11,BMCCRIT,11,0)="^90001.82110101A^"_1_"^"_1
- Q
- Y ;EP - called from apclvl0
- S DIR(0)="S^1:"_BMCTEXT_";0:NO "_BMCTEXT_"",DIR("A")="Should "_$S(BMCPTVS="P":"patient",1:"referral")_" have",DIR("B")="1" 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 ^BMCRTMP(BMCRPT,11,BMCCRIT,11,1,0)=Y,^BMCRTMP(BMCRPT,11,BMCCRIT,11,"B",Y,1)="",^BMCRTMP(BMCRPT,11,BMCCRIT,11,0)="^90001.82110101A^"_1_"^"_1
- Q
- BMCRL01 ; IHS/PHXAO/TMJ - SCREEN LOGIC ;
- +1 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
- +2 ;
- +3 ;
- INFORM ;EP
- +1 SET BMCTCW=0
- +2 IF $DATA(IOF)
- WRITE @IOF
- +3 SET BMCLHDR="REFERRED CARE INFORMATION SYSTEM (RCIS) GENERAL RETRIEVAL"
- +4 WRITE ?((80-$LENGTH(BMCLHDR))/2),BMCLHDR
- +5 WRITE !!!,"This report will list or count referrals based on selection criteria"
- +6 WRITE !,"entered by the user. You will be asked, in 3 separate steps, to identify"
- +7 WRITE !,"your selection criteria, what you wish displayed for each referral",!,"and the sorting order for your list. You may save the logic used to produce"
- +8 WRITE !,"the list for future use. If you design a report that is 80 characters or less",!,"it can be displayed on your screen or printed. If your report is 81-132",!,"characters wide, it must be printed - and only on a printer capable of "
- +9 WRITE !,"producing 132 character lines. ",!
- +10 ;BMCPTCT -- pt total for # of "R"eferrals
- SET (BMCPCNT,BMCPTCT)=0
- +11 KILL BMCRDTR,BMCBDD,BMCBD,BMCEDD,BMCED
- +12 ;--- just in case variable left around
- KILL BMCTYPE
- +13 QUIT
- +14 ;
- ADD ;EP
- +1 WRITE !
- +2 IF '$DATA(BMCCAND)
- GOTO ADD1
- +3 SET DIC="^BMCRTMP("
- SET DIC("S")="I $P(^(0),U,2)&($P(^(0),U,6)=BMCPTVS)"
- IF $DATA(BMCEP1)
- SET DIC("S")=DIC("S")_"&($P(^(0),U,9)=BMCPACK)"
- SET DIC(0)="AEQ"
- SET DIC("A")="REPORT NAME: "
- SET D="C"
- DO IX^DIC
- KILL DIC,DA,DR
- +4 IF Y=-1
- SET BMCQUIT=1
- QUIT
- +5 SET BMCRPT=+Y
- SET BMCCAND=1
- +6 ;--- set up sorting and report control variables
- +7 SET BMCSORT=$PIECE(^BMCRTMP(BMCRPT,0),U,7)
- SET BMCSORV=$PIECE(^(0),U,8)
- SET BMCSPAG=$PIECE(^(0),U,4)
- SET BMCCTYP=$PIECE(^(0),U,5)
- +8 SET X=0
- FOR
- SET X=$ORDER(^BMCRTMP(BMCRPT,12,X))
- IF X'=+X
- QUIT
- SET BMCTCW=BMCTCW+$PIECE(^BMCRTMP(BMCRPT,12,X,0),U,2)+2
- +9 QUIT
- ADD1 ;
- +1 ;CREATE REPORT ENTRY IN FILEMAN FILE
- +2 SET %H=$HOROLOG
- DO YX^%DTC
- SET X=$PIECE(^VA(200,DUZ,0),U)_"-"_Y
- SET DIC(0)="L"
- SET DIC="^BMCRTMP("
- SET DLAYGO=90001.82
- SET DIADD=1
- SET DIC("DR")=".13////"_DUZ
- DO ^DIC
- KILL DIC,DA,DR,DIADD,DLAYGO
- IF Y=-1
- WRITE !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!"
- SET BMCQUIT=1
- QUIT
- +3 SET BMCRPT=+Y
- +4 KILL DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
- +5 ;DELETE ALL 11 MULTIPLE HERE
- +6 KILL ^BMCRTMP(BMCRPT,11)
- +7 QUIT
- PAUSE ;EP
- +1 IF $EXTRACT(IOST)'="C"!(IO'=IO(0))
- QUIT
- +2 WRITE !
- SET DIR(0)="EO"
- SET DIR("A")="Hit return to continue...."
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +3 QUIT
- +4 ;
- N ;EP
- +1 KILL ^BMCRTMP(BMCRPT,11,BMCCRIT),^BMCRTMP(BMCRPT,11,"B",BMCCRIT)
- +2 SET DIR(0)="FO^1:11"
- SET DIR("A")="Enter a Range of numbers (e.g. 5-12,1-1,10000-99000)"
- 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(^BMCTSORT(BMCCRIT,25))
- SET X=Y
- XECUTE ^(25)
- IF '$DATA(X)
- GOTO N
- +5 IF '$DATA(^BMCTSORT(BMCCRIT,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 ^BMCRTMP(BMCRPT,11,BMCCRIT,0)=BMCCRIT
- SET ^BMCRTMP(BMCRPT,11,"B",BMCCRIT,BMCCRIT)=""
- +7 SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,0)="^90001.82110101A^1^1"
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,1,0)=$PIECE(Y,"-")
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,"B",$PIECE(Y,"-"),1)=""
- +8 SET $PIECE(^BMCRTMP(BMCRPT,11,BMCCRIT,11,1,0),U,2)=$PIECE(Y,"-",2)
- +9 QUIT
- J ;EP - JUST A HIT
- +1 SET ^BMCRTMP(BMCRPT,11,BMCCRIT,0)=BMCCRIT
- SET ^BMCRTMP(BMCRPT,11,"B",BMCCRIT,BMCCRIT)=""
- +2 SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,1,0)=1
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,"B",1,1)=""
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,0)="^90001.82110101A^"_1_"^"_1
- +3 QUIT
- Y ;EP - called from apclvl0
- +1 SET DIR(0)="S^1:"_BMCTEXT_";0:NO "_BMCTEXT_""
- SET DIR("A")="Should "_$SELECT(BMCPTVS="P":"patient",1:"referral")_" 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 ^BMCRTMP(BMCRPT,11,BMCCRIT,0)=BMCCRIT
- SET ^BMCRTMP(BMCRPT,11,"B",BMCCRIT,BMCCRIT)=""
- +5 SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,1,0)=Y
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,"B",Y,1)=""
- SET ^BMCRTMP(BMCRPT,11,BMCCRIT,11,0)="^90001.82110101A^"_1_"^"_1
- +6 QUIT
