- ABPACLG4 ;CHECK LOG MODIFICATIONS REPORT; [ 03/29/91 12:20 PM ]
- ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- W !!,"NOT AN ENTRY POINT - ACCESS DENIED",!! Q
- ;--------------------------------------------------------------------
- HD ;PROCEDURE TO PERFORM MEMORANDUM HEADING
- S ABPAPG=ABPAPG+1 D CHECK^ABPAOPT I +ABPAOPT(5)>0 D
- .F I=1:1:+ABPAOPT(5) W !
- W ?55,"PAGE ",ABPAPG F I=1:1:5 W !
- W ?12,+$E(ABPADT,4,5)_"/"_+$E(ABPADT,6,7)_"/"_+$E(ABPADT,2,3),!!
- W ?12,ABPAOPT(3),!!!
- W ?12,"Private Insurance Collections"," - "
- W "Control Log Corrections",!!?12,"Finance",!?12
- W $P(^DIC(4,DUZ(2),0),"^"),!!!!
- W ?12,"The following corrections to the private insurance collections"
- W !?12,"control log have been noted by this office:",!!!
- Q
- ;--------------------------------------------------------------------
- EDITS ;PROCEDURE TO PROCESS EDIT NODES
- S R=0 F I=0:0 D Q:R=""
- .S R=$O(^TMP("ABPACLG1","E",R)) Q:R=""
- .S R1=0 F M=0:0 D Q:R1=""
- ..S R1=$O(^TMP("ABPACLG1","E",R,R1)) Q:R1=""
- ..S RR=0 F J=0:0 D Q:RR=""
- ...S RR=$O(^TMP("ABPACLG1","E",R,R1,RR)) Q:RR=""
- ...S R3=0 F K=0:0 D Q:R3=""
- ....S R3=$O(^TMP("ABPACLG1","E",R,R1,RR,R3)) Q:R3=""
- ....S R4=0 F L=0:0 D Q:R4=""
- .....S R4=$O(^TMP("ABPACLG1","E",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 TCNT=TCNT+1 W !!,$J(TCNT,2),".",?4,"Check number ",R
- .....W " in the amount of $",$J(R1,8,2)," from",!?4,ABPAINS
- .....W " has been corrected to read ",R3,!?4,"as of"
- .....W " ",+$E(R4,4,5)_"/"_+$E(R4,6,7)_"/"_+$E(R4,2,3),".",!?4
- .....W "This was originally submitted on the transmittal dated "
- .....W ABPACHK("XMIT"),"." I $Y>46 D ^%AUCLS,HD
- Q
- ;--------------------------------------------------------------------
- END ;PROCEDURE TO PERFORM MEMORANDUM CLOSING
- I $Y>46 D ^%AUCLS S ABPAPG=ABPAPG+1 W ?55,"PAGE ",ABPAPG,!!!!!!!!
- W !!!!!!?45,ABPAOPT(4),!?45,ABPAOPT(10)
- W !?45,$P(^DIC(4,DUZ(2),0),"^")
- D ^%AUCLS
- Q
- ;--------------------------------------------------------------------
- MAIN ;ENTRY POINT - THE MAIN ROUTINE DRIVER
- Q:$D(^TMP("ABPACLG1"))'=10
- S ABPAPG=0,TCNT=0 D ^%AUCLS,HD
- LOCK ^TMP("ABPACLG1")
- D EDITS,IMPROPER^ABPACLG8,RETURNS^ABPACLG8,TXFERS^ABPACLG9,END
- LOCK ^TMP("ABPACLG1")
- K ABPACHK("XMIT"),ABPAINS,ABPAPG,ACCTPT,FROM,I,J,K,L,M,R,R1,R3,R4,R5
- K R6,RR,TCNT,TO
- Q
- ABPACLG4 ;CHECK LOG MODIFICATIONS REPORT; [ 03/29/91 12:20 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 ;--------------------------------------------------------------------
- HD ;PROCEDURE TO PERFORM MEMORANDUM HEADING
- +1 SET ABPAPG=ABPAPG+1
- DO CHECK^ABPAOPT
- IF +ABPAOPT(5)>0
- Begin DoDot:1
- +2 FOR I=1:1:+ABPAOPT(5)
- WRITE !
- End DoDot:1
- +3 WRITE ?55,"PAGE ",ABPAPG
- FOR I=1:1:5
- WRITE !
- +4 WRITE ?12,+$EXTRACT(ABPADT,4,5)_"/"_+$EXTRACT(ABPADT,6,7)_"/"_+$EXTRACT(ABPADT,2,3),!!
- +5 WRITE ?12,ABPAOPT(3),!!!
- +6 WRITE ?12,"Private Insurance Collections"," - "
- +7 WRITE "Control Log Corrections",!!?12,"Finance",!?12
- +8 WRITE $PIECE(^DIC(4,DUZ(2),0),"^"),!!!!
- +9 WRITE ?12,"The following corrections to the private insurance collections"
- +10 WRITE !?12,"control log have been noted by this office:",!!!
- +11 QUIT
- +12 ;--------------------------------------------------------------------
- EDITS ;PROCEDURE TO PROCESS EDIT NODES
- +1 SET R=0
- FOR I=0:0
- Begin DoDot:1
- +2 SET R=$ORDER(^TMP("ABPACLG1","E",R))
- IF R=""
- QUIT
- +3 SET R1=0
- FOR M=0:0
- Begin DoDot:2
- +4 SET R1=$ORDER(^TMP("ABPACLG1","E",R,R1))
- IF R1=""
- QUIT
- +5 SET RR=0
- FOR J=0:0
- Begin DoDot:3
- +6 SET RR=$ORDER(^TMP("ABPACLG1","E",R,R1,RR))
- IF RR=""
- QUIT
- +7 SET R3=0
- FOR K=0:0
- Begin DoDot:4
- +8 SET R3=$ORDER(^TMP("ABPACLG1","E",R,R1,RR,R3))
- IF R3=""
- QUIT
- +9 SET R4=0
- FOR L=0:0
- Begin DoDot:5
- +10 SET R4=$ORDER(^TMP("ABPACLG1","E",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 TCNT=TCNT+1
- WRITE !!,$JUSTIFY(TCNT,2),".",?4,"Check number ",R
- +14 WRITE " in the amount of $",$JUSTIFY(R1,8,2)," from",!?4,ABPAINS
- +15 WRITE " has been corrected to read ",R3,!?4,"as of"
- +16 WRITE " ",+$EXTRACT(R4,4,5)_"/"_+$EXTRACT(R4,6,7)_"/"_+$EXTRACT(R4,2,3),".",!?4
- +17 WRITE "This was originally submitted on the transmittal dated "
- +18 WRITE ABPACHK("XMIT"),"."
- IF $Y>46
- DO ^%AUCLS
- DO HD
- 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
- +19 QUIT
- +20 ;--------------------------------------------------------------------
- END ;PROCEDURE TO PERFORM MEMORANDUM CLOSING
- +1 IF $Y>46
- DO ^%AUCLS
- SET ABPAPG=ABPAPG+1
- WRITE ?55,"PAGE ",ABPAPG,!!!!!!!!
- +2 WRITE !!!!!!?45,ABPAOPT(4),!?45,ABPAOPT(10)
- +3 WRITE !?45,$PIECE(^DIC(4,DUZ(2),0),"^")
- +4 DO ^%AUCLS
- +5 QUIT
- +6 ;--------------------------------------------------------------------
- MAIN ;ENTRY POINT - THE MAIN ROUTINE DRIVER
- +1 IF $DATA(^TMP("ABPACLG1"))'=10
- QUIT
- +2 SET ABPAPG=0
- SET TCNT=0
- DO ^%AUCLS
- DO HD
- +3 LOCK ^TMP("ABPACLG1")
- +4 DO EDITS
- DO IMPROPER^ABPACLG8
- DO RETURNS^ABPACLG8
- DO TXFERS^ABPACLG9
- DO END
- +5 LOCK ^TMP("ABPACLG1")
- +6 KILL ABPACHK("XMIT"),ABPAINS,ABPAPG,ACCTPT,FROM,I,J,K,L,M,R,R1,R3,R4,R5
- +7 KILL R6,RR,TCNT,TO
- +8 QUIT
