ABPVPCC3 ;PRINT PRIVATE INSURANCE ELIG O/P VISIT REPORT; [ 06/02/91 12:53 PM ]
;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
START D INIT,HEADING,XTRACT,SUMRY,CLOSE Q
;
INIT S ABPV("PG")=0,LOC=$P(^DIC(4,ABPV("SITE"),0),"^",1),ZTSK=ABPV("TASK")
S TITLE1="*** PRIVATE INSURANCE ELIGIBLE REPORT ***",TITLE2=LOC
S TITLE3="PCC VISITS WITH PRIVATE INSURANCE COVERAGE"
S Y=ABPV("BEG") X ^DD("DD") S A("BEG")=Y
S Y=ABPV("END") X ^DD("DD") S A("END")=Y
S TITLE4="For the period "_A("BEG")_" through "_A("END")
S A("PDT")=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
Q
;
HEADING S ABPV("PG")=ABPV("PG")+1
S A("TM")=$P($H,",",2),A("HR")=A("TM")\3600,A("MIN")=A("TM")#3600\60
S:A("MIN")<10 A("MIN")="0"_A("MIN") S TME=A("HR")_":"_A("MIN")
D ^%AUCLS W A("PDT"),?80-$L(TITLE1)\2,TITLE1,?73,"page ",ABPV("PG"),!
W TME S X="(task "_ZTSK_")" W ?80-$L(X),X,!
W ?80-$L(TITLE2)\2,TITLE2,!,?80-$L(TITLE3)\2,TITLE3,!
W ?80-$L(TITLE4)\2,TITLE4
W !!," D.O.S.",?10,"SVCS",?16,"PATIENT NAME",?38,"CHART #",?47
W "INSURANCE CARRIER(S)",! F I=1:1:79 W "-"
W !
Q
;
XTRACT S A("ADOS")=ABPV("BEG")-1
A S A("ADOS")=$O(^%ZTSK(ZTSK,ABPV("SITE"),A("ADOS")))
Q:+A("ADOS")=0!(A("ADOS")>ABPV("END"))
S ABPV("DOS")=$E(A("ADOS"),4,5)_"/"_$E(A("ADOS"),6,7)_"/"_$E(A("ADOS"),2,3) D:$Y>55 HEADING W !,ABPV("DOS") S A("ADFN")=0
A1 S A("ADFN")=$O(^%ZTSK(ZTSK,ABPV("SITE"),A("ADOS"),A("ADFN"))) G A:+A("ADFN")=0
S A("SVCS")=^%ZTSK(ZTSK,ABPV("SITE"),A("ADOS"),A("ADFN"))
NAME I $D(^DPT(A("ADFN"),0))=0 S A("NAME")="***** ERROR *****" G CHART
S A("NAME")=$P(^DPT(A("ADFN"),0),"^",1),A("NAME")=$E(A("NAME"),1,20)
CHART I $D(^AUPNPAT(A("ADFN"),41,ABPV("SITE"),0))=0 S A("CHART")="***** ERROR *****" G PRINT
S A("CHART")=$P(^AUPNPAT(A("ADFN"),41,ABPV("SITE"),0),"^",2)
PRINT W ?11,A("SVCS"),?16,A("NAME"),?38,$J(A("CHART"),7)
PVTINS S ASM("$Y")=$Y,X=0 F I=1:1 S X=$O(^AUPNPRVT(A("ADFN"),11,X)) Q:X="B"!(X="") S A("PTR")=$P(^AUPNPRVT(A("ADFN"),11,X,0),"^",1) D INSPRT
I ((X="B"!(X=""))&(I=1)) S A("PRT")="" D INSPRT
W:ASM("$Y")=$Y ! G A1
INSPRT I A("PTR")="" W ?47,"***** INCOMPLETE *****" D:$Y>55 HEADING W ! Q
I $D(^AUTNINS(A("PTR"),0))=0 W ?47,"***** INCOMPLETE *****" D:$Y>55 HEADING W ! Q
W ?47,$P(^AUTNINS(A("PTR"),0),"^",1) D:$Y>55 HEADING W ! Q
;
SUMRY W ! F I=1:1:79 W "-"
S:ABPV("TOTAL")=0 ABPV("%")=0
S:ABPV("TOTAL")>0 ABPV("%")=(ABPV("HITS")/ABPV("TOTAL"))*100
W !!,"TOTAL PCC VISITS FOR THIS PERIOD: ",$J(ABPV("TOTAL"),6)
W !,"VISITS WITH THIRD PARTY COVERAGE: ",$J(ABPV("HITS"),6)
W !,"PERCENTAGE PRIVATE INS. COVERAGE: ",$J(ABPV("%"),6,1),"%"
Q
;
CLOSE W @IOF X ^%ZIS("C") K A,ASM,ABPV,LOC,TITLE,X,Y,I Q
ABPVPCC3 ;PRINT PRIVATE INSURANCE ELIG O/P VISIT REPORT; [ 06/02/91 12:53 PM ]
+1 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
START DO INIT
DO HEADING
DO XTRACT
DO SUMRY
DO CLOSE
QUIT
+1 ;
INIT SET ABPV("PG")=0
SET LOC=$PIECE(^DIC(4,ABPV("SITE"),0),"^",1)
SET ZTSK=ABPV("TASK")
+1 SET TITLE1="*** PRIVATE INSURANCE ELIGIBLE REPORT ***"
SET TITLE2=LOC
+2 SET TITLE3="PCC VISITS WITH PRIVATE INSURANCE COVERAGE"
+3 SET Y=ABPV("BEG")
XECUTE ^DD("DD")
SET A("BEG")=Y
+4 SET Y=ABPV("END")
XECUTE ^DD("DD")
SET A("END")=Y
+5 SET TITLE4="For the period "_A("BEG")_" through "_A("END")
+6 SET A("PDT")=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+7 QUIT
+8 ;
HEADING SET ABPV("PG")=ABPV("PG")+1
+1 SET A("TM")=$PIECE($HOROLOG,",",2)
SET A("HR")=A("TM")\3600
SET A("MIN")=A("TM")#3600\60
+2 IF A("MIN")<10
SET A("MIN")="0"_A("MIN")
SET TME=A("HR")_":"_A("MIN")
+3 DO ^%AUCLS
WRITE A("PDT"),?80-$LENGTH(TITLE1)\2,TITLE1,?73,"page ",ABPV("PG"),!
+4 WRITE TME
SET X="(task "_ZTSK_")"
WRITE ?80-$LENGTH(X),X,!
+5 WRITE ?80-$LENGTH(TITLE2)\2,TITLE2,!,?80-$LENGTH(TITLE3)\2,TITLE3,!
+6 WRITE ?80-$LENGTH(TITLE4)\2,TITLE4
+7 WRITE !!," D.O.S.",?10,"SVCS",?16,"PATIENT NAME",?38,"CHART #",?47
+8 WRITE "INSURANCE CARRIER(S)",!
FOR I=1:1:79
WRITE "-"
+9 WRITE !
+10 QUIT
+11 ;
XTRACT SET A("ADOS")=ABPV("BEG")-1
A SET A("ADOS")=$ORDER(^%ZTSK(ZTSK,ABPV("SITE"),A("ADOS")))
+1 IF +A("ADOS")=0!(A("ADOS")>ABPV("END"))
QUIT
+2 SET ABPV("DOS")=$EXTRACT(A("ADOS"),4,5)_"/"_$EXTRACT(A("ADOS"),6,7)_"/"_$EXTRACT(A("ADOS"),2,3)
IF $Y>55
DO HEADING
WRITE !,ABPV("DOS")
SET A("ADFN")=0
A1 SET A("ADFN")=$ORDER(^%ZTSK(ZTSK,ABPV("SITE"),A("ADOS"),A("ADFN")))
IF +A("ADFN")=0
GOTO A
+1 SET A("SVCS")=^%ZTSK(ZTSK,ABPV("SITE"),A("ADOS"),A("ADFN"))
NAME IF $DATA(^DPT(A("ADFN"),0))=0
SET A("NAME")="***** ERROR *****"
GOTO CHART
+1 SET A("NAME")=$PIECE(^DPT(A("ADFN"),0),"^",1)
SET A("NAME")=$EXTRACT(A("NAME"),1,20)
CHART IF $DATA(^AUPNPAT(A("ADFN"),41,ABPV("SITE"),0))=0
SET A("CHART")="***** ERROR *****"
GOTO PRINT
+1 SET A("CHART")=$PIECE(^AUPNPAT(A("ADFN"),41,ABPV("SITE"),0),"^",2)
PRINT WRITE ?11,A("SVCS"),?16,A("NAME"),?38,$JUSTIFY(A("CHART"),7)
PVTINS SET ASM("$Y")=$Y
SET X=0
FOR I=1:1
SET X=$ORDER(^AUPNPRVT(A("ADFN"),11,X))
IF X="B"!(X="")
QUIT
SET A("PTR")=$PIECE(^AUPNPRVT(A("ADFN"),11,X,0),"^",1)
DO INSPRT
+1 IF ((X="B"!(X=""))&(I=1))
SET A("PRT")=""
DO INSPRT
+2 IF ASM("$Y")=$Y
WRITE !
GOTO A1
INSPRT IF A("PTR")=""
WRITE ?47,"***** INCOMPLETE *****"
IF $Y>55
DO HEADING
WRITE !
QUIT
+1 IF $DATA(^AUTNINS(A("PTR"),0))=0
WRITE ?47,"***** INCOMPLETE *****"
IF $Y>55
DO HEADING
WRITE !
QUIT
+2 WRITE ?47,$PIECE(^AUTNINS(A("PTR"),0),"^",1)
IF $Y>55
DO HEADING
WRITE !
QUIT
+3 ;
SUMRY WRITE !
FOR I=1:1:79
WRITE "-"
+1 IF ABPV("TOTAL")=0
SET ABPV("%")=0
+2 IF ABPV("TOTAL")>0
SET ABPV("%")=(ABPV("HITS")/ABPV("TOTAL"))*100
+3 WRITE !!,"TOTAL PCC VISITS FOR THIS PERIOD: ",$JUSTIFY(ABPV("TOTAL"),6)
+4 WRITE !,"VISITS WITH THIRD PARTY COVERAGE: ",$JUSTIFY(ABPV("HITS"),6)
+5 WRITE !,"PERCENTAGE PRIVATE INS. COVERAGE: ",$JUSTIFY(ABPV("%"),6,1),"%"
+6 QUIT
+7 ;
CLOSE WRITE @IOF
XECUTE ^%ZIS("C")
KILL A,ASM,ABPV,LOC,TITLE,X,Y,I
QUIT
