BCHRNRL ; IHS/CMI/LAB - CHR Report 1 ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;
START ;
D INFORM
GETDATES ;
BD ;get beginning date
S BCHYEARS=0
W !!,"Please enter the number of years to determine if the patient should be"
W !,"listed on the report. For example, if you want all patients who have"
W !,"been seen in the past 5 years enter 5.",!
S DIR(0)="N^1:100:0",DIR("A")="List patients seen in the past how many years?",DIR("B")="10" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D XIT Q
S BCHYEARS=Y
S BCHBD=$$FMADD^XLFDT(DT,-(BCHYEARS*365))
;
ZIS ;CALL TO XBDBQUE
S XBRP="PRINT^BCHRNRL",XBRC="PROC^BCHRNRL",XBRX="XIT^BCHRNRL",XBNS="BCH"
D ^XBDBQUE
D XIT
Q
ERR W $C(7),$C(7),!,"Must be a valid date and be Today or earlier. Time not allowed!" Q
XIT ;
D EN^XBVK("BCH")
Q
INFORM ;
W:$D(IOF) @IOF
W !?20,"********** NON-REGISTERED PATIENT LIST **********"
W !!,"This report will list all Non-Registered Patients in the CHR Non-Registered"
W !,"patient file who have been seen in the last N number of years you indicate."
W !,"The list will be sorted by DOB, NAME, TRIBE, COMMUNITY",!!
Q
;
PROC ;
S BCHJ=$J,BCHH=$H
S BCHX=0 F S BCHX=$O(^BCHRPAT(BCHX)) Q:BCHX'=+BCHX D
.Q:'$$LASTV(BCHX,BCHBD) ;no visit in time period
.S N=^BCHRPAT(BCHX,0)
.S D=$P(N,U,2) I D="" S D="BLANK"
.S S=$$VAL^XBDIQ1(90002.11,BCHX,.03) I S="" S S="BLANK"
.S T=$$VAL^XBDIQ1(90002.11,BCHX,.05) I T="" S T="BLANK"
.S C=$$VAL^XBDIQ1(90002.11,BCHX,.06) I C="" S C="BLANK"
.S ^XTMP("BCHRNRL",BCHJ,BCHH,"DATA",D,$P(^BCHRPAT(BCHX,0),U,1),S,T,C,BCHX)=""
.Q
Q
LASTV(P,D) ;EP
NEW X,Y,Z,G
S G=0
S X=0 F S X=$O(^BCHR("ANRE",P,X)) Q:X'=+X!(G) D
.S Y=0 F S Y=$O(^BCHR("ANRE",P,X,Y)) Q:Y'=+Y!(G) D
..I X<D Q
..S G=1
Q G
PRINT ;EP
D XTMP^BCHUTIL("BCHRNRL","CHR NON REG PT REPORT")
D NOW^%DTC S Y=X D DD^%DT S BCHDT=Y
K BCHQUIT S BCHPG=0
S Y=BCHBD D DD^%DT S BCHBDD=Y
I '$D(^XTMP("BCHRNRL",BCHJ,BCHH,"DATA")) D HEAD W !!,"NO PATIENTS TO REPORT",!! G DONE
D HEAD
S BCHD="" F S BCHD=$O(^XTMP("BCHRNRL",BCHJ,BCHH,"DATA",BCHD)) Q:BCHD=""!($D(BCHQUIT)) D
.S BCHN="" F S BCHN=$O(^XTMP("BCHRNRL",BCHJ,BCHH,"DATA",BCHD,BCHN)) Q:BCHN=""!($D(BCHQUIT)) D
..S BCHS="" F S BCHS=$O(^XTMP("BCHRNRL",BCHJ,BCHH,"DATA",BCHD,BCHN,BCHS)) Q:BCHS=""!($D(BCHQUIT)) D
...S BCHT="" F S BCHT=$O(^XTMP("BCHRNRL",BCHJ,BCHH,"DATA",BCHD,BCHN,BCHS,BCHT)) Q:BCHT=""!($D(BCHQUIT)) D
....S BCHC="" F S BCHC=$O(^XTMP("BCHRNRL",BCHJ,BCHH,"DATA",BCHD,BCHN,BCHS,BCHT,BCHC)) Q:BCHC=""!($D(BCHQUIT)) D
.....W !,BCHN
.....I BCHD'="BLANK" W ?32,$$DATE(BCHD)
.....I BCHS'="BLANK" W ?42,$E(BCHS)
.....I BCHT'="BLANK" W ?46,$E(BCHT,1,15)
.....I BCHC'="BLANK" W ?63,$E(BCHC,1,15)
DONE ;
I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report. HIT RETURN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
K ^XTMP("BCHRNRL",BCHJ,BCHH),BCHJ,BCHH
Q
DATE(D) ;EP
I D="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
;
HEAD ;
I BCHPG=0 G HEAD2
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BCHQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF
HEAD2 ;
S BCHPG=BCHPG+1
W !,$P(^VA(200,DUZ,0),U,2),?58,BCHDT,?72,"Page ",BCHPG,!
W $$CTR^BCHRLU($$LOC^BCHRLU),!
S X="********** LIST OF NON-REGISTERED PATIENTS **********" W !,$$CTR^BCHRLU(X,80)
S X="SEEN BY THE CHR PROGRAM SINCE "_BCHBDD W !,$$CTR^BCHRLU(X,80)
W !,"NAME",?32,"DOB",?41,"SEX",?46,"TRIBE",?63,"COMMUNITY"
W !,$TR($J("",80)," ","-"),!
Q
BCHRNRL ; IHS/CMI/LAB - CHR Report 1 ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;
START ;
+1 DO INFORM
GETDATES ;
BD ;get beginning date
+1 SET BCHYEARS=0
+2 WRITE !!,"Please enter the number of years to determine if the patient should be"
+3 WRITE !,"listed on the report. For example, if you want all patients who have"
+4 WRITE !,"been seen in the past 5 years enter 5.",!
+5 SET DIR(0)="N^1:100:0"
SET DIR("A")="List patients seen in the past how many years?"
SET DIR("B")="10"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
DO XIT
QUIT
+7 SET BCHYEARS=Y
+8 SET BCHBD=$$FMADD^XLFDT(DT,-(BCHYEARS*365))
+9 ;
ZIS ;CALL TO XBDBQUE
+1 SET XBRP="PRINT^BCHRNRL"
SET XBRC="PROC^BCHRNRL"
SET XBRX="XIT^BCHRNRL"
SET XBNS="BCH"
+2 DO ^XBDBQUE
+3 DO XIT
+4 QUIT
ERR WRITE $CHAR(7),$CHAR(7),!,"Must be a valid date and be Today or earlier. Time not allowed!"
QUIT
XIT ;
+1 DO EN^XBVK("BCH")
+2 QUIT
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !?20,"********** NON-REGISTERED PATIENT LIST **********"
+3 WRITE !!,"This report will list all Non-Registered Patients in the CHR Non-Registered"
+4 WRITE !,"patient file who have been seen in the last N number of years you indicate."
+5 WRITE !,"The list will be sorted by DOB, NAME, TRIBE, COMMUNITY",!!
+6 QUIT
+7 ;
PROC ;
+1 SET BCHJ=$JOB
SET BCHH=$HOROLOG
+2 SET BCHX=0
FOR
SET BCHX=$ORDER(^BCHRPAT(BCHX))
IF BCHX'=+BCHX
QUIT
Begin DoDot:1
+3 ;no visit in time period
IF '$$LASTV(BCHX,BCHBD)
QUIT
+4 SET N=^BCHRPAT(BCHX,0)
+5 SET D=$PIECE(N,U,2)
IF D=""
SET D="BLANK"
+6 SET S=$$VAL^XBDIQ1(90002.11,BCHX,.03)
IF S=""
SET S="BLANK"
+7 SET T=$$VAL^XBDIQ1(90002.11,BCHX,.05)
IF T=""
SET T="BLANK"
+8 SET C=$$VAL^XBDIQ1(90002.11,BCHX,.06)
IF C=""
SET C="BLANK"
+9 SET ^XTMP("BCHRNRL",BCHJ,BCHH,"DATA",D,$PIECE(^BCHRPAT(BCHX,0),U,1),S,T,C,BCHX)=""
+10 QUIT
End DoDot:1
+11 QUIT
LASTV(P,D) ;EP
+1 NEW X,Y,Z,G
+2 SET G=0
+3 SET X=0
FOR
SET X=$ORDER(^BCHR("ANRE",P,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+4 SET Y=0
FOR
SET Y=$ORDER(^BCHR("ANRE",P,X,Y))
IF Y'=+Y!(G)
QUIT
Begin DoDot:2
+5 IF X<D
QUIT
+6 SET G=1
End DoDot:2
End DoDot:1
+7 QUIT G
PRINT ;EP
+1 DO XTMP^BCHUTIL("BCHRNRL","CHR NON REG PT REPORT")
+2 DO NOW^%DTC
SET Y=X
DO DD^%DT
SET BCHDT=Y
+3 KILL BCHQUIT
SET BCHPG=0
+4 SET Y=BCHBD
DO DD^%DT
SET BCHBDD=Y
+5 IF '$DATA(^XTMP("BCHRNRL",BCHJ,BCHH,"DATA"))
DO HEAD
WRITE !!,"NO PATIENTS TO REPORT",!!
GOTO DONE
+6 DO HEAD
+7 SET BCHD=""
FOR
SET BCHD=$ORDER(^XTMP("BCHRNRL",BCHJ,BCHH,"DATA",BCHD))
IF BCHD=""!($DATA(BCHQUIT))
QUIT
Begin DoDot:1
+8 SET BCHN=""
FOR
SET BCHN=$ORDER(^XTMP("BCHRNRL",BCHJ,BCHH,"DATA",BCHD,BCHN))
IF BCHN=""!($DATA(BCHQUIT))
QUIT
Begin DoDot:2
+9 SET BCHS=""
FOR
SET BCHS=$ORDER(^XTMP("BCHRNRL",BCHJ,BCHH,"DATA",BCHD,BCHN,BCHS))
IF BCHS=""!($DATA(BCHQUIT))
QUIT
Begin DoDot:3
+10 SET BCHT=""
FOR
SET BCHT=$ORDER(^XTMP("BCHRNRL",BCHJ,BCHH,"DATA",BCHD,BCHN,BCHS,BCHT))
IF BCHT=""!($DATA(BCHQUIT))
QUIT
Begin DoDot:4
+11 SET BCHC=""
FOR
SET BCHC=$ORDER(^XTMP("BCHRNRL",BCHJ,BCHH,"DATA",BCHD,BCHN,BCHS,BCHT,BCHC))
IF BCHC=""!($DATA(BCHQUIT))
QUIT
Begin DoDot:5
+12 WRITE !,BCHN
+13 IF BCHD'="BLANK"
WRITE ?32,$$DATE(BCHD)
+14 IF BCHS'="BLANK"
WRITE ?42,$EXTRACT(BCHS)
+15 IF BCHT'="BLANK"
WRITE ?46,$EXTRACT(BCHT,1,15)
+16 IF BCHC'="BLANK"
WRITE ?63,$EXTRACT(BCHC,1,15)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
DONE ;
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of report. HIT RETURN"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 KILL ^XTMP("BCHRNRL",BCHJ,BCHH),BCHJ,BCHH
+3 QUIT
DATE(D) ;EP
+1 IF D=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)
+3 ;
HEAD ;
+1 IF BCHPG=0
GOTO HEAD2
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BCHQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
HEAD2 ;
+1 SET BCHPG=BCHPG+1
+2 WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?58,BCHDT,?72,"Page ",BCHPG,!
+3 WRITE $$CTR^BCHRLU($$LOC^BCHRLU),!
+4 SET X="********** LIST OF NON-REGISTERED PATIENTS **********"
WRITE !,$$CTR^BCHRLU(X,80)
+5 SET X="SEEN BY THE CHR PROGRAM SINCE "_BCHBDD
WRITE !,$$CTR^BCHRLU(X,80)
+6 WRITE !,"NAME",?32,"DOB",?41,"SEX",?46,"TRIBE",?63,"COMMUNITY"
+7 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+8 QUIT
