ABPAAGE1 ;COMPILE DETAILED OPEN ITEMS; [ 05/21/91 11:22 AM ]
;;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 INSURER="*** UNKNOWN ***",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 S INSURER=$P(^AUTNINS(+INSPTR,0),"^")
..S FACILITY="*** UNKNOWN ***",FACPTR=$P(^ABPVAO(R,0),"^",2)
..I $D(^AUTTLOC(+FACPTR,0))=1 D
...S FACILITY=$P(^AUTTLOC(+FACPTR,0),"^",2)
..S PAT=$P(^ABPVAO(+R,0),"^"),HRN=+$P(^ABPVAO(+R,0),"^",3),DOS=+DATA
..S SSN=$P(^ABPVAO(+R,0),"^",4) I $L(SSN)=9 D
...S SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,99)
..S AMT=+$P(DATA,"^",7)
..S DATA=SSN_"^^"_DOS_"^"_$P(^DIC(4,+FACPTR,0),"^")_"^"_AMT
..S ^%ZTSK(ZTSK,"AGING",+INSPTR,FACILITY_PAT_HRN,PAT,RR)=DATA
..S ^%ZTSK(ZTSK,"INSURER",INSURER,+INSPTR)=""
Q
;--------------------------------------------------------------------
ZTLOAD ;PROCEDURE TO LOAD BACKGROUND TASK MANAGER WITH JOB REQUEST
S ZTRTN="MAIN^ABPAAGE2",ZTDTH=$H,ZTIO=ABPA("IO")_";132",ZTN=ZTSK
S ZTDESC="PRINT DETAILED OPEN ITEMS"
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
Q
;--------------------------------------------------------------------
MAIN ;ENTRY POINT - CALLED BY TASK MANAGER
D EXTRACT,ZTLOAD,ZTLEND
Q
ABPAAGE1 ;COMPILE DETAILED OPEN ITEMS; [ 05/21/91 11:22 AM ]
+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
+10 SET INSURER="*** UNKNOWN ***"
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
SET INSURER=$PIECE(^AUTNINS(+INSPTR,0),"^")
+16 SET FACILITY="*** UNKNOWN ***"
SET FACPTR=$PIECE(^ABPVAO(R,0),"^",2)
+17 IF $DATA(^AUTTLOC(+FACPTR,0))=1
Begin DoDot:3
+18 SET FACILITY=$PIECE(^AUTTLOC(+FACPTR,0),"^",2)
End DoDot:3
+19 SET PAT=$PIECE(^ABPVAO(+R,0),"^")
SET HRN=+$PIECE(^ABPVAO(+R,0),"^",3)
SET DOS=+DATA
+20 SET SSN=$PIECE(^ABPVAO(+R,0),"^",4)
IF $LENGTH(SSN)=9
Begin DoDot:3
+21 SET SSN=$EXTRACT">EXTRACT">EXTRACT">EXTRACT(SSN,1,3)_"-"_$EXTRACT">EXTRACT">EXTRACT">EXTRACT(SSN,4,5)_"-"_$EXTRACT">EXTRACT">EXTRACT">EXTRACT(SSN,6,99)
End DoDot:3
+22 SET AMT=+$PIECE(DATA,"^",7)
+23 SET DATA=SSN_"^^"_DOS_"^"_$PIECE(^DIC(4,+FACPTR,0),"^")_"^"_AMT
+24 SET ^%ZTSK(ZTSK,"AGING",+INSPTR,FACILITY_PAT_HRN,PAT,RR)=DATA
+25 SET ^%ZTSK(ZTSK,"INSURER",INSURER,+INSPTR)=""
End DoDot:2
IF +RR=0
QUIT
End DoDot:1
IF +R=0
QUIT
+26 QUIT
+27 ;--------------------------------------------------------------------
ZTLOAD ;PROCEDURE TO LOAD BACKGROUND TASK MANAGER WITH JOB REQUEST
+1 SET ZTRTN="MAIN^ABPAAGE2"
SET ZTDTH=$HOROLOG
SET ZTIO=ABPA("IO")_";132"
SET ZTN=ZTSK
+2 SET ZTDESC="PRINT DETAILED OPEN ITEMS"
+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
+3 QUIT
+4 ;--------------------------------------------------------------------
MAIN ;ENTRY POINT - CALLED BY TASK MANAGER
+1 DO EXTRACT
DO ZTLOAD
DO ZTLEND
+2 QUIT
