- 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
