AQAQDCC ;IHS/ANMC/LJF - DELINQUENT CHARTS BY PROVIDER; [ 05/27/92 11:14 AM ]
;;2.2;STAFF CREDENTIALS;;01 OCT 1992
;
;>>> FIND INCOMPLETE CHARTS & GET COUNTS BY PROVIDER <<<
;
K ^UTILITY("AQAQDC",$J) S AQAQDTOT=0 ;total delq charts
;***> loop thru incomplete chart file by provider
S AQAQPRV=0 K AQAQ
F S AQAQPRV=$O(^ADGIC("AC",AQAQPRV)) Q:AQAQPRV="" D
.S AQAQPRVN=$P(^DIC(16,AQAQPRV,0),U) ;provider name
.S DFN=0 F AQAQI=1:1:7 S AQAQ(AQAQI)=0 ;reset counts
.F S DFN=$O(^ADGIC("AC",AQAQPRV,DFN)) Q:DFN="" D
..S AQAQDS=0
..F S AQAQDS=$O(^ADGIC("AC",AQAQPRV,DFN,AQAQDS)) Q:AQAQDS="" D
...S AQAQPM=0
...F S AQAQPM=$O(^ADGIC("AC",AQAQPRV,DFN,AQAQDS,AQAQPM)) Q:AQAQPM="" D
....;
....Q:'$D(^ADGIC(DFN,"D",AQAQDS,"P",AQAQPM,"C",0)) Q:$P(^(0),U,4)<1
....Q:'$D(^ADGIC(DFN,"D",AQAQDS,0))
....S AQAQSTR=^(0),AQAQDSD=$P(AQAQSTR,U) ;discharge date for chart
....;
....;**> find all chart deficiencies for this prov for this discharge
....S AQAQCD="",AQAQX=0
....F S AQAQX=$O(^ADGIC(DFN,"D",AQAQDS,"P",AQAQPM,"C",AQAQX)) Q:AQAQX'=+AQAQX D
.....S AQAQX1=$P(^(AQAQX,0),U)
.....S AQAQCD=$S(AQAQCD="":AQAQX1,1:AQAQCD_U_AQAQX1)
....D COUNT ;increment counts
.;
.;**> for each provider, set ^utility
.S AQAQSTR=AQAQ(3) F AQAQI=4:1:7 S AQAQSTR=AQAQSTR_U_AQAQ(AQAQI)
.S ^UTILITY("AQAQDC",$J,AQAQPRVN)=AQAQSTR
.I AQAQADD D FILE ;stuff data into credentials file
;
;**> find total delq charts for facility by patient
S (DFN,AQAQDTOT)=0
F S DFN=$O(^UTILITY("AQAQDC","ZZ",DFN)) Q:DFN="" S AQAQDTOT=AQAQDTOT+1
I AQAQADD D DLQTOT ;stuff facility delq total into entries
;
;>>> end of calculate <<<
NEXT ;***> if adding to file, kill vars then quit
I AQAQADD=1 K ^UTILITY("AQAQDC") G KILL^AQAQUTIL
;***> else, go to print rtn
E G ^AQAQDCP
;
;>>> END OF MAIN CALCULATE RTN <<<
;
COUNT ;***> SUBRTN to increment chart counts for each provider
S AQAQFLG=0 F AQAQI=4,5,6,7 S AQAQZ(AQAQI)=0
F AQAQY=1:1 S AQAQX=$P(AQAQCD,U,AQAQY) Q:AQAQX="" D
.S AQAQG=$P(^ADGCD(AQAQX,0),U,3) ;deficiency grouping
.I AQAQG="ASH" S AQAQZ(5)=1,AQAQFLG=1 Q ;a sheet always delq
.I AQAQG="SIG" S AQAQZ(7)=1,AQAQFLG=1 Q ;delq for sig
.I AQAQG="OPR" S AQAQZ(4)=1,AQAQFLG=1 Q ;delq for op report
.I AQAQG="SUM" S AQAQZ(6)=1,AQAQFLG=1 Q ;delq for summary
.Q
F AQAQY=4,5,6,7 S AQAQ(AQAQY)=AQAQ(AQAQY)+AQAQZ(AQAQY)
I AQAQFLG S AQAQ(3)=AQAQ(3)+1,^UTILITY("AQAQDC","ZZ",DFN)="" ;dlqnt
Q
;
;
FILE ;***> SUBRTN to stuff # of delinquent charts into credentials file
Q:'$D(^AQAQC(AQAQPRV,0)) ;provider not in credentials file
I '$D(^AQAQC(AQAQPRV,"DLQ",0)) S ^AQAQC(AQAQPRV,"DLQ",0)="^9002165.04DA"
S DIC="^AQAQC("_AQAQPRV_",""DLQ"",",DIC(0)="L",DA(1)=AQAQPRV,X=DT
S DIC("DR")="1////^S X=AQAQ(3)" D FILE^DICN
Q
;
;
DLQTOT ;***> SUBRTN to stuff total delq charts for facility into prov entries
S AQAQPRV=0
F S AQAQPRV=$O(^AQAQC(AQAQPRV)) Q:AQAQPRV'=+AQAQPRV D
.Q:'$D(^AQAQC(AQAQPRV,"DLQ","B",DT))
.S AQAQX=0
.F S AQAQX=$O(^AQAQC(AQAQPRV,"DLQ","B",DT,AQAQX)) Q:AQAQX="" D
..S DIE="^AQAQC("_AQAQPRV_",""DLQ"",",DA(1)=AQAQPRV
..S DA=AQAQX,DR="2////^S X=AQAQDTOT" D ^DIE
Q
;
;
JOB ;EP; >>> entry point for background job to add data to file
;
;***> set # of working days
S X1=DT,X2=-30 D C^%DTC S AQAQDEL=X
;***> let calculate know this is rtn to add data to file
S AQAQADD=1
;***> go to claculate rtn
G ^AQAQDCC
AQAQDCC ;IHS/ANMC/LJF - DELINQUENT CHARTS BY PROVIDER; [ 05/27/92 11:14 AM ]
+1 ;;2.2;STAFF CREDENTIALS;;01 OCT 1992
+2 ;
+3 ;>>> FIND INCOMPLETE CHARTS & GET COUNTS BY PROVIDER <<<
+4 ;
+5 ;total delq charts
KILL ^UTILITY("AQAQDC",$JOB)
SET AQAQDTOT=0
+6 ;***> loop thru incomplete chart file by provider
+7 SET AQAQPRV=0
KILL AQAQ
+8 FOR
SET AQAQPRV=$ORDER(^ADGIC("AC",AQAQPRV))
IF AQAQPRV=""
QUIT
Begin DoDot:1
+9 ;provider name
SET AQAQPRVN=$PIECE(^DIC(16,AQAQPRV,0),U)
+10 ;reset counts
SET DFN=0
FOR AQAQI=1:1:7
SET AQAQ(AQAQI)=0
+11 FOR
SET DFN=$ORDER(^ADGIC("AC",AQAQPRV,DFN))
IF DFN=""
QUIT
Begin DoDot:2
+12 SET AQAQDS=0
+13 FOR
SET AQAQDS=$ORDER(^ADGIC("AC",AQAQPRV,DFN,AQAQDS))
IF AQAQDS=""
QUIT
Begin DoDot:3
+14 SET AQAQPM=0
+15 FOR
SET AQAQPM=$ORDER(^ADGIC("AC",AQAQPRV,DFN,AQAQDS,AQAQPM))
IF AQAQPM=""
QUIT
Begin DoDot:4
+16 ;
+17 IF '$DATA(^ADGIC(DFN,"D",AQAQDS,"P",AQAQPM,"C",0))
QUIT
IF $PIECE(^(0),U,4)<1
QUIT
+18 IF '$DATA(^ADGIC(DFN,"D",AQAQDS,0))
QUIT
+19 ;discharge date for chart
SET AQAQSTR=^(0)
SET AQAQDSD=$PIECE(AQAQSTR,U)
+20 ;
+21 ;**> find all chart deficiencies for this prov for this discharge
+22 SET AQAQCD=""
SET AQAQX=0
+23 FOR
SET AQAQX=$ORDER(^ADGIC(DFN,"D",AQAQDS,"P",AQAQPM,"C",AQAQX))
IF AQAQX'=+AQAQX
QUIT
Begin DoDot:5
+24 SET AQAQX1=$PIECE(^(AQAQX,0),U)
+25 SET AQAQCD=$SELECT(AQAQCD="":AQAQX1,1:AQAQCD_U_AQAQX1)
End DoDot:5
+26 ;increment counts
DO COUNT
End DoDot:4
End DoDot:3
End DoDot:2
+27 ;
+28 ;**> for each provider, set ^utility
+29 SET AQAQSTR=AQAQ(3)
FOR AQAQI=4:1:7
SET AQAQSTR=AQAQSTR_U_AQAQ(AQAQI)
+30 SET ^UTILITY("AQAQDC",$JOB,AQAQPRVN)=AQAQSTR
+31 ;stuff data into credentials file
IF AQAQADD
DO FILE
End DoDot:1
+32 ;
+33 ;**> find total delq charts for facility by patient
+34 SET (DFN,AQAQDTOT)=0
+35 FOR
SET DFN=$ORDER(^UTILITY("AQAQDC","ZZ",DFN))
IF DFN=""
QUIT
SET AQAQDTOT=AQAQDTOT+1
+36 ;stuff facility delq total into entries
IF AQAQADD
DO DLQTOT
+37 ;
+38 ;>>> end of calculate <<<
NEXT ;***> if adding to file, kill vars then quit
+1 IF AQAQADD=1
KILL ^UTILITY("AQAQDC")
GOTO KILL^AQAQUTIL
+2 ;***> else, go to print rtn
+3 IF '$TEST
GOTO ^AQAQDCP
+4 ;
+5 ;>>> END OF MAIN CALCULATE RTN <<<
+6 ;
COUNT ;***> SUBRTN to increment chart counts for each provider
+1 SET AQAQFLG=0
FOR AQAQI=4,5,6,7
SET AQAQZ(AQAQI)=0
+2 FOR AQAQY=1:1
SET AQAQX=$PIECE(AQAQCD,U,AQAQY)
IF AQAQX=""
QUIT
Begin DoDot:1
+3 ;deficiency grouping
SET AQAQG=$PIECE(^ADGCD(AQAQX,0),U,3)
+4 ;a sheet always delq
IF AQAQG="ASH"
SET AQAQZ(5)=1
SET AQAQFLG=1
QUIT
+5 ;delq for sig
IF AQAQG="SIG"
SET AQAQZ(7)=1
SET AQAQFLG=1
QUIT
+6 ;delq for op report
IF AQAQG="OPR"
SET AQAQZ(4)=1
SET AQAQFLG=1
QUIT
+7 ;delq for summary
IF AQAQG="SUM"
SET AQAQZ(6)=1
SET AQAQFLG=1
QUIT
+8 QUIT
End DoDot:1
+9 FOR AQAQY=4,5,6,7
SET AQAQ(AQAQY)=AQAQ(AQAQY)+AQAQZ(AQAQY)
+10 ;dlqnt
IF AQAQFLG
SET AQAQ(3)=AQAQ(3)+1
SET ^UTILITY("AQAQDC","ZZ",DFN)=""
+11 QUIT
+12 ;
+13 ;
FILE ;***> SUBRTN to stuff # of delinquent charts into credentials file
+1 ;provider not in credentials file
IF '$DATA(^AQAQC(AQAQPRV,0))
QUIT
+2 IF '$DATA(^AQAQC(AQAQPRV,"DLQ",0))
SET ^AQAQC(AQAQPRV,"DLQ",0)="^9002165.04DA"
+3 SET DIC="^AQAQC("_AQAQPRV_",""DLQ"","
SET DIC(0)="L"
SET DA(1)=AQAQPRV
SET X=DT
+4 SET DIC("DR")="1////^S X=AQAQ(3)"
DO FILE^DICN
+5 QUIT
+6 ;
+7 ;
DLQTOT ;***> SUBRTN to stuff total delq charts for facility into prov entries
+1 SET AQAQPRV=0
+2 FOR
SET AQAQPRV=$ORDER(^AQAQC(AQAQPRV))
IF AQAQPRV'=+AQAQPRV
QUIT
Begin DoDot:1
+3 IF '$DATA(^AQAQC(AQAQPRV,"DLQ","B",DT))
QUIT
+4 SET AQAQX=0
+5 FOR
SET AQAQX=$ORDER(^AQAQC(AQAQPRV,"DLQ","B",DT,AQAQX))
IF AQAQX=""
QUIT
Begin DoDot:2
+6 SET DIE="^AQAQC("_AQAQPRV_",""DLQ"","
SET DA(1)=AQAQPRV
+7 SET DA=AQAQX
SET DR="2////^S X=AQAQDTOT"
DO ^DIE
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
+10 ;
JOB ;EP; >>> entry point for background job to add data to file
+1 ;
+2 ;***> set # of working days
+3 SET X1=DT
SET X2=-30
DO C^%DTC
SET AQAQDEL=X
+4 ;***> let calculate know this is rtn to add data to file
+5 SET AQAQADD=1
+6 ;***> go to claculate rtn
+7 GOTO ^AQAQDCC
