- ABPACLG8 ;CHECK LOG MODIFICATIONS REPORT; [ 03/29/91 2:02 PM ]
- ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- W !!,"NOT AN ENTRY POINT - ACCESS DENIED",!! Q
- ;--------------------------------------------------------------------
- RETURNS ;PROCEDURE TO PROCESS RETURN NODES
- S R=0 F I=0:0 D Q:R=""
- .S R=$O(^TMP("ABPACLG1","R",R)) Q:R=""
- .S R1=0 F M=0:0 D Q:R1=""
- ..S R1=$O(^TMP("ABPACLG1","R",R,R1)) Q:R1=""
- ..S RR=0 F J=0:0 D Q:RR=""
- ...S RR=$O(^TMP("ABPACLG1","R",R,R1,RR)) Q:RR=""
- ...S R3=0 F K=0:0 D Q:R3=""
- ....S R3=$O(^TMP("ABPACLG1","R",R,R1,RR,R3)) Q:R3=""
- ....S R4=0 F L=0:0 D Q:R4=""
- .....S R4=$O(^TMP("ABPACLG1","R",R,R1,RR,R3,R4)) Q:R4=""
- .....S Y=^(R4),Y=+$E(Y,4,5)_"/"_+$E(Y,6,7)_"/"_+$E(Y,2,3)
- .....S ABPACHK("XMIT")=Y,ABPAINS=$P(^AUTNINS(RR,0),"^")
- .....S ACCTPT=$P(^DIC(4,R3,0),"^")
- .....S TCNT=TCNT+1 W !!,$J(TCNT,2),".",?4,"It is requested that "
- .....W "check number ",R," in the amount of $",$J(R1,8,2),!?4
- .....W "from ",ABPAINS," originally deposited for",!?4
- .....W ACCTPT," be returned per attached instructions from the "
- .....W "insurer.",!!?4,"This was originally submitted on the "
- .....W "transmittal dated ",ABPACHK("XMIT"),"."
- .....I $Y>46 D ^%AUCLS,HD^ABPACLG4
- Q
- ;--------------------------------------------------------------------
- IMPROPER ;PROCEDURE TO PROCESS IMPROPER NODES
- S R=0 F I=0:0 D Q:R=""
- .S R=$O(^TMP("ABPACLG1","I",R)) Q:R=""
- .S R1=0 F M=0:0 D Q:R1=""
- ..S R1=$O(^TMP("ABPACLG1","I",R,R1)) Q:R1=""
- ..S RR=0 F J=0:0 D Q:RR=""
- ...S RR=$O(^TMP("ABPACLG1","I",R,R1,RR)) Q:RR=""
- ...S R3=0 F K=0:0 D Q:R3=""
- ....S R3=$O(^TMP("ABPACLG1","I",R,R1,RR,R3)) Q:R3=""
- ....S R4=0 F L=0:0 D Q:R4=""
- .....S R4=$O(^TMP("ABPACLG1","I",R,R1,RR,R3,R4)) Q:R4=""
- .....S Y=^(R4),Y=+$E(Y,4,5)_"/"_+$E(Y,6,7)_"/"_+$E(Y,2,3)
- .....S ABPACHK("XMIT")=Y,ABPAINS=$P(^AUTNINS(RR,0),"^")
- .....S ACCTPT=$P(^DIC(4,R3,0),"^")
- .....S TCNT=TCNT+1 W !!,$J(TCNT,2),".",?4,"It is requested that "
- .....W "check number ",R," in the amount of $",$J(R1,8,2),!?4
- .....W "from ",ABPAINS," originally deposited for",!?4
- .....W ACCTPT," be deducted from private insurance collections"
- .....W !?4,"as it has been determined the check was not issued "
- .....W "as reimbursement",!?4,"for patient care.",!!?4
- .....W "This was originally submitted on the transmittal dated "
- .....W ABPACHK("XMIT"),"." I $Y>46 D ^%AUCLS,HD^ABPACLG4
- Q
- ABPACLG8 ;CHECK LOG MODIFICATIONS REPORT; [ 03/29/91 2:02 PM ]
- +1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- +2 WRITE !!,"NOT AN ENTRY POINT - ACCESS DENIED",!!
- QUIT
- +3 ;--------------------------------------------------------------------
- RETURNS ;PROCEDURE TO PROCESS RETURN NODES
- +1 SET R=0
- FOR I=0:0
- Begin DoDot:1
- +2 SET R=$ORDER(^TMP("ABPACLG1","R",R))
- IF R=""
- QUIT
- +3 SET R1=0
- FOR M=0:0
- Begin DoDot:2
- +4 SET R1=$ORDER(^TMP("ABPACLG1","R",R,R1))
- IF R1=""
- QUIT
- +5 SET RR=0
- FOR J=0:0
- Begin DoDot:3
- +6 SET RR=$ORDER(^TMP("ABPACLG1","R",R,R1,RR))
- IF RR=""
- QUIT
- +7 SET R3=0
- FOR K=0:0
- Begin DoDot:4
- +8 SET R3=$ORDER(^TMP("ABPACLG1","R",R,R1,RR,R3))
- IF R3=""
- QUIT
- +9 SET R4=0
- FOR L=0:0
- Begin DoDot:5
- +10 SET R4=$ORDER(^TMP("ABPACLG1","R",R,R1,RR,R3,R4))
- IF R4=""
- QUIT
- +11 SET Y=^(R4)
- SET Y=+$EXTRACT(Y,4,5)_"/"_+$EXTRACT(Y,6,7)_"/"_+$EXTRACT(Y,2,3)
- +12 SET ABPACHK("XMIT")=Y
- SET ABPAINS=$PIECE(^AUTNINS(RR,0),"^")
- +13 SET ACCTPT=$PIECE(^DIC(4,R3,0),"^")
- +14 SET TCNT=TCNT+1
- WRITE !!,$JUSTIFY(TCNT,2),".",?4,"It is requested that "
- +15 WRITE "check number ",R," in the amount of $",$JUSTIFY(R1,8,2),!?4
- +16 WRITE "from ",ABPAINS," originally deposited for",!?4
- +17 WRITE ACCTPT," be returned per attached instructions from the "
- +18 WRITE "insurer.",!!?4,"This was originally submitted on the "
- +19 WRITE "transmittal dated ",ABPACHK("XMIT"),"."
- +20 IF $Y>46
- DO ^%AUCLS
- DO HD^ABPACLG4
- End DoDot:5
- IF R4=""
- QUIT
- End DoDot:4
- IF R3=""
- QUIT
- End DoDot:3
- IF RR=""
- QUIT
- End DoDot:2
- IF R1=""
- QUIT
- End DoDot:1
- IF R=""
- QUIT
- +21 QUIT
- +22 ;--------------------------------------------------------------------
- IMPROPER ;PROCEDURE TO PROCESS IMPROPER NODES
- +1 SET R=0
- FOR I=0:0
- Begin DoDot:1
- +2 SET R=$ORDER(^TMP("ABPACLG1","I",R))
- IF R=""
- QUIT
- +3 SET R1=0
- FOR M=0:0
- Begin DoDot:2
- +4 SET R1=$ORDER(^TMP("ABPACLG1","I",R,R1))
- IF R1=""
- QUIT
- +5 SET RR=0
- FOR J=0:0
- Begin DoDot:3
- +6 SET RR=$ORDER(^TMP("ABPACLG1","I",R,R1,RR))
- IF RR=""
- QUIT
- +7 SET R3=0
- FOR K=0:0
- Begin DoDot:4
- +8 SET R3=$ORDER(^TMP("ABPACLG1","I",R,R1,RR,R3))
- IF R3=""
- QUIT
- +9 SET R4=0
- FOR L=0:0
- Begin DoDot:5
- +10 SET R4=$ORDER(^TMP("ABPACLG1","I",R,R1,RR,R3,R4))
- IF R4=""
- QUIT
- +11 SET Y=^(R4)
- SET Y=+$EXTRACT(Y,4,5)_"/"_+$EXTRACT(Y,6,7)_"/"_+$EXTRACT(Y,2,3)
- +12 SET ABPACHK("XMIT")=Y
- SET ABPAINS=$PIECE(^AUTNINS(RR,0),"^")
- +13 SET ACCTPT=$PIECE(^DIC(4,R3,0),"^")
- +14 SET TCNT=TCNT+1
- WRITE !!,$JUSTIFY(TCNT,2),".",?4,"It is requested that "
- +15 WRITE "check number ",R," in the amount of $",$JUSTIFY(R1,8,2),!?4
- +16 WRITE "from ",ABPAINS," originally deposited for",!?4
- +17 WRITE ACCTPT," be deducted from private insurance collections"
- +18 WRITE !?4,"as it has been determined the check was not issued "
- +19 WRITE "as reimbursement",!?4,"for patient care.",!!?4
- +20 WRITE "This was originally submitted on the transmittal dated "
- +21 WRITE ABPACHK("XMIT"),"."
- IF $Y>46
- DO ^%AUCLS
- DO HD^ABPACLG4
- End DoDot:5
- IF R4=""
- QUIT
- End DoDot:4
- IF R3=""
- QUIT
- End DoDot:3
- IF RR=""
- QUIT
- End DoDot:2
- IF R1=""
- QUIT
- End DoDot:1
- IF R=""
- QUIT
- +22 QUIT
