ACHSDFI ; IHS/ITSC/PMF - DEFERRED SERVICES LIST BY ISSUE DATE ;7/27/10 16:09
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
;ACHS*3.1*18 4/1/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
;
K X2,X3
A2 ; --- All or date range
;{ABK, 3/31/10}S %=$$DIR^ACHS("Y","ALL DEFERRED SERVICES","YES","Enter 'NO' to select the date range for the denial list","",2)
S %=$$DIR^ACHS("Y","ALL UNMET NEEDS","YES","Enter 'NO' to select the date range for the denial list","",2)
G K:$D(DUOUT)!$D(DTOUT)
I % S ACHDBDT=1,ACHDEDT=9999999 G B
;
BDT ; --- Beginning date
;{ABK, 3/31/10}S ACHDBDT=$$DATE^ACHS("B","DEFERRED SERVICES LIST")
S ACHDBDT=$$DATE^ACHS("B","UNMET NEEDS LIST")
G:ACHDBDT<1 A2
;
A3 ; --- Ending date
;{ABK, 3/31/10}S ACHDEDT=$$DATE^ACHS("E","DEFERRED SERVICES LIST")
S ACHDEDT=$$DATE^ACHS("E","UNMET NEEDS LIST")
G:ACHDEDT<1 BDT
I $$EBB^ACHS(ACHDBDT,ACHDEDT) G BDT
B ;
S ACHDHAT=""
DEV ;
S %ZIS="OPQ"
D ^%ZIS
I POP D HOME^%ZIS G K
G:'$D(IO("Q")) START
K IO("Q")
I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
;{ABK, 3/31/10}S ZTRTN="START^ACHSDNI",ZTDESC="CHS Deferred Services Documents"_$$FMTE^XLFDT(ACHDBDT)_" to "_$$FMTE^XLFDT(ACHDEDT)
S ZTRTN="START^ACHSDNI",ZTDESC="CHS Unmet Needs Documents"_$$FMTE^XLFDT(ACHDBDT)_" to "_$$FMTE^XLFDT(ACHDEDT)
F %="ACHDBDT","ACHDEDT" S ZTSAVE(%)=""
D ^%ZTLOAD
G:'$D(ZTSK) DEV
K ZTSK
G K
;
START ;EP - TaskMan.
;{ABK, 3/31/10}S ACHDISU=ACHDBDT-1,(ACHDTOT("$"),ACHDTOT)=0,ACHDT1=$$C^ACHS($S(ACHDBDT=1:"*** ALL DEFERRED SERVICES ***",1:"For the period "_$$FMTE^XLFDT(ACHDBDT)_" through "_$$FMTE^XLFDT(ACHDEDT)),80)
S ACHDISU=ACHDBDT-1,(ACHDTOT("$"),ACHDTOT)=0,ACHDT1=$$C^ACHS($S(ACHDBDT=1:"*** ALL UNMET NEEDS ***",1:"For the period "_$$FMTE^XLFDT(ACHDBDT)_" through "_$$FMTE^XLFDT(ACHDEDT)),80)
D BRPT^ACHS
D HDR
;
L1 ;
S ACHDISU=$O(^ACHSDEF(DUZ(2),"D","AISSUE",ACHDISU))
G END:+ACHDISU=0!(ACHDISU>ACHDEDT)
S ACHSA=0
L2 ;
S ACHSA=$O(^ACHSDEF(DUZ(2),"D","AISSUE",ACHDISU,ACHSA))
G L1:+ACHSA=0
G L2:'$D(^ACHSDEF(DUZ(2),"D",ACHSA,0))
G L2:$E($G(^ACHSDEF(DUZ(2),"D","AISSUE",ACHDISU,ACHSA,0)))="#" ;INCOMPLETE
;{ABK, 3/31/10}G L2:$$DF^ACHS(0,14)="Y" ;'DEFERRED SERVICE CANCELLED'
G L2:$$DF^ACHS(0,14)="Y" ;'UNMET NEED CANCELLED'
;
;'IS PATIENT REGISTERED?' NO GO GET NAME IF NOT THERE
I $$DF^ACHS(0,5)="N" G L2:'$L($$DF^ACHS(0,7)) S ACHDNAME=$$DF^ACHS(0,7) G L3
G L2:'$$DF^ACHS(0,6) ;'REGISTERED PATIENT' PTR
G L2:'$D(^DPT($$DF^ACHS(0,6),0))
S ACHDNAME=$P($G(^DPT($$DF^ACHS(0,6),0)),U) ;REG. PAT. NAME
L3 ;
S ACHD("$")=""
W $$FMTE^XLFDT(ACHDISU) ;'SERVICE DATE ISSUED'
W ?14,$$DF^ACHS(0,1) ;'CHS DEFERRED SERVICE FACILITY'
W ?27,ACHDNAME,?65
S X=$$DF^ACHS(100,5),X2=2,X3=12
D FMT^ACHS
W !
I $Y>ACHSBM D RTRN^ACHS G K:$D(DUOUT)!$D(DTOUT)!($G(ACHSQUIT)) D HDR
S ACHDTOT=ACHDTOT+1
S ACHDTOT("$")=ACHDTOT("$")+$$DF^ACHS(100,5) ;'ESTIMATED COST'
G L2
;
END ;
S X=ACHDTOT("$"),X2="2$",X3=16
D COMMA^%DTC
;{ABK, 3/31/10}W !,$$REPEAT^XLFSTR("=",79),!,"TOTALS FOR THIS REPORT: ",ACHDTOT," DEFERRED SERVICE",$S(ACHDTOT=1:"",1:"S"),?61,X
W !,$$REPEAT^XLFSTR("=",79),!,"TOTALS FOR THIS REPORT: ",ACHDTOT," UNMET NEED",$S(ACHDTOT=1:"",1:"S"),?61,X
K ACHDHAT
D RTRN^ACHS
W @IOF
;
K ; --- Kill, End, Quit
K ACHD,ACHDISU,ACHDNAME,ACHDTOT,ACHSA
D ERPT^ACHS
Q
;
HDR ; --- Paginate, write headers
S ACHSPG=ACHSPG+1
;{ABK, 3/31/10}W @IOF,!!,$$C^ACHS("*** CHS DENIAL/DEFERRED SERVICES ***",80),!!,ACHSLOC,!?20,"DEFERRED SERVICES DOCUMENTS BY ISSUE DATE",?71,"Page",$J(ACHSPG,3)
W @IOF,!!,$$C^ACHS("*** CHS UNMET NEEDS ***",80),!!,ACHSLOC,!?20,"UNMET NEEDS DOCUMENTS BY ISSUE DATE",?71,"Page",$J(ACHSPG,3)
W !,ACHSTIME,!!,ACHDT1,!!,"ISSUE DATE",?14,"DOCUMENT #",?27,"PATIENT",?69,"DOLLARS",!,$$REPEAT^XLFSTR("=",79),!
Q
;
ACHSDFI ; IHS/ITSC/PMF - DEFERRED SERVICES LIST BY ISSUE DATE ;7/27/10 16:09
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
+2 ;ACHS*3.1*18 4/1/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
+3 ;
+4 KILL X2,X3
A2 ; --- All or date range
+1 ;{ABK, 3/31/10}S %=$$DIR^ACHS("Y","ALL DEFERRED SERVICES","YES","Enter 'NO' to select the date range for the denial list","",2)
+2 SET %=$$DIR^ACHS("Y","ALL UNMET NEEDS","YES","Enter 'NO' to select the date range for the denial list","",2)
+3 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO K
+4 IF %
SET ACHDBDT=1
SET ACHDEDT=9999999
GOTO B
+5 ;
BDT ; --- Beginning date
+1 ;{ABK, 3/31/10}S ACHDBDT=$$DATE^ACHS("B","DEFERRED SERVICES LIST")
+2 SET ACHDBDT=$$DATE^ACHS("B","UNMET NEEDS LIST")
+3 IF ACHDBDT<1
GOTO A2
+4 ;
A3 ; --- Ending date
+1 ;{ABK, 3/31/10}S ACHDEDT=$$DATE^ACHS("E","DEFERRED SERVICES LIST")
+2 SET ACHDEDT=$$DATE^ACHS("E","UNMET NEEDS LIST")
+3 IF ACHDEDT<1
GOTO BDT
+4 IF $$EBB^ACHS(ACHDBDT,ACHDEDT)
GOTO BDT
B ;
+1 SET ACHDHAT=""
DEV ;
+1 SET %ZIS="OPQ"
+2 DO ^%ZIS
+3 IF POP
DO HOME^%ZIS
GOTO K
+4 IF '$DATA(IO("Q"))
GOTO START
+5 KILL IO("Q")
+6 IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
WRITE *7,!,"Please queue to system printers."
DO ^%ZISC
GOTO DEV
+7 ;{ABK, 3/31/10}S ZTRTN="START^ACHSDNI",ZTDESC="CHS Deferred Services Documents"_$$FMTE^XLFDT(ACHDBDT)_" to "_$$FMTE^XLFDT(ACHDEDT)
+8 SET ZTRTN="START^ACHSDNI"
SET ZTDESC="CHS Unmet Needs Documents"_$$FMTE^XLFDT(ACHDBDT)_" to "_$$FMTE^XLFDT(ACHDEDT)
+9 FOR %="ACHDBDT","ACHDEDT"
SET ZTSAVE(%)=""
+10 DO ^%ZTLOAD
+11 IF '$DATA(ZTSK)
GOTO DEV
+12 KILL ZTSK
+13 GOTO K
+14 ;
START ;EP - TaskMan.
+1 ;{ABK, 3/31/10}S ACHDISU=ACHDBDT-1,(ACHDTOT("$"),ACHDTOT)=0,ACHDT1=$$C^ACHS($S(ACHDBDT=1:"*** ALL DEFERRED SERVICES ***",1:"For the period "_$$FMTE^XLFDT(ACHDBDT)_" through "_$$FMTE^XLFDT(ACHDEDT)),80)
+2 SET ACHDISU=ACHDBDT-1
SET (ACHDTOT("$"),ACHDTOT)=0
SET ACHDT1=$$C^ACHS($SELECT(ACHDBDT=1:"*** ALL UNMET NEEDS ***",1:"For the period "_$$FMTE^XLFDT(ACHDBDT)_" through "_$$FMTE^XLFDT(ACHDEDT)),80)
+3 DO BRPT^ACHS
+4 DO HDR
+5 ;
L1 ;
+1 SET ACHDISU=$ORDER(^ACHSDEF(DUZ(2),"D","AISSUE",ACHDISU))
+2 IF +ACHDISU=0!(ACHDISU>ACHDEDT)
GOTO END
+3 SET ACHSA=0
L2 ;
+1 SET ACHSA=$ORDER(^ACHSDEF(DUZ(2),"D","AISSUE",ACHDISU,ACHSA))
+2 IF +ACHSA=0
GOTO L1
+3 IF '$DATA(^ACHSDEF(DUZ(2),"D",ACHSA,0))
GOTO L2
+4 ;INCOMPLETE
IF $EXTRACT($GET(^ACHSDEF(DUZ(2),"D","AISSUE",ACHDISU,ACHSA,0)))="#"
GOTO L2
+5 ;{ABK, 3/31/10}G L2:$$DF^ACHS(0,14)="Y" ;'DEFERRED SERVICE CANCELLED'
+6 ;'UNMET NEED CANCELLED'
IF $$DF^ACHS(0,14)="Y"
GOTO L2
+7 ;
+8 ;'IS PATIENT REGISTERED?' NO GO GET NAME IF NOT THERE
+9 IF $$DF^ACHS(0,5)="N"
IF '$LENGTH($$DF^ACHS(0,7))
GOTO L2
SET ACHDNAME=$$DF^ACHS(0,7)
GOTO L3
+10 ;'REGISTERED PATIENT' PTR
IF '$$DF^ACHS(0,6)
GOTO L2
+11 IF '$DATA(^DPT($$DF^ACHS(0,6),0))
GOTO L2
+12 ;REG. PAT. NAME
SET ACHDNAME=$PIECE($GET(^DPT($$DF^ACHS(0,6),0)),U)
L3 ;
+1 SET ACHD("$")=""
+2 ;'SERVICE DATE ISSUED'
WRITE $$FMTE^XLFDT(ACHDISU)
+3 ;'CHS DEFERRED SERVICE FACILITY'
WRITE ?14,$$DF^ACHS(0,1)
+4 WRITE ?27,ACHDNAME,?65
+5 SET X=$$DF^ACHS(100,5)
SET X2=2
SET X3=12
+6 DO FMT^ACHS
+7 WRITE !
+8 IF $Y>ACHSBM
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)!($GET(ACHSQUIT))
GOTO K
DO HDR
+9 SET ACHDTOT=ACHDTOT+1
+10 ;'ESTIMATED COST'
SET ACHDTOT("$")=ACHDTOT("$")+$$DF^ACHS(100,5)
+11 GOTO L2
+12 ;
END ;
+1 SET X=ACHDTOT("$")
SET X2="2$"
SET X3=16
+2 DO COMMA^%DTC
+3 ;{ABK, 3/31/10}W !,$$REPEAT^XLFSTR("=",79),!,"TOTALS FOR THIS REPORT: ",ACHDTOT," DEFERRED SERVICE",$S(ACHDTOT=1:"",1:"S"),?61,X
+4 WRITE !,$$REPEAT^XLFSTR("=",79),!,"TOTALS FOR THIS REPORT: ",ACHDTOT," UNMET NEED",$SELECT(ACHDTOT=1:"",1:"S"),?61,X
+5 KILL ACHDHAT
+6 DO RTRN^ACHS
+7 WRITE @IOF
+8 ;
K ; --- Kill, End, Quit
+1 KILL ACHD,ACHDISU,ACHDNAME,ACHDTOT,ACHSA
+2 DO ERPT^ACHS
+3 QUIT
+4 ;
HDR ; --- Paginate, write headers
+1 SET ACHSPG=ACHSPG+1
+2 ;{ABK, 3/31/10}W @IOF,!!,$$C^ACHS("*** CHS DENIAL/DEFERRED SERVICES ***",80),!!,ACHSLOC,!?20,"DEFERRED SERVICES DOCUMENTS BY ISSUE DATE",?71,"Page",$J(ACHSPG,3)
+3 WRITE @IOF,!!,$$C^ACHS("*** CHS UNMET NEEDS ***",80),!!,ACHSLOC,!?20,"UNMET NEEDS DOCUMENTS BY ISSUE DATE",?71,"Page",$JUSTIFY(ACHSPG,3)
+4 WRITE !,ACHSTIME,!!,ACHDT1,!!,"ISSUE DATE",?14,"DOCUMENT #",?27,"PATIENT",?69,"DOLLARS",!,$$REPEAT^XLFSTR("=",79),!
+5 QUIT
+6 ;
