Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABPAAGS1

ABPAAGS1.m

Go to the documentation of this file.
  1. 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
  1. W !!?5,"<<< NOT AN ENTRY POINT - ACCESS DENIED >>>",!! G ZTLEND
  1. ;--------------------------------------------------------------------
  1. EXTRACT ;PROCEDURE TO LOOP THROUGH ALL OPEN CLAIMS
  1. S R=0 F I=0:0 D Q:+R=0
  1. .S R=$O(^ABPVAO("CS","O",R)) Q:+R=0
  1. .S RR=0 F J=0:0 D Q:+RR=0
  1. ..S RR=$O(^ABPVAO("CS","O",R,RR)) Q:+RR=0
  1. ..Q:$D(^ABPVAO(R,1,RR,0))'=1
  1. ..S DATA=^ABPVAO(R,1,RR,0)
  1. ..I ABPAOPT(9)=1 S X2=$P(DATA,"^",12)
  1. ..E S X2=$P(DATA,"^",11)
  1. ..Q:X2<BDT!(X2>EDT) S X1=DT D ^%DTC S AGE=+X
  1. ..S INSURER="*** UNKNOWN ***",ZIP="?????",INSPTR=$P(DATA,"^",6)
  1. ..I ABPA("INS")'="ALL" D Q:'FOUND
  1. ...S FOUND=0
  1. ...F K=1:1 Q:($D(ABPA("INS",K))'=1)!(FOUND) D
  1. ....I ABPA("INS",K)=INSPTR S FOUND=1
  1. ..I $D(^AUTNINS(+INSPTR,0))=1 D
  1. ...S INSURER=$P(^AUTNINS(+INSPTR,0),"^"),ZIP=$P(^(0),"^",5)
  1. ..S AMT=+$P(DATA,"^",7)
  1. ..I $D(^%ZTSK(ZTSK,"AGING",+INSPTR))'=1 D
  1. ...S ^%ZTSK(ZTSK,"AGING",+INSPTR)="0^0^0^0"
  1. ..I AGE<60 D
  1. ...S CUR=$P(^%ZTSK(ZTSK,"AGING",+INSPTR),"^")
  1. ...S $P(^%ZTSK(ZTSK,"AGING",+INSPTR),"^")=CUR+AMT
  1. ..I AGE>59&(AGE<90) D
  1. ...S CUR=$P(^%ZTSK(ZTSK,"AGING",+INSPTR),"^",2)
  1. ...S $P(^%ZTSK(ZTSK,"AGING",+INSPTR),"^",2)=CUR+AMT
  1. ..I AGE>89 D
  1. ...S CUR=$P(^%ZTSK(ZTSK,"AGING",+INSPTR),"^",3)
  1. ...S $P(^%ZTSK(ZTSK,"AGING",+INSPTR),"^",3)=CUR+AMT
  1. ..S ^%ZTSK(ZTSK,"INSURER",INSURER_"/.:"_ZIP,+INSPTR)=""
  1. S R=0 F I=0:0 D Q:R=""
  1. .S R=$O(^%ZTSK(ZTSK,"INSURER",R)) Q:R=""
  1. .S RR=0 F J=0:0 D Q:+RR=0
  1. ..S RR=$O(^%ZTSK(ZTSK,"INSURER",R,RR)) Q:+RR=0
  1. ..S P4=0 F J=1:1:3 S P4=P4+$P(^%ZTSK(ZTSK,"AGING",RR),"^",J)
  1. ..S $P(^%ZTSK(ZTSK,"AGING",RR),"^",4)=P4
  1. Q
  1. ;--------------------------------------------------------------------
  1. ZTLOAD ;PROCEDURE TO LOAD BACKGROUND TASK MANAGER WITH JOB REQUEST
  1. S ZTRTN="MAIN^ABPAAGS2",ZTDTH=$H,ZTIO=ABPA("IO")_";80",ZTN=ZTSK
  1. S ZTDESC="PRINT AGED CLAIMS SUMMARY"
  1. S ZTSAVE("BDT")="",ZTSAVE("EDT")="",ZTSAVE("ZTN")=""
  1. S ZTSAVE("ABPATLE")="",ZTSAVE("ABPA(")="" D ^%ZTLOAD
  1. Q
  1. ;--------------------------------------------------------------------
  1. ZTLEND ;PROCEDURE TO KILL ALL LOCALLY USED TEMPORARY VARIABLES
  1. K %DT,%ZIS,%IS,ZTSK,X,Y,BDT,EDT,ZTRTN,ZTSAVE,ZTIO,ZTDESC,ABPA
  1. K DIC,%,IOP,I,K,FOUND,X1,X2,P5,AGE,CUR,R,RR,INSURER,INSPTR
  1. Q
  1. ;--------------------------------------------------------------------
  1. MAIN ;ENTRY POINT - CALLED BY TASK MANAGER
  1. D EXTRACT
  1. D ZTLOAD
  1. D ZTLEND
  1. Q