- 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
