ABPAAR1D ;PRINT UTILIZATION REPORT; [ 04/10/91 1:50 PM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
W !!,"<<< NOT AN ENTRY POINT - ACCESS DENIED >>>",!! Q
COMMA D COMMA^%DTC Q
;
HEAD K ABPA("HD") S ABPA("HD",1)="R E P O R T O F P R I V A T E "
S ABPA("HD",1)=ABPA("HD",1)_"I N S U R A N C E U T I L I Z A T I O N"
S ABPA("HD",2)="for the period "_$E(BDT,4,5)_"/"_$E(BDT,6,7)_"/"_$E(BDT,2,3)_" to "_$E(EDT,4,5)_"/"_$E(EDT,6,7)_"/"_$E(EDT,2,3)
D ^ABPAARHD Q
;
FC S FC=0 F T=1:1:15 S @("T"_T)=0
S TABLST="32^39^47^57^66^74^93^103^112^120^82^39^105^66^112"
S WDLST="6^6^12^6^6^12^12^6^6^12^5^6^6^6^6"
NXTFC S FC=$O(^%ZTSK(ZTSK,"SITE",FC)) G SUM:FC="" S DATA=^%ZTSK(ZTSK,FC)
I ($P(DATA,"^",7)=0)&($P(DATA,"^",10)=0) G NXTFC
D:$Y>55 HEAD W !,FC
F P=1:1:15 S @("P"_P)=$P(DATA,"^",P),@("T"_P)=@("T"_P)+@("P"_P)
F P=1:1:6,11,7:1:10,12,14,13,15 D
.S TAB=$P(TABLST,"^",P),TAB="?"_TAB,WD=$P(WDLST,"^",P)
.S X=@("P"_P) D COMMA F I=1:1:12 Q:$E(X,I)'=" "
.S X=$E(X,I,12) I (P'=3)&(P'=6)&(P'=7)&(P'=10) S X=$P(X,".")
.W:P=12 ! W @TAB,$J(X,WD)
W ! F I=1:1:132 W "-"
G NXTFC
;
SUM W !?5,"S U B - T O T A L"
F T=1:1:6,11,7:1:10,12,14,13,15 D
.S TAB=$P(TABLST,"^",T),TAB="?"_TAB,WD=$P(WDLST,"^",T)
.S X=@("T"_T) D COMMA F I=1:1:12 Q:$E(X,I)'=" "
.S X=$E(X,I,12)
.I (T'=3)&(T'=6)&(T'=7)&(T'=10) S X=$P(X,".")
.W:T=12 ! W @TAB,$J(X,WD)
UNPROC W !!?73,"Plus U N D I S T R I B U T E D T O T A L"
S X=ABPA("UPAMT") D COMMA^%DTC W ?120,X,!?120 F I=1:1:12 W "-"
COLLECT W !?74,"C O L L E C T I O N S F O R P E R I O D"
S X=T10+ABPA("UPAMT") D COMMA^%DTC W ?120,X
REFUNDS W !!?99,"Less R E F U N D S"
S X=ABPA("REF") D COMMA^%DTC W ?120,X
ADJUST W !!?89,"Less A D J U S T M E N T S" S X=ABPA("TRAN")
D COMMA^%DTC W ?120,X,!?120 F I=1:1:12 W "-"
TOTAL W !?86,"T O T A L F O R P E R I O D"
S X=T10+(ABPA("UPAMT"))-(ABPA("REF"))-(ABPA("TRAN"))
D COMMA^%DTC W ?120,X
D ^%AUCLS I $D(A("PRINT",10))=1 W @(A("PRINT",10))
X ^%ZIS("C") S IOP=$I D ^%ZIS K IOP
ZEND K BDT,DATA,EDT,FC,HD,IPT,OPT,CLT,SITENAME,X,A,PDT,ABPAPG,ABPA,PART2
F I=1:1:11 K @("P"_I),@("T"_I)
K I Q
;
START S IOP=ABPA("IO") D ^%ZIS
D ^ABPAPRT I $D(A("PRINT",16))=1 W @(A("PRINT",16))
S ABPAPG=0,ZTSK=ABPA("TASK"),PART2=0 D HEAD G FC
ABPAAR1D ;PRINT UTILIZATION REPORT; [ 04/10/91 1:50 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
+2 WRITE !!,"<<< NOT AN ENTRY POINT - ACCESS DENIED >>>",!!
QUIT
COMMA DO COMMA^%DTC
QUIT
+1 ;
HEAD KILL ABPA("HD")
SET ABPA("HD",1)="R E P O R T O F P R I V A T E "
+1 SET ABPA("HD",1)=ABPA("HD",1)_"I N S U R A N C E U T I L I Z A T I O N"
+2 SET ABPA("HD",2)="for the period "_$EXTRACT(BDT,4,5)_"/"_$EXTRACT(BDT,6,7)_"/"_$EXTRACT(BDT,2,3)_" to "_$EXTRACT(EDT,4,5)_"/"_$EXTRACT(EDT,6,7)_"/"_$EXTRACT(EDT,2,3)
+3 DO ^ABPAARHD
QUIT
+4 ;
FC SET FC=0
FOR T=1:1:15
SET @("T"_T)=0
+1 SET TABLST="32^39^47^57^66^74^93^103^112^120^82^39^105^66^112"
+2 SET WDLST="6^6^12^6^6^12^12^6^6^12^5^6^6^6^6"
NXTFC SET FC=$ORDER(^%ZTSK(ZTSK,"SITE",FC))
IF FC=""
GOTO SUM
SET DATA=^%ZTSK(ZTSK,FC)
+1 IF ($PIECE(DATA,"^",7)=0)&($PIECE(DATA,"^",10)=0)
GOTO NXTFC
+2 IF $Y>55
DO HEAD
WRITE !,FC
+3 FOR P=1:1:15
SET @("P"_P)=$PIECE(DATA,"^",P)
SET @("T"_P)=@("T"_P)+@("P"_P)
+4 FOR P=1:1:6,11,7:1:10,12,14,13,15
Begin DoDot:1
+5 SET TAB=$PIECE(TABLST,"^",P)
SET TAB="?"_TAB
SET WD=$PIECE(WDLST,"^",P)
+6 SET X=@("P"_P)
DO COMMA
FOR I=1:1:12
IF $EXTRACT(X,I)'=" "
QUIT
+7 SET X=$EXTRACT(X,I,12)
IF (P'=3)&(P'=6)&(P'=7)&(P'=10)
SET X=$PIECE(X,".")
+8 IF P=12
WRITE !
WRITE @TAB,$JUSTIFY(X,WD)
End DoDot:1
+9 WRITE !
FOR I=1:1:132
WRITE "-"
+10 GOTO NXTFC
+11 ;
SUM WRITE !?5,"S U B - T O T A L"
+1 FOR T=1:1:6,11,7:1:10,12,14,13,15
Begin DoDot:1
+2 SET TAB=$PIECE(TABLST,"^",T)
SET TAB="?"_TAB
SET WD=$PIECE(WDLST,"^",T)
+3 SET X=@("T"_T)
DO COMMA
FOR I=1:1:12
IF $EXTRACT(X,I)'=" "
QUIT
+4 SET X=$EXTRACT(X,I,12)
+5 IF (T'=3)&(T'=6)&(T'=7)&(T'=10)
SET X=$PIECE(X,".")
+6 IF T=12
WRITE !
WRITE @TAB,$JUSTIFY(X,WD)
End DoDot:1
UNPROC WRITE !!?73,"Plus U N D I S T R I B U T E D T O T A L"
+1 SET X=ABPA("UPAMT")
DO COMMA^%DTC
WRITE ?120,X,!?120
FOR I=1:1:12
WRITE "-"
COLLECT WRITE !?74,"C O L L E C T I O N S F O R P E R I O D"
+1 SET X=T10+ABPA("UPAMT")
DO COMMA^%DTC
WRITE ?120,X
REFUNDS WRITE !!?99,"Less R E F U N D S"
+1 SET X=ABPA("REF")
DO COMMA^%DTC
WRITE ?120,X
ADJUST WRITE !!?89,"Less A D J U S T M E N T S"
SET X=ABPA("TRAN")
+1 DO COMMA^%DTC
WRITE ?120,X,!?120
FOR I=1:1:12
WRITE "-"
TOTAL WRITE !?86,"T O T A L F O R P E R I O D"
+1 SET X=T10+(ABPA("UPAMT"))-(ABPA("REF"))-(ABPA("TRAN"))
+2 DO COMMA^%DTC
WRITE ?120,X
+3 DO ^%AUCLS
IF $DATA(A("PRINT",10))=1
WRITE @(A("PRINT",10))
+4 XECUTE ^%ZIS("C")
SET IOP=$IO
DO ^%ZIS
KILL IOP
ZEND KILL BDT,DATA,EDT,FC,HD,IPT,OPT,CLT,SITENAME,X,A,PDT,ABPAPG,ABPA,PART2
+1 FOR I=1:1:11
KILL @("P"_I),@("T"_I)
+2 KILL I
QUIT
+3 ;
START SET IOP=ABPA("IO")
DO ^%ZIS
+1 DO ^ABPAPRT
IF $DATA(A("PRINT",16))=1
WRITE @(A("PRINT",16))
+2 SET ABPAPG=0
SET ZTSK=ABPA("TASK")
SET PART2=0
DO HEAD
GOTO FC
