ABPVPCC2 ;TALLY PRIVATE INSURANCE ELIG O/P VISIT REPORT; [ 06/02/91 12:51 PM ]
;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
START D INIT,XTRACT,ZTLOAD
Q
;---------------------------------------------------------------------
INIT ;PROCEDURE TO INITIALIZE ROUTINE SPECIFIC VARIABLES
S ABPV("TOTAL")=0,ABPV("HITS")=0,ABPV("TASK")=ZTSK
S DIC="^DIC(7,",DIC(0)="",D="D",X="09" D IX^DIC
S RXPROV="" S:+Y>0 RXPROV=+Y
K DIC,D,X,Y
Q
;---------------------------------------------------------------------
XTRACT ;PROCEDURE TO LOOP THROUGH THE ^AUPNVSIT FILE TO EXTRACT REQUIRED DATA
S R=(ABPV("BEG")-1)+.9999,ABPV("STOP")=ABPV("END")+.9999
F I=0:0 D Q:+R=0!(R>ABPV("STOP"))
.S R=$O(^AUPNVSIT("B",R)) Q:+R=0!(R>ABPV("STOP"))
.S A("DOS")=$P(R,"."),RR=0 F J=0:0 D Q:+RR=0
..S RR=$O(^AUPNVSIT("B",R,RR)) Q:+RR=0
..Q:$D(^AUPNVSIT(RR,0))'=1
..S DATA=^(0),A("DFN")=$P(DATA,"^",5)
..K ABPVPRV,ABPVPTR,ABPVI,X D Q:$D(X)'=1 Q:X=RXPROV
...S ABPVPTR="" F ABPVI=0:0 D Q:+ABPVPTR=0
....S ABPVPTR=$O(^AUPNVPRV("AD",RR,ABPVPTR)) Q:+ABPVPTR=0
....Q:$D(^AUPNVPRV(ABPVPTR,0))'=1
....I $P(^AUPNVPRV(ABPVPTR,0),"^",4)="P" D
.....S ABPVPRV=+^AUPNVPRV(ABPVPTR,0),ABPVPTR=""
...Q:$D(ABPVPRV)'=1 Q:+ABPVPRV<1 Q:'$D(^DIC(6,+ABPVPRV,0))
...S X=$P(^DIC(6,+ABPVPRV,0),"^",4) I +X<1 K X Q
...I '$D(^DIC(7,+X,0)) K X Q
..S ABPV("TOTAL")=ABPV("TOTAL")+1
..Q:$D(^AUPNPRVT(A("DFN"),0))=0
..S A("SVCS")=0
..I $D(^%ZTSK(ABPV("TASK"),ABPV("SITE"),A("DOS"),A("DFN")))=1 D
...S A("SVCS")=^(A("DFN"))
..S A("SVCS")=A("SVCS")+1,ABPV("HITS")=ABPV("HITS")+1
..S ^%ZTSK(ABPV("TASK"),ABPV("SITE"),A("DOS"),A("DFN"))=A("SVCS")
Q
;---------------------------------------------------------------------
;PROCEDURE TO LOAD BACKGROUND TASKMANAGER
ZTLOAD S ZTRTN="^ABPVPCC3",ZTDTH=$H,ZTIO=ABPV("IO"),ZTSAVE("ABPV(")=""
S ZTDESC="PRINT PVT INS ELIGIBLE PCC VISITS"
D ^%ZTLOAD
ZTLEND K ABPV,ABPV,%ZIS,%IS,ZRTN,ZTDTH,ZTDESC,ZTSAVE,ZTSK,A,X,Y,DIC,DIE,DA
K DR,ZTIO,R,I
Q
ABPVPCC2 ;TALLY PRIVATE INSURANCE ELIG O/P VISIT REPORT; [ 06/02/91 12:51 PM ]
+1 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
START DO INIT
DO XTRACT
DO ZTLOAD
+1 QUIT
+2 ;---------------------------------------------------------------------
INIT ;PROCEDURE TO INITIALIZE ROUTINE SPECIFIC VARIABLES
+1 SET ABPV("TOTAL")=0
SET ABPV("HITS")=0
SET ABPV("TASK")=ZTSK
+2 SET DIC="^DIC(7,"
SET DIC(0)=""
SET D="D"
SET X="09"
DO IX^DIC
+3 SET RXPROV=""
IF +Y>0
SET RXPROV=+Y
+4 KILL DIC,D,X,Y
+5 QUIT
+6 ;---------------------------------------------------------------------
XTRACT ;PROCEDURE TO LOOP THROUGH THE ^AUPNVSIT FILE TO EXTRACT REQUIRED DATA
+1 SET R=(ABPV("BEG")-1)+.9999
SET ABPV("STOP")=ABPV("END")+.9999
+2 FOR I=0:0
Begin DoDot:1
+3 SET R=$ORDER(^AUPNVSIT("B",R))
IF +R=0!(R>ABPV("STOP"))
QUIT
+4 SET A("DOS")=$PIECE(R,".")
SET RR=0
FOR J=0:0
Begin DoDot:2
+5 SET RR=$ORDER(^AUPNVSIT("B",R,RR))
IF +RR=0
QUIT
+6 IF $DATA(^AUPNVSIT(RR,0))'=1
QUIT
+7 SET DATA=^(0)
SET A("DFN")=$PIECE(DATA,"^",5)
+8 KILL ABPVPRV,ABPVPTR,ABPVI,X
Begin DoDot:3
+9 SET ABPVPTR=""
FOR ABPVI=0:0
Begin DoDot:4
+10 SET ABPVPTR=$ORDER(^AUPNVPRV("AD",RR,ABPVPTR))
IF +ABPVPTR=0
QUIT
+11 IF $DATA(^AUPNVPRV(ABPVPTR,0))'=1
QUIT
+12 IF $PIECE(^AUPNVPRV(ABPVPTR,0),"^",4)="P"
Begin DoDot:5
+13 SET ABPVPRV=+^AUPNVPRV(ABPVPTR,0)
SET ABPVPTR=""
End DoDot:5
End DoDot:4
IF +ABPVPTR=0
QUIT
+14 IF $DATA(ABPVPRV)'=1
QUIT
IF +ABPVPRV<1
QUIT
IF '$DATA(^DIC(6,+ABPVPRV,0))
QUIT
+15 SET X=$PIECE(^DIC(6,+ABPVPRV,0),"^",4)
IF +X<1
KILL X
QUIT
+16 IF '$DATA(^DIC(7,+X,0))
KILL X
QUIT
End DoDot:3
IF $DATA(X)'=1
QUIT
IF X=RXPROV
QUIT
+17 SET ABPV("TOTAL")=ABPV("TOTAL")+1
+18 IF $DATA(^AUPNPRVT(A("DFN"),0))=0
QUIT
+19 SET A("SVCS")=0
+20 IF $DATA(^%ZTSK(ABPV("TASK"),ABPV("SITE"),A("DOS"),A("DFN")))=1
Begin DoDot:3
+21 SET A("SVCS")=^(A("DFN"))
End DoDot:3
+22 SET A("SVCS")=A("SVCS")+1
SET ABPV("HITS")=ABPV("HITS")+1
+23 SET ^%ZTSK(ABPV("TASK"),ABPV("SITE"),A("DOS"),A("DFN"))=A("SVCS")
End DoDot:2
IF +RR=0
QUIT
End DoDot:1
IF +R=0!(R>ABPV("STOP"))
QUIT
+24 QUIT
+25 ;---------------------------------------------------------------------
+26 ;PROCEDURE TO LOAD BACKGROUND TASKMANAGER
ZTLOAD SET ZTRTN="^ABPVPCC3"
SET ZTDTH=$HOROLOG
SET ZTIO=ABPV("IO")
SET ZTSAVE("ABPV(")=""
+1 SET ZTDESC="PRINT PVT INS ELIGIBLE PCC VISITS"
+2 DO ^%ZTLOAD
ZTLEND KILL ABPV,ABPV,%ZIS,%IS,ZRTN,ZTDTH,ZTDESC,ZTSAVE,ZTSK,A,X,Y,DIC,DIE,DA
+1 KILL DR,ZTIO,R,I
+2 QUIT
