- BCHRU1P ; IHS/CMI/LAB - print all visit report ;
- ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
- ;IHS/CMI/LAB - tmp to xtmp
- START ;
- 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 S Y=BCHED D DD^%DT S BCHEDD=Y
- I '$D(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA")) D HEAD W !!,"NO DATA TO REPORT",!! G DONE
- HA ;
- D @("HEAD"_(2-($E(IOST,1,2)="C-")))
- ;set total numbers and print
- S BCHTOTS=(BCHPATS("ST")/60)
- S BCHTOTA=BCHPATS
- S BCHTOTC=BCHPATS("F")
- S BCHTOTT=BCHPATS("M")
- I $Y>(IOSL-3) D HEAD G:$D(BCHQUIT) DONE
- W !?4,"TOTAL",?28,$J($FN(BCHTOTA,",",0),6),?35,"100%",?41,$J($FN(BCHTOTC,",",0),5),?47,"100%",?54,$J($FN(BCHTOTT,",",0),5),?60,"100%",?67,$J($FN(BCHTOTS,",",0),5),?73,"100%",!
- S BCHHA="*Z" F S BCHHA=$O(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA",BCHHA)) Q:BCHHA=""!($D(BCHQUIT)) D
- .S BCHCS=($P(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA",BCHHA),U,4)/60),BCHCA=$P(^(BCHHA),U),BCHCC=$P(^(BCHHA),U,2),BCHCT=$P(^(BCHHA),U,3)
- .I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
- .W !
- .I BCHSUB W !
- .W ?0,$E($P(BCHHA,"|",2),1,25)," ",$E($P(BCHHA,"|"),1,22)
- .W ?29,$J(BCHCA,5),?35,$S(BCHTOTA:$J(((BCHCA/BCHTOTA)*100),3,0),1:$J("0",3,0)),"%"
- .W ?41,$J(BCHCC,5),?47,$S(BCHTOTC:$J(((BCHCC/BCHTOTC)*100),3,0),1:$J("0",3,0)),"%"
- .W ?54,$J(BCHCT,5),?60,$S(BCHTOTT:$J(((BCHCT/BCHTOTT)*100),3,0),1:$J("0",3,0)),"%"
- .W ?67,$J(BCHCS,5,0) W ?73,$S(BCHTOTS:$J(((BCHCS/BCHTOTS)*100),3,0),1:$J("0",3,0)),"%"
- .Q:'BCHSUB
- .W !
- .S BCHSUB1="" F S BCHSUB1=$O(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA",BCHHA,BCHSUB1)) Q:BCHSUB1=""!($D(BCHQUIT)) D
- ..S BCHCS=($P(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA",BCHHA,BCHSUB1),U,4)/60),BCHCA=$P(^(BCHSUB1),U),BCHCC=$P(^(BCHSUB1),U,2),BCHCT=$P(^(BCHSUB1),U,3)
- ..I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
- ..W !?2,$P(BCHSUB1,"|",2)," ",$E($P(BCHSUB1,"|"),1,22)
- ..W ?29,$J(BCHCA,5) W ?35,$S(BCHTOTA:$J(((BCHCA/BCHTOTA)*100),3,0),1:$J("0",3,0)),"%"
- ..W ?41,$J(BCHCC,5),?47,$S(BCHTOTC:$J(((BCHCC/BCHTOTC)*100),3,0),1:$J("0",3,0)),"%"
- ..W ?54,$J(BCHCT,5),?60,$S(BCHTOTT:$J(((BCHCT/BCHTOTT)*100),3,0),1:$J("0",3,0)),"%"
- ..W ?67,$J(BCHCS,5,0),?73,$S(BCHTOTS:$J(((BCHCS/BCHTOTS)*100),3,0),1:$J("0",3,0)),"%"
- ..Q
- DONE ;
- D DONE^BCHUTIL1
- K ^XTMP("BCHRU1",BCHJOB,BCHBTH),BCHJOB,BCHBTH
- Q
- HEAD ;
- 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="********** UNDUPLICATED PATIENT REPORT NO. "_BCHRPT_" **********" W !,$$CTR^BCHRLU(X,80)
- S X="Unduplicated Patient Count by "_BCHCH W !,$$CTR^BCHRLU(X,80)
- S BCHPROGN=$S(BCHPRG:$P(^BCHTPROG(BCHPRG,0),U)_" ("_$P(^(0),U,5)_")",1:"ALL"),X=$L(BCHPROGN)+10
- W !!?((80-X)/2),"PROGRAM: ",BCHPROGN
- S BCHPROVN=$S(BCHPROVT="O":$P(^VA(200,BCHCHR1,0),U),1:"ALL"),X=$L(BCHPROGN)+10
- W !?((80-X)/2),"PROVIDER: ",BCHPROVN
- S X=$L("PATIENTS: "_BCHREGN)
- W !?((80-X)/2),"PATIENTS: ",BCHREGN
- W !?17,"REPORT DATES: ",BCHBDD," TO ",BCHEDD,!
- W !!?3,BCHCH,?31,"# PATIENTS",?44,"# FEMALES",?56,"# MALES",?69,"SERVICE"
- W !?69,"HOURS"
- W !,$TR($J(" ",80)," ","-")
- Q
- BCHRU1P ; IHS/CMI/LAB - print all visit report ;
- +1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
- +2 ;IHS/CMI/LAB - tmp to xtmp
- START ;
- +1 DO NOW^%DTC
- SET Y=X
- DO DD^%DT
- SET BCHDT=Y
- +2 KILL BCHQUIT
- SET BCHPG=0
- +3 SET Y=BCHBD
- DO DD^%DT
- SET BCHBDD=Y
- SET Y=BCHED
- DO DD^%DT
- SET BCHEDD=Y
- +4 IF '$DATA(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA"))
- DO HEAD
- WRITE !!,"NO DATA TO REPORT",!!
- GOTO DONE
- HA ;
- +1 DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))
- +2 ;set total numbers and print
- +3 SET BCHTOTS=(BCHPATS("ST")/60)
- +4 SET BCHTOTA=BCHPATS
- +5 SET BCHTOTC=BCHPATS("F")
- +6 SET BCHTOTT=BCHPATS("M")
- +7 IF $Y>(IOSL-3)
- DO HEAD
- IF $DATA(BCHQUIT)
- GOTO DONE
- +8 WRITE !?4,"TOTAL",?28,$JUSTIFY($FNUMBER(BCHTOTA,",",0),6),?35,"100%",?41,$JUSTIFY($FNUMBER(BCHTOTC,",",0),5),?47,"100%",?54,$JUSTIFY($FNUMBER(BCHTOTT,",",0),5),?60,"100%",?67,$JUSTIFY($FNUMBER(BCHTOTS,",",0),5),?73,"100%",!
- +9 SET BCHHA="*Z"
- FOR
- SET BCHHA=$ORDER(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA",BCHHA))
- IF BCHHA=""!($DATA(BCHQUIT))
- QUIT
- Begin DoDot:1
- +10 SET BCHCS=($PIECE(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA",BCHHA),U,4)/60)
- SET BCHCA=$PIECE(^(BCHHA),U)
- SET BCHCC=$PIECE(^(BCHHA),U,2)
- SET BCHCT=$PIECE(^(BCHHA),U,3)
- +11 IF $Y>(IOSL-4)
- DO HEAD
- IF $DATA(BCHQUIT)
- QUIT
- +12 WRITE !
- +13 IF BCHSUB
- WRITE !
- +14 WRITE ?0,$EXTRACT($PIECE(BCHHA,"|",2),1,25)," ",$EXTRACT($PIECE(BCHHA,"|"),1,22)
- +15 WRITE ?29,$JUSTIFY(BCHCA,5),?35,$SELECT(BCHTOTA:$JUSTIFY(((BCHCA/BCHTOTA)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
- +16 WRITE ?41,$JUSTIFY(BCHCC,5),?47,$SELECT(BCHTOTC:$JUSTIFY(((BCHCC/BCHTOTC)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
- +17 WRITE ?54,$JUSTIFY(BCHCT,5),?60,$SELECT(BCHTOTT:$JUSTIFY(((BCHCT/BCHTOTT)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
- +18 WRITE ?67,$JUSTIFY(BCHCS,5,0)
- WRITE ?73,$SELECT(BCHTOTS:$JUSTIFY(((BCHCS/BCHTOTS)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
- +19 IF 'BCHSUB
- QUIT
- +20 WRITE !
- +21 SET BCHSUB1=""
- FOR
- SET BCHSUB1=$ORDER(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA",BCHHA,BCHSUB1))
- IF BCHSUB1=""!($DATA(BCHQUIT))
- QUIT
- Begin DoDot:2
- +22 SET BCHCS=($PIECE(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA",BCHHA,BCHSUB1),U,4)/60)
- SET BCHCA=$PIECE(^(BCHSUB1),U)
- SET BCHCC=$PIECE(^(BCHSUB1),U,2)
- SET BCHCT=$PIECE(^(BCHSUB1),U,3)
- +23 IF $Y>(IOSL-4)
- DO HEAD
- IF $DATA(BCHQUIT)
- QUIT
- +24 WRITE !?2,$PIECE(BCHSUB1,"|",2)," ",$EXTRACT($PIECE(BCHSUB1,"|"),1,22)
- +25 WRITE ?29,$JUSTIFY(BCHCA,5)
- WRITE ?35,$SELECT(BCHTOTA:$JUSTIFY(((BCHCA/BCHTOTA)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
- +26 WRITE ?41,$JUSTIFY(BCHCC,5),?47,$SELECT(BCHTOTC:$JUSTIFY(((BCHCC/BCHTOTC)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
- +27 WRITE ?54,$JUSTIFY(BCHCT,5),?60,$SELECT(BCHTOTT:$JUSTIFY(((BCHCT/BCHTOTT)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
- +28 WRITE ?67,$JUSTIFY(BCHCS,5,0),?73,$SELECT(BCHTOTS:$JUSTIFY(((BCHCS/BCHTOTS)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
- +29 QUIT
- End DoDot:2
- End DoDot:1
- DONE ;
- +1 DO DONE^BCHUTIL1
- +2 KILL ^XTMP("BCHRU1",BCHJOB,BCHBTH),BCHJOB,BCHBTH
- +3 QUIT
- HEAD ;
- +1 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="********** UNDUPLICATED PATIENT REPORT NO. "_BCHRPT_" **********"
- WRITE !,$$CTR^BCHRLU(X,80)
- +5 SET X="Unduplicated Patient Count by "_BCHCH
- WRITE !,$$CTR^BCHRLU(X,80)
- +6 SET BCHPROGN=$SELECT(BCHPRG:$PIECE(^BCHTPROG(BCHPRG,0),U)_" ("_$PIECE(^(0),U,5)_")",1:"ALL")
- SET X=$LENGTH(BCHPROGN)+10
- +7 WRITE !!?((80-X)/2),"PROGRAM: ",BCHPROGN
- +8 SET BCHPROVN=$SELECT(BCHPROVT="O":$PIECE(^VA(200,BCHCHR1,0),U),1:"ALL")
- SET X=$LENGTH(BCHPROGN)+10
- +9 WRITE !?((80-X)/2),"PROVIDER: ",BCHPROVN
- +10 SET X=$LENGTH("PATIENTS: "_BCHREGN)
- +11 WRITE !?((80-X)/2),"PATIENTS: ",BCHREGN
- +12 WRITE !?17,"REPORT DATES: ",BCHBDD," TO ",BCHEDD,!
- +13 WRITE !!?3,BCHCH,?31,"# PATIENTS",?44,"# FEMALES",?56,"# MALES",?69,"SERVICE"
- +14 WRITE !?69,"HOURS"
- +15 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
- +16 QUIT
