ADGDSIP ; IHS/ADC/PDW/ENM - DS CHART DEFICIENCY BY PROV ; [ 03/25/1999 11:48 AM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
;
K ^TMP("DGZICPL",$J)
A ;--main
NEW DGRNG
D DELDT,HDH,PROV I $D(DIRUT) D Q Q
D COPY I $D(DIRUT) D Q Q
D SUMM I $D(DIRUT)!(Y=-1) D Q Q
D SCRN I $D(DIRUT) D Q Q
D DEV I POP D Q Q
I $D(IO("Q")) D QUE,Q Q
D:'DGPR PA D:DGPR P1 D ^ADGDSIP1,Q
Q
;
DELDT ;--delinquent chart date (today-(30days+holidaydays))
N X,Y,X1,X2 S DGRNG=$P($G(^DG(43,1,9999999.02)),U,3)
S X1=DT,X2=-$S(DGRNG:DGRNG,1:30) D C^%DTC
F Y=0:0 S X=$O(^HOLIDAY(X)) Q:'X!(X>DT) S Y=Y+1
S X1=DT,X2=-$S(DGRNG:DGRNG,1:30)-Y D C^%DTC S DGDEL=X Q
;
HDH ;--intro
W !!!?23,"Chart Deficiency List By Provider",!!
W !!?10,"Charts with a surgery date earlier than "
W !?29,$E(DGDEL,4,5)_"/"_$E(DGDEL,6,7)_"/"_$E(DGDEL,2,3)
W !?15,"will be considered delinquent! (",DGRNG," days)"
Q
;
PROV ;--all providers or just one?
K DIR S DIR("A")="For All Providers",DIR(0)="Y",DIR("B")="YES"
S DIR("?",1)="Answer YES to print the list for all providers."
S DIR("?",2)="Answer NO to select sort logic.",DIR("?")=" "
S (DGSCN,DGOPT,DGPR)=0 D ^DIR Q:Y Q:$D(DIRUT)
;--select option
W !!,"(1) for a Service",!,"(2) for a Class",!,"(3) for a Provider"
K DIR S DIR("A")="Which Option (number)",DIR(0)="N^1:3"
D ^DIR S DGOPT=+Y Q:$D(DIRUT)
;--class
I DGOPT=2 D Q
. K DIR S DIR("A")="Which Class",DIR(0)="P^7:EQZM"
. D ^DIR S DGSCN=+Y
;--specialty
I DGOPT=1 D Q
. K DIR S DIR("A")="Which Specialty",DIR(0)="P^45.7:EQZM"
. D ^DIR S DGSCN=+Y
;--select provider
K DIC S DIC("A")="Which Provider: ",DIC=200,DIC(0)="AEQZM"
S DIC("S")="I $D(^XUSEC(""PROVIDER"",+Y))"
D ^DIC S DGPR=+Y Q
;
COPY ;--number of copies
K DIR S DIR("A")="How Many Copies",DIR(0)="N^1:10",DIR("B")=1
D ^DIR S DGNUM=Y Q
;
SUMM ;--print summaries at end of each provider?
W !!,"Include in Report:",!,"(1) Individual Provider Lists Only"
W !,"(2) Summary Page Only",!,"(3) BOTH"
K DIR S DIR(0)="N^1:3",DIR("A")="Choose number"
D ^DIR S DGSUMPG=Y Q
;
SCRN ;--include awaiting trans deficiency?
K DIR S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="Include 'AWAITING TRANS' deficiencies"
D ^DIR S DGSCRN='Y Q
;
DEV ;--device selection
S %ZIS="PQ" D ^%ZIS Q
;
QUE ;--queued output
K IO("Q") S ZTRTN="EN^ADGDSIP",ZTDESC="PRINT CHART DEFICIENCY LIST"
N I F I="DGPR","DGDEL","DGNUM","DGSUMPG","DGSCRN","DGOPT","DGSCN" S ZTSAVE(I)=""
D ^%ZTLOAD,^%ZISC K ZTSK Q
;
EN ;EP; --queued entry point
D:'DGPR PA D:DGPR P1 D ^ADGDSIP1,Q Q
;
PA ;--all providers
F S DGPR=$O(^ADGDSI("AC",DGPR)) Q:'DGPR D
. I DGOPT=2 D:$P($G(^VA(200,+DGPR,"PS")),U,5)=DGSCN P1 Q
. D P1
Q
;
P1 ;--one provider
N DFN,DS,PM
S DFN=0 F S DFN=$O(^ADGDSI("AC",DGPR,DFN)) Q:'DFN D
. F DS=0:0 S DS=$O(^ADGDSI("AC",DGPR,DFN,DS)) Q:'DS D
.. I DGOPT=1,$P($G(^ADGDSI(DFN,"DT",DS,0)),U,5)'=DGSCN Q
.. F PM=0:0 S PM=$O(^ADGDSI("AC",DGPR,DFN,DS,PM)) Q:'PM D 1
Q
;
1 ;
NEW NM,CHT,N,SUM,OPD,OPR,PRN,CD,DSD
S NM=$P($G(^DPT(DFN,0)),U),CHT=$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
;discharge date ;date summary dictated ;date op report dictated
S N=$G(^ADGDSI(DFN,"DT",DS,0)) Q:N=""
S DSD=$P(N,U),OPD=$P(N,U,2),OPR=$P(N,U,3)
S PRN=$P($G(^VA(200,+DGPR,0)),U)
;--chart deficiencies
N X,X1 S CD="",X=0
F S X=$O(^ADGDSI(DFN,"DT",DS,"P",PM,"CD",X)) Q:'X D
. S X1=$P(^ADGDSI(DFN,"DT",DS,"P",PM,"CD",X,0),U)
. I DGSCRN Q:^ADGCD(X1,0)["AWAITING TRANS"
. S CD=$S(CD="":X1,1:CD_U_X1)
;--utility
Q:CD="" S ^TMP("DGZICPL",$J,PRN,DSD,NM,DFN)=CHT_U_OPD_U_OPR_U_CD Q
;
Q ;--cleanup
K DGPR,DIR,POP,DGFLG,DGDEL,DGSUMPG,DGSCRN,DGNUM,DGOPT,DGSCN
D HOME^%ZIS Q
ADGDSIP ; IHS/ADC/PDW/ENM - DS CHART DEFICIENCY BY PROV ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
+2 ;
+3 KILL ^TMP("DGZICPL",$JOB)
A ;--main
+1 NEW DGRNG
+2 DO DELDT
DO HDH
DO PROV
IF $DATA(DIRUT)
DO Q
QUIT
+3 DO COPY
IF $DATA(DIRUT)
DO Q
QUIT
+4 DO SUMM
IF $DATA(DIRUT)!(Y=-1)
DO Q
QUIT
+5 DO SCRN
IF $DATA(DIRUT)
DO Q
QUIT
+6 DO DEV
IF POP
DO Q
QUIT
+7 IF $DATA(IO("Q"))
DO QUE
DO Q
QUIT
+8 IF 'DGPR
DO PA
IF DGPR
DO P1
DO ^ADGDSIP1
DO Q
+9 QUIT
+10 ;
DELDT ;--delinquent chart date (today-(30days+holidaydays))
+1 NEW X,Y,X1,X2
SET DGRNG=$PIECE($GET(^DG(43,1,9999999.02)),U,3)
+2 SET X1=DT
SET X2=-$SELECT(DGRNG:DGRNG,1:30)
DO C^%DTC
+3 FOR Y=0:0
SET X=$ORDER(^HOLIDAY(X))
IF 'X!(X>DT)
QUIT
SET Y=Y+1
+4 SET X1=DT
SET X2=-$SELECT(DGRNG:DGRNG,1:30)-Y
DO C^%DTC
SET DGDEL=X
QUIT
+5 ;
HDH ;--intro
+1 WRITE !!!?23,"Chart Deficiency List By Provider",!!
+2 WRITE !!?10,"Charts with a surgery date earlier than "
+3 WRITE !?29,$EXTRACT(DGDEL,4,5)_"/"_$EXTRACT(DGDEL,6,7)_"/"_$EXTRACT(DGDEL,2,3)
+4 WRITE !?15,"will be considered delinquent! (",DGRNG," days)"
+5 QUIT
+6 ;
PROV ;--all providers or just one?
+1 KILL DIR
SET DIR("A")="For All Providers"
SET DIR(0)="Y"
SET DIR("B")="YES"
+2 SET DIR("?",1)="Answer YES to print the list for all providers."
+3 SET DIR("?",2)="Answer NO to select sort logic."
SET DIR("?")=" "
+4 SET (DGSCN,DGOPT,DGPR)=0
DO ^DIR
IF Y
QUIT
IF $DATA(DIRUT)
QUIT
+5 ;--select option
+6 WRITE !!,"(1) for a Service",!,"(2) for a Class",!,"(3) for a Provider"
+7 KILL DIR
SET DIR("A")="Which Option (number)"
SET DIR(0)="N^1:3"
+8 DO ^DIR
SET DGOPT=+Y
IF $DATA(DIRUT)
QUIT
+9 ;--class
+10 IF DGOPT=2
Begin DoDot:1
+11 KILL DIR
SET DIR("A")="Which Class"
SET DIR(0)="P^7:EQZM"
+12 DO ^DIR
SET DGSCN=+Y
End DoDot:1
QUIT
+13 ;--specialty
+14 IF DGOPT=1
Begin DoDot:1
+15 KILL DIR
SET DIR("A")="Which Specialty"
SET DIR(0)="P^45.7:EQZM"
+16 DO ^DIR
SET DGSCN=+Y
End DoDot:1
QUIT
+17 ;--select provider
+18 KILL DIC
SET DIC("A")="Which Provider: "
SET DIC=200
SET DIC(0)="AEQZM"
+19 SET DIC("S")="I $D(^XUSEC(""PROVIDER"",+Y))"
+20 DO ^DIC
SET DGPR=+Y
QUIT
+21 ;
COPY ;--number of copies
+1 KILL DIR
SET DIR("A")="How Many Copies"
SET DIR(0)="N^1:10"
SET DIR("B")=1
+2 DO ^DIR
SET DGNUM=Y
QUIT
+3 ;
SUMM ;--print summaries at end of each provider?
+1 WRITE !!,"Include in Report:",!,"(1) Individual Provider Lists Only"
+2 WRITE !,"(2) Summary Page Only",!,"(3) BOTH"
+3 KILL DIR
SET DIR(0)="N^1:3"
SET DIR("A")="Choose number"
+4 DO ^DIR
SET DGSUMPG=Y
QUIT
+5 ;
SCRN ;--include awaiting trans deficiency?
+1 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
+2 SET DIR("A")="Include 'AWAITING TRANS' deficiencies"
+3 DO ^DIR
SET DGSCRN='Y
QUIT
+4 ;
DEV ;--device selection
+1 SET %ZIS="PQ"
DO ^%ZIS
QUIT
+2 ;
QUE ;--queued output
+1 KILL IO("Q")
SET ZTRTN="EN^ADGDSIP"
SET ZTDESC="PRINT CHART DEFICIENCY LIST"
+2 NEW I
FOR I="DGPR","DGDEL","DGNUM","DGSUMPG","DGSCRN","DGOPT","DGSCN"
SET ZTSAVE(I)=""
+3 DO ^%ZTLOAD
DO ^%ZISC
KILL ZTSK
QUIT
+4 ;
EN ;EP; --queued entry point
+1 IF 'DGPR
DO PA
IF DGPR
DO P1
DO ^ADGDSIP1
DO Q
QUIT
+2 ;
PA ;--all providers
+1 FOR
SET DGPR=$ORDER(^ADGDSI("AC",DGPR))
IF 'DGPR
QUIT
Begin DoDot:1
+2 IF DGOPT=2
IF $PIECE($GET(^VA(200,+DGPR,"PS")),U,5)=DGSCN
DO P1
QUIT
+3 DO P1
End DoDot:1
+4 QUIT
+5 ;
P1 ;--one provider
+1 NEW DFN,DS,PM
+2 SET DFN=0
FOR
SET DFN=$ORDER(^ADGDSI("AC",DGPR,DFN))
IF 'DFN
QUIT
Begin DoDot:1
+3 FOR DS=0:0
SET DS=$ORDER(^ADGDSI("AC",DGPR,DFN,DS))
IF 'DS
QUIT
Begin DoDot:2
+4 IF DGOPT=1
IF $PIECE($GET(^ADGDSI(DFN,"DT",DS,0)),U,5)'=DGSCN
QUIT
+5 FOR PM=0:0
SET PM=$ORDER(^ADGDSI("AC",DGPR,DFN,DS,PM))
IF 'PM
QUIT
DO 1
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
1 ;
+1 NEW NM,CHT,N,SUM,OPD,OPR,PRN,CD,DSD
+2 SET NM=$PIECE($GET(^DPT(DFN,0)),U)
SET CHT=$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
+3 ;discharge date ;date summary dictated ;date op report dictated
+4 SET N=$GET(^ADGDSI(DFN,"DT",DS,0))
IF N=""
QUIT
+5 SET DSD=$PIECE(N,U)
SET OPD=$PIECE(N,U,2)
SET OPR=$PIECE(N,U,3)
+6 SET PRN=$PIECE($GET(^VA(200,+DGPR,0)),U)
+7 ;--chart deficiencies
+8 NEW X,X1
SET CD=""
SET X=0
+9 FOR
SET X=$ORDER(^ADGDSI(DFN,"DT",DS,"P",PM,"CD",X))
IF 'X
QUIT
Begin DoDot:1
+10 SET X1=$PIECE(^ADGDSI(DFN,"DT",DS,"P",PM,"CD",X,0),U)
+11 IF DGSCRN
IF ^ADGCD(X1,0)["AWAITING TRANS"
QUIT
+12 SET CD=$SELECT(CD="":X1,1:CD_U_X1)
End DoDot:1
+13 ;--utility
+14 IF CD=""
QUIT
SET ^TMP("DGZICPL",$JOB,PRN,DSD,NM,DFN)=CHT_U_OPD_U_OPR_U_CD
QUIT
+15 ;
Q ;--cleanup
+1 KILL DGPR,DIR,POP,DGFLG,DGDEL,DGSUMPG,DGSCRN,DGNUM,DGOPT,DGSCN
+2 DO HOME^%ZIS
QUIT
