- 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
