- 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
