- 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