ABPAAGS1 ;COMPILE AGED CLAIMS SUMMARY; [ 05/17/91 3:35 PM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
W !!?5,"<<< NOT AN ENTRY POINT - ACCESS DENIED >>>",!! G ZTLEND
;--------------------------------------------------------------------
S R=0 F I=0:0 D Q:+R=0
.S R=$O(^ABPVAO("CS","O",R)) Q:+R=0
.S RR=0 F J=0:0 D Q:+RR=0
..S RR=$O(^ABPVAO("CS","O",R,RR)) Q:+RR=0
..Q:$D(^ABPVAO(R,1,RR,0))'=1
..S DATA=^ABPVAO(R,1,RR,0)
..I ABPAOPT(9)=1 S X2=$P(DATA,"^",12)
..E S X2=$P(DATA,"^",11)
..Q:X2<BDT!(X2>EDT) S X1=DT D ^%DTC S AGE=+X
..S INSURER="*** UNKNOWN ***",ZIP="?????",INSPTR=$P(DATA,"^",6)
..I ABPA("INS")'="ALL" D Q:'FOUND
...S FOUND=0
...F K=1:1 Q:($D(ABPA("INS",K))'=1)!(FOUND) D
....I ABPA("INS",K)=INSPTR S FOUND=1
..I $D(^AUTNINS(+INSPTR,0))=1 D
...S INSURER=$P(^AUTNINS(+INSPTR,0),"^"),ZIP=$P(^(0),"^",5)
..S AMT=+$P(DATA,"^",7)
..I $D(^%ZTSK(ZTSK,"AGING",+INSPTR))'=1 D
...S ^%ZTSK(ZTSK,"AGING",+INSPTR)="0^0^0^0"
..I AGE<60 D
...S CUR=$P(^%ZTSK(ZTSK,"AGING",+INSPTR),"^")
...S $P(^%ZTSK(ZTSK,"AGING",+INSPTR),"^")=CUR+AMT
..I AGE>59&(AGE<90) D
...S CUR=$P(^%ZTSK(ZTSK,"AGING",+INSPTR),"^",2)
...S $P(^%ZTSK(ZTSK,"AGING",+INSPTR),"^",2)=CUR+AMT
..I AGE>89 D
...S CUR=$P(^%ZTSK(ZTSK,"AGING",+INSPTR),"^",3)
...S $P(^%ZTSK(ZTSK,"AGING",+INSPTR),"^",3)=CUR+AMT
..S ^%ZTSK(ZTSK,"INSURER",INSURER_"/.:"_ZIP,+INSPTR)=""
S R=0 F I=0:0 D Q:R=""
.S R=$O(^%ZTSK(ZTSK,"INSURER",R)) Q:R=""
.S RR=0 F J=0:0 D Q:+RR=0
..S RR=$O(^%ZTSK(ZTSK,"INSURER",R,RR)) Q:+RR=0
..S P4=0 F J=1:1:3 S P4=P4+$P(^%ZTSK(ZTSK,"AGING",RR),"^",J)
..S $P(^%ZTSK(ZTSK,"AGING",RR),"^",4)=P4
Q
;--------------------------------------------------------------------
ZTLOAD ;PROCEDURE TO LOAD BACKGROUND TASK MANAGER WITH JOB REQUEST
S ZTRTN="MAIN^ABPAAGS2",ZTDTH=$H,ZTIO=ABPA("IO")_";80",ZTN=ZTSK
S ZTDESC="PRINT AGED CLAIMS SUMMARY"
S ZTSAVE("BDT")="",ZTSAVE("EDT")="",ZTSAVE("ZTN")=""
S ZTSAVE("ABPATLE")="",ZTSAVE("ABPA(")="" D ^%ZTLOAD
Q
;--------------------------------------------------------------------
ZTLEND ;PROCEDURE TO KILL ALL LOCALLY USED TEMPORARY VARIABLES
K %DT,%ZIS,%IS,ZTSK,X,Y,BDT,EDT,ZTRTN,ZTSAVE,ZTIO,ZTDESC,ABPA
K DIC,%,IOP,I,K,FOUND,X1,X2,P5,AGE,CUR,R,RR,INSURER,INSPTR
Q
;--------------------------------------------------------------------
MAIN ;ENTRY POINT - CALLED BY TASK MANAGER
D EXTRACT
D ZTLOAD
D ZTLEND
Q
ABPAAGS1 ;COMPILE AGED CLAIMS SUMMARY; [ 05/17/91 3:35 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
+2 WRITE !!?5,"<<< NOT AN ENTRY POINT - ACCESS DENIED >>>",!!
GOTO ZTLEND
+3 ;--------------------------------------------------------------------
+1 SET R=0
FOR I=0:0
Begin DoDot:1
+2 SET R=$ORDER(^ABPVAO("CS","O",R))
IF +R=0
QUIT
+3 SET RR=0
FOR J=0:0
Begin DoDot:2
+4 SET RR=$ORDER(^ABPVAO("CS","O",R,RR))
IF +RR=0
QUIT
+5 IF $DATA(^ABPVAO(R,1,RR,0))'=1
QUIT
+6 SET DATA=^ABPVAO(R,1,RR,0)
+7 IF ABPAOPT(9)=1
SET X2=$PIECE(DATA,"^",12)
+8 IF '$TEST
SET X2=$PIECE(DATA,"^",11)
+9 IF X2<BDT!(X2>EDT)
QUIT
SET X1=DT
DO ^%DTC
SET AGE=+X
+10 SET INSURER="*** UNKNOWN ***"
SET ZIP="?????"
SET INSPTR=$PIECE(DATA,"^",6)
+11 IF ABPA("INS")'="ALL"
Begin DoDot:3
+12 SET FOUND=0
+13 FOR K=1:1
IF ($DATA(ABPA("INS",K))'=1)!(FOUND)
QUIT
Begin DoDot:4
+14 IF ABPA("INS",K)=INSPTR
SET FOUND=1
End DoDot:4
End DoDot:3
IF 'FOUND
QUIT
+15 IF $DATA(^AUTNINS(+INSPTR,0))=1
Begin DoDot:3
+16 SET INSURER=$PIECE(^AUTNINS(+INSPTR,0),"^")
SET ZIP=$PIECE(^(0),"^",5)
End DoDot:3
+17 SET AMT=+$PIECE(DATA,"^",7)
+18 IF $DATA(^%ZTSK(ZTSK,"AGING",+INSPTR))'=1
Begin DoDot:3
+19 SET ^%ZTSK(ZTSK,"AGING",+INSPTR)="0^0^0^0"
End DoDot:3
+20 IF AGE<60
Begin DoDot:3
+21 SET CUR=$PIECE(^%ZTSK(ZTSK,"AGING",+INSPTR),"^")
+22 SET $PIECE(^%ZTSK(ZTSK,"AGING",+INSPTR),"^")=CUR+AMT
End DoDot:3
+23 IF AGE>59&(AGE<90)
Begin DoDot:3
+24 SET CUR=$PIECE(^%ZTSK(ZTSK,"AGING",+INSPTR),"^",2)
+25 SET $PIECE(^%ZTSK(ZTSK,"AGING",+INSPTR),"^",2)=CUR+AMT
End DoDot:3
+26 IF AGE>89
Begin DoDot:3
+27 SET CUR=$PIECE(^%ZTSK(ZTSK,"AGING",+INSPTR),"^",3)
+28 SET $PIECE(^%ZTSK(ZTSK,"AGING",+INSPTR),"^",3)=CUR+AMT
End DoDot:3
+29 SET ^%ZTSK(ZTSK,"INSURER",INSURER_"/.:"_ZIP,+INSPTR)=""
End DoDot:2
IF +RR=0
QUIT
End DoDot:1
IF +R=0
QUIT
+30 SET R=0
FOR I=0:0
Begin DoDot:1
+31 SET R=$ORDER(^%ZTSK(ZTSK,"INSURER",R))
IF R=""
QUIT
+32 SET RR=0
FOR J=0:0
Begin DoDot:2
+33 SET RR=$ORDER(^%ZTSK(ZTSK,"INSURER",R,RR))
IF +RR=0
QUIT
+34 SET P4=0
FOR J=1:1:3
SET P4=P4+$PIECE(^%ZTSK(ZTSK,"AGING",RR),"^",J)
+35 SET $PIECE(^%ZTSK(ZTSK,"AGING",RR),"^",4)=P4
End DoDot:2
IF +RR=0
QUIT
End DoDot:1
IF R=""
QUIT
+36 QUIT
+37 ;--------------------------------------------------------------------
ZTLOAD ;PROCEDURE TO LOAD BACKGROUND TASK MANAGER WITH JOB REQUEST
+1 SET ZTRTN="MAIN^ABPAAGS2"
SET ZTDTH=$HOROLOG
SET ZTIO=ABPA("IO")_";80"
SET ZTN=ZTSK
+2 SET ZTDESC="PRINT AGED CLAIMS SUMMARY"
+3 SET ZTSAVE("BDT")=""
SET ZTSAVE("EDT")=""
SET ZTSAVE("ZTN")=""
+4 SET ZTSAVE("ABPATLE")=""
SET ZTSAVE("ABPA(")=""
DO ^%ZTLOAD
+5 QUIT
+6 ;--------------------------------------------------------------------
ZTLEND ;PROCEDURE TO KILL ALL LOCALLY USED TEMPORARY VARIABLES
+1 KILL %DT,%ZIS,%IS,ZTSK,X,Y,BDT,EDT,ZTRTN,ZTSAVE,ZTIO,ZTDESC,ABPA
+2 KILL DIC,%,IOP,I,K,FOUND,X1,X2,P5,AGE,CUR,R,RR,INSURER,INSPTR
+3 QUIT
+4 ;--------------------------------------------------------------------
MAIN ;ENTRY POINT - CALLED BY TASK MANAGER
+1 DO EXTRACT
+2 DO ZTLOAD
+3 DO ZTLEND
+4 QUIT
