- BCHRC1P ; 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("BCHRC1",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=($P(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA","*TOTAL*"),U,2)/60),BCHTOTA=$P(^("*TOTAL*"),U),BCHTOTC=$P(^("*TOTAL*"),U,4),BCHTOTT=($P(^("*TOTAL*"),U,3)/60)
- I $Y>(IOSL-3) D HEAD G:$D(BCHQUIT) DONE
- W !?4,"TOTAL",?28,$J($FN(BCHTOTS,",",0),6),?35,"100%",?41,$J($FN(BCHTOTT,",",0),5),?47,"100%",?54,$J($FN(BCHTOTC,",",0),5),?60,"100%",?67,$J($FN(BCHTOTA,",",0),5),?73,"100%",!
- S BCHHA="*Z" F S BCHHA=$O(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA",BCHHA)) Q:BCHHA=""!($D(BCHQUIT)) D
- .S BCHCS=($P(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA",BCHHA),U,2)/60),BCHCA=$P(^(BCHHA),U),BCHCC=$P(^(BCHHA),U,4),BCHCT=($P(^(BCHHA),U,3)/60)
- .I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
- .W !
- .I BCHSUB W !
- .W $P(BCHHA,"|",2)," ",$E($P(BCHHA,"|"),1,22)
- .W ?29,$J(BCHCS,5,0) W ?35,$S(BCHTOTS:$J(((BCHCS/BCHTOTS)*100),3,0),1:$J("0",3,0)),"%"
- .W ?41,$J(BCHCT,5,0),?47,$S(BCHTOTT:$J(((BCHCT/BCHTOTT)*100),3,0),1:$J("0",3,0)),"%"
- .W ?54,$J(BCHCC,5),?60,$S(BCHTOTC:$J(((BCHCC/BCHTOTC)*100),3,0),1:$J("0",3,0)),"%"
- .W ?67,$J(BCHCA,5),?73,$S(BCHTOTA:$J(((BCHCA/BCHTOTA)*100),3,0),1:$J("0",3,0)),"%"
- .Q:'BCHSUB
- .W !
- .S BCHSUB1="" F S BCHSUB1=$O(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA",BCHHA,BCHSUB1)) Q:BCHSUB1=""!($D(BCHQUIT)) D
- ..S BCHCS=($P(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA",BCHHA,BCHSUB1),U,2)/60),BCHCA=$P(^(BCHSUB1),U),BCHCC=$P(^(BCHSUB1),U,4),BCHCT=($P(^(BCHSUB1),U,3)/60)
- ..I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
- ..W !?2,$P(BCHSUB1,"|",2)," ",$E($P(BCHSUB1,"|"),1,22)
- ..W ?29,$J(BCHCS,5,0) W ?35,$S(BCHTOTS:$J(((BCHCS/BCHTOTS)*100),3,0),1:$J("0",3,0)),"%"
- ..W ?41,$J(BCHCT,5,0),?47,$S(BCHTOTT:$J(((BCHCT/BCHTOTT)*100),3,0),1:$J("0",3,0)),"%"
- ..W ?54,$J(BCHCC,5),?60,$S(BCHTOTC:$J(((BCHCC/BCHTOTC)*100),3,0),1:$J("0",3,0)),"%"
- ..W ?67,$J(BCHCA,5),?73,$S(BCHTOTA:$J(((BCHCA/BCHTOTA)*100),3,0),1:$J("0",3,0)),"%"
- ..Q
- DONE ;
- D DONE^BCHUTIL1
- K ^XTMP("BCHRC1",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),!
- W !?20,"********** CHR REPORT NO. ",BCHRPT," **********"
- W !?((80-($L(BCHCH)+47))/2),"TIME SPENT, ",$S(BCHRPT=3:"# SERVED",1:"SERVICE ACTIVITIES"),", AND SERVICES by ",BCHCH
- 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 !,"* SERVICES is equal to # of Lines of Assessment"
- W !!?3,BCHCH,?31,"SERVICE",?44,"TRAVEL",?56,$S(BCHRPT=3:"NUMBER",1:"SERVICE"),?69,"SERVICES*"
- W !?31,"HOURS",?44,"HOURS",?56,$S(BCHRPT=3:"SERVED",1:"ACTIVITIES")
- W !,$TR($J(" ",80)," ","-")
- Q
- BCHRC1P ; 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("BCHRC1",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=($PIECE(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA","*TOTAL*"),U,2)/60)
- SET BCHTOTA=$PIECE(^("*TOTAL*"),U)
- SET BCHTOTC=$PIECE(^("*TOTAL*"),U,4)
- SET BCHTOTT=($PIECE(^("*TOTAL*"),U,3)/60)
- +4 IF $Y>(IOSL-3)
- DO HEAD
- IF $DATA(BCHQUIT)
- GOTO DONE
- +5 WRITE !?4,"TOTAL",?28,$JUSTIFY($FNUMBER(BCHTOTS,",",0),6),?35,"100%",?41,$JUSTIFY($FNUMBER(BCHTOTT,",",0),5),?47,"100%",?54,$JUSTIFY($FNUMBER(BCHTOTC,",",0),5),?60,"100%",?67,$JUSTIFY($FNUMBER(BCHTOTA,",",0),5),?73,"100%",!
- +6 SET BCHHA="*Z"
- FOR
- SET BCHHA=$ORDER(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA",BCHHA))
- IF BCHHA=""!($DATA(BCHQUIT))
- QUIT
- Begin DoDot:1
- +7 SET BCHCS=($PIECE(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA",BCHHA),U,2)/60)
- SET BCHCA=$PIECE(^(BCHHA),U)
- SET BCHCC=$PIECE(^(BCHHA),U,4)
- SET BCHCT=($PIECE(^(BCHHA),U,3)/60)
- +8 IF $Y>(IOSL-4)
- DO HEAD
- IF $DATA(BCHQUIT)
- QUIT
- +9 WRITE !
- +10 IF BCHSUB
- WRITE !
- +11 WRITE $PIECE(BCHHA,"|",2)," ",$EXTRACT($PIECE(BCHHA,"|"),1,22)
- +12 WRITE ?29,$JUSTIFY(BCHCS,5,0)
- WRITE ?35,$SELECT(BCHTOTS:$JUSTIFY(((BCHCS/BCHTOTS)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
- +13 WRITE ?41,$JUSTIFY(BCHCT,5,0),?47,$SELECT(BCHTOTT:$JUSTIFY(((BCHCT/BCHTOTT)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
- +14 WRITE ?54,$JUSTIFY(BCHCC,5),?60,$SELECT(BCHTOTC:$JUSTIFY(((BCHCC/BCHTOTC)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
- +15 WRITE ?67,$JUSTIFY(BCHCA,5),?73,$SELECT(BCHTOTA:$JUSTIFY(((BCHCA/BCHTOTA)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
- +16 IF 'BCHSUB
- QUIT
- +17 WRITE !
- +18 SET BCHSUB1=""
- FOR
- SET BCHSUB1=$ORDER(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA",BCHHA,BCHSUB1))
- IF BCHSUB1=""!($DATA(BCHQUIT))
- QUIT
- Begin DoDot:2
- +19 SET BCHCS=($PIECE(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA",BCHHA,BCHSUB1),U,2)/60)
- SET BCHCA=$PIECE(^(BCHSUB1),U)
- SET BCHCC=$PIECE(^(BCHSUB1),U,4)
- SET BCHCT=($PIECE(^(BCHSUB1),U,3)/60)
- +20 IF $Y>(IOSL-4)
- DO HEAD
- IF $DATA(BCHQUIT)
- QUIT
- +21 WRITE !?2,$PIECE(BCHSUB1,"|",2)," ",$EXTRACT($PIECE(BCHSUB1,"|"),1,22)
- +22 WRITE ?29,$JUSTIFY(BCHCS,5,0)
- WRITE ?35,$SELECT(BCHTOTS:$JUSTIFY(((BCHCS/BCHTOTS)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
- +23 WRITE ?41,$JUSTIFY(BCHCT,5,0),?47,$SELECT(BCHTOTT:$JUSTIFY(((BCHCT/BCHTOTT)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
- +24 WRITE ?54,$JUSTIFY(BCHCC,5),?60,$SELECT(BCHTOTC:$JUSTIFY(((BCHCC/BCHTOTC)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
- +25 WRITE ?67,$JUSTIFY(BCHCA,5),?73,$SELECT(BCHTOTA:$JUSTIFY(((BCHCA/BCHTOTA)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
- +26 QUIT
- End DoDot:2
- End DoDot:1
- DONE ;
- +1 DO DONE^BCHUTIL1
- +2 KILL ^XTMP("BCHRC1",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 WRITE !?20,"********** CHR REPORT NO. ",BCHRPT," **********"
- +5 WRITE !?((80-($LENGTH(BCHCH)+47))/2),"TIME SPENT, ",$SELECT(BCHRPT=3:"# SERVED",1:"SERVICE ACTIVITIES"),", AND SERVICES by ",BCHCH
- +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 !,"* SERVICES is equal to # of Lines of Assessment"
- +14 WRITE !!?3,BCHCH,?31,"SERVICE",?44,"TRAVEL",?56,$SELECT(BCHRPT=3:"NUMBER",1:"SERVICE"),?69,"SERVICES*"
- +15 WRITE !?31,"HOURS",?44,"HOURS",?56,$SELECT(BCHRPT=3:"SERVED",1:"ACTIVITIES")
- +16 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
- +17 QUIT
