ACHSDST ; IHS/ITSC/PMF - DOCUMENT STATUS REPORT ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
;
TITLE ;;DOCUMENT STATUS
S ACHSIO=IO
K X2,X3
BDT ;
S ACHSBDT=$$DATE^ACHS("B",$P($T(TITLE),";",3),"ISSUE")
G K:$D(DUOUT)!$D(DTOUT)!(ACHSBDT<1)
EDT ;
S ACHSEDT=$$DATE^ACHS("E",$P($T(TITLE),";",3),"ISSUE")
G K:$D(DTOUT)!(ACHSEDT<1),BDT:$D(DUOUT)
G:$$EBB^ACHS(ACHSBDT,ACHSEDT) EDT
TYPE ;
W !!,"Which type of report?",!!," 1. OPEN DOCUMENTS only",!," 2. CLOSED DOCUMENTS only",!," 3. COMBINED list",!!," ENTER OPTION (1-3) 3//"
D READ^ACHSFU
I Y="" S Y=3
G K:$D(DTOUT),Q:Y?1"?".E,BDT:$D(DUOUT)
I "123"[Y&(Y>0)&(Y<4) S ACHSRPT=Y G DEV
W !!,*7," Enter only a 1, 2, or 3"
G TYPE
;
Q ;
W !!,"Choice 1 - only open documents will be listed.",!,"Choice 2 - only documents which have been paid or cancelled will be listed.",!,"Choice 3 - open and closed documents will be listed together."
G TYPE
;
DEV ;
S %=$$PB^ACHS
I %=U!$D(DTOUT)!$D(DUOUT) D K Q
I %="B" D VIEWR^XBLM("PRINT^ACHSDST"),EN^XBVK("VALM"),K Q
S %ZIS="OPQ"
D ^%ZIS
I POP D HOME^%ZIS G K
G:'$D(IO("Q")) PRINT
K IO("Q")
I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
S ZTRTN="PRINT^ACHSDST",ZTIO="",ZTDESC=$P($T(TITLE),";",3)_", Type "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT),ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
F ACHS="ACHSQIO","ACHSBDT","ACHSEDT","ACHSRPT" S ZTSAVE(ACHS)=""
D ^%ZTLOAD
G:'$D(ZTSK) DEV
K ;
K ACHS,ACHSIO,ACHSQIO,ACHSBDT,ACHSEDT,ACHSRPT,ZTIO,ZTSK
D ^%ZISC
Q
;
PRINT ;EP - From TaskMan.
;
D FC^ACHSUF
I $D(ACHSERR),ACHSERR=1 K ZTSK G KILL
S (ACHSTOTP,ACHSCNX,ACHSOPEN,ACHSTOTP("$"),ACHSCNX("$"),ACHSOPEN("$"))=0
S ACHST1=$$C^XBFUNC($S(ACHSRPT=1:"OPEN DOCUMENTS",ACHSRPT=2:"CLOSED DOCUMENTS",1:"OPEN AND CLOSED DOCUMENTS"),80),ACHST2=$$C^XBFUNC("For the period "_$$FMTE^XLFDT(ACHSBDT)_" through "_$$FMTE^XLFDT(ACHSEDT),80)
D BRPT^ACHSFU
D HDR
S X3=0,ACHSBDT=ACHSBDT-1
A ; Main loop.
S ACHSBDT=$O(^ACHSF(DUZ(2),"TB",ACHSBDT))
G END:+ACHSBDT=0!(+ACHSBDT>ACHSEDT)
S ACHSTYPE=""
B ;
S ACHSTYPE=$O(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTYPE))
G A:ACHSTYPE="",B:ACHSTYPE'="I"
S DA=0
C ;
S DA=$O(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTYPE,DA))
G A:+DA=0,A:'$D(^ACHSF(DUZ(2),"D",DA,0)) S ACHSSTS=$S($P(^(0),U,12)=3:"P",$P(^(0),U,12)=4:"C",1:"OPEN")
I ACHSRPT=1,"PC"[ACHSSTS G C
I ACHSRPT=2,"PC"'[ACHSSTS G C
S ACHSDOC1=$P(^ACHSF(DUZ(2),"D",DA,0),U),ACHSVPTR=$P(^(0),U,8),ACHSDOC2=$P(^(0),U,14),ACHS("$")=$P(^(0),U,9),ACHSTOS=$P(^(0),U,4),ACHSBLNK=+$P(^(0),U,3)
G A:ACHSVPTR']"",A:'$D(^AUTTVNDR(ACHSVPTR,0)) S ACHSVNDR=$P(^(0),U) S ACHSEIN="" S:$D(^(11)) ACHSEIN=$P(^(11),U)_" "_$P(^(11),U,2)
S ACHSDOC=ACHSDOC2_"-"_ACHSFC_"-"_ACHSDOC1
K ACHSNAME
S ACHS=$O(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTYPE,DA,0))
I +ACHS>0,$D(^ACHSF(DUZ(2),"D",DA,"T",ACHS,0)) S DFN=$P(^(0),U,3) I +DFN>0,$D(^DPT(DFN,0)) S ACHSNAME=$P(^(0),U)
I '$D(ACHSNAME),ACHSBLNK S ACHSNAME=$S(ACHSBLNK=1:"* BLANKET",1:"* SPECIAL TRANS")
D ;
G C:'$D(ACHSNAME)
S:$D(^ACHSF(DUZ(2),"D",DA,"PA")) ACHS("$")=+^("PA")
S:$D(^ACHSF(DUZ(2),"D",DA,"ZA")) ACHS("$")=+^("ZA")
E ;
I ACHSSTS="C" S ACHS("$")=0 F ACHS=0:0 S ACHS=$O(^ACHSF(DUZ(2),"D",DA,"T",ACHS)) Q:+ACHS=0 S ACHS("$")=+$P(^(ACHS,0),U,4)
S ACHSDOS=""
I $O(^ACHSF(DUZ(2),"TB",ACHSBDT,"P",DA,0)) S ACHSDOS=$P(^ACHSF(DUZ(2),"D",DA,"T",$O(^ACHSF(DUZ(2),"TB",ACHSBDT,"P",DA,0)),0),U,10)
W $E(ACHSNAME,1,24),?25,$E(ACHSVNDR,1,26),?52,$E(ACHSBDT,4,7),$E(ACHSBDT,2,3)
W:ACHSDOS]"" "/",$E(ACHSDOS,4,7)
W ?64
G P1:"PC"'[ACHSSTS
W $S(ACHSSTS="P":"PAID",1:"CANCEL")
S X=ACHS("$")
D COMMA^%DTC
W ?80-$L(X),X
G P2
;
P1 ;
I +ACHS("$")'=0 S X=ACHS("$") D COMMA^%DTC W ?80-$L(X),X
P2 ;
W !,ACHSDOC,?25,ACHSEIN,?52,$S(ACHSTOS=1:"HOSPITAL",ACHSTOS=2:"DENTAL",ACHSTOS=3:"OUTPATIENT",1:"")
I ACHSSTS="P" S ACHSTOTP=ACHSTOTP+1,ACHSTOTP("$")=ACHSTOTP("$")+ACHS("$") G P3
I ACHSSTS="C" S ACHSCNX=ACHSCNX+1,ACHSCNX("$")=ACHSCNX("$")+ACHS("$") G P3
S ACHSOPEN=ACHSOPEN+1,ACHSOPEN("$")=ACHSOPEN("$")+ACHS("$")
P3 ; Ask RTRN if EOP, do header, go main loop.
W !!
I $Y>ACHSBM D RTRN^ACHS G KILL:$D(DUOUT)!$D(DTOUT) D HDR
G C
;
END ; Print totals, ask RTRN, write IOF.
W !,$$REPEAT^XLFSTR("-",79),!
S X2="2$",X3=14
I ACHSTOTP S X=ACHSTOTP("$") D COMMA^%DTC W "TOTAL PAID DOCUMENTS:",$J(ACHSTOTP,11),?40,"TOTAL DOLLARS PAID: ",X,!
I ACHSCNX S X=ACHSCNX("$") D COMMA^%DTC W "TOTAL CANCELLED DOCUMENTS:",$J(ACHSCNX,6),?40,"TOTAL DOLLARS CANCELLED: ",X,!
I ACHSOPEN S X=ACHSOPEN("$") D COMMA^%DTC W "TOTAL OPEN DOCUMENTS:",$J(ACHSOPEN,11),?40,"TOTAL DOLLARS OPEN: ",X
D RTRN^ACHS
W @IOF
KILL ; Do ERPT, kill vars, quit.
I $D(ZTQUEUED) K ACHSFC
D ERPT^ACHS
K ACHSDOC,ACHSDOC1,ACHSDOC2,ACHSBLNK,ACHSCNX,ACHSDOS,ACHSTYPE,ACHSVNDR,ACHSEIN,ACHSOPEN,ACHSNAME,ACHSSTS,ACHSTOS,ACHSTOTP,ACHSVPTR
K DA,DFN,X2,X3
Q
;
HDR ; Print report header.
S ACHSPG=ACHSPG+1
W @IOF,!!,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,$$C^XBFUNC("*** CONTRACT HEALTH MANAGEMENT SYSTEM ***",80),!!,ACHSLOC,!?29,"DOCUMENT STATUS REPORT"
I $D(ZTQUEUED) W ?77-$L(ZTSK),"(",ZTSK,")"
W !,ACHSTIME,!,ACHST1,!,ACHST2,!!,"Patient Name",?25,"Provider of Service",?52,"Issue /DOS",!,"Document number",?25,"EIN Number",?52,"Type",?64,"Status",?73,"Amount",!,$$REPEAT^XLFSTR("=",79),!
Q
;
ACHSDST ; IHS/ITSC/PMF - DOCUMENT STATUS REPORT ; [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 ;
TITLE ;;DOCUMENT STATUS
+1 SET ACHSIO=IO
+2 KILL X2,X3
BDT ;
+1 SET ACHSBDT=$$DATE^ACHS("B",$PIECE($TEXT(TITLE),";",3),"ISSUE")
+2 IF $DATA(DUOUT)!$DATA(DTOUT)!(ACHSBDT<1)
GOTO K
EDT ;
+1 SET ACHSEDT=$$DATE^ACHS("E",$PIECE($TEXT(TITLE),";",3),"ISSUE")
+2 IF $DATA(DTOUT)!(ACHSEDT<1)
GOTO K
IF $DATA(DUOUT)
GOTO BDT
+3 IF $$EBB^ACHS(ACHSBDT,ACHSEDT)
GOTO EDT
TYPE ;
+1 WRITE !!,"Which type of report?",!!," 1. OPEN DOCUMENTS only",!," 2. CLOSED DOCUMENTS only",!," 3. COMBINED list",!!," ENTER OPTION (1-3) 3//"
+2 DO READ^ACHSFU
+3 IF Y=""
SET Y=3
+4 IF $DATA(DTOUT)
GOTO K
IF Y?1"?".E
GOTO Q
IF $DATA(DUOUT)
GOTO BDT
+5 IF "123"[Y&(Y>0)&(Y<4)
SET ACHSRPT=Y
GOTO DEV
+6 WRITE !!,*7," Enter only a 1, 2, or 3"
+7 GOTO TYPE
+8 ;
Q ;
+1 WRITE !!,"Choice 1 - only open documents will be listed.",!,"Choice 2 - only documents which have been paid or cancelled will be listed.",!,"Choice 3 - open and closed documents will be listed together."
+2 GOTO TYPE
+3 ;
DEV ;
+1 SET %=$$PB^ACHS
+2 IF %=U!$DATA(DTOUT)!$DATA(DUOUT)
DO K
QUIT
+3 IF %="B"
DO VIEWR^XBLM("PRINT^ACHSDST")
DO EN^XBVK("VALM")
DO K
QUIT
+4 SET %ZIS="OPQ"
+5 DO ^%ZIS
+6 IF POP
DO HOME^%ZIS
GOTO K
+7 IF '$DATA(IO("Q"))
GOTO PRINT
+8 KILL IO("Q")
+9 IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
WRITE *7,!,"Please queue to system printers."
DO ^%ZISC
GOTO DEV
+10 SET ZTRTN="PRINT^ACHSDST"
SET ZTIO=""
SET ZTDESC=$PIECE($TEXT(TITLE),";",3)_", Type "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)
SET ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
+11 FOR ACHS="ACHSQIO","ACHSBDT","ACHSEDT","ACHSRPT"
SET ZTSAVE(ACHS)=""
+12 DO ^%ZTLOAD
+13 IF '$DATA(ZTSK)
GOTO DEV
K ;
+1 KILL ACHS,ACHSIO,ACHSQIO,ACHSBDT,ACHSEDT,ACHSRPT,ZTIO,ZTSK
+2 DO ^%ZISC
+3 QUIT
+4 ;
PRINT ;EP - From TaskMan.
+1 ;
+2 DO FC^ACHSUF
+3 IF $DATA(ACHSERR)
IF ACHSERR=1
KILL ZTSK
GOTO KILL
+4 SET (ACHSTOTP,ACHSCNX,ACHSOPEN,ACHSTOTP("$"),ACHSCNX("$"),ACHSOPEN("$"))=0
+5 SET ACHST1=$$C^XBFUNC($SELECT(ACHSRPT=1:"OPEN DOCUMENTS",ACHSRPT=2:"CLOSED DOCUMENTS",1:"OPEN AND CLOSED DOCUMENTS"),80)
SET ACHST2=$$C^XBFUNC("For the period "_$$FMTE^XLFDT(ACHSBDT)_" through "_$$FMTE^XLFDT(ACHSEDT),80)
+6 DO BRPT^ACHSFU
+7 DO HDR
+8 SET X3=0
SET ACHSBDT=ACHSBDT-1
A ; Main loop.
+1 SET ACHSBDT=$ORDER(^ACHSF(DUZ(2),"TB",ACHSBDT))
+2 IF +ACHSBDT=0!(+ACHSBDT>ACHSEDT)
GOTO END
+3 SET ACHSTYPE=""
B ;
+1 SET ACHSTYPE=$ORDER(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTYPE))
+2 IF ACHSTYPE=""
GOTO A
IF ACHSTYPE'="I"
GOTO B
+3 SET DA=0
C ;
+1 SET DA=$ORDER(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTYPE,DA))
+2 IF +DA=0
GOTO A
IF '$DATA(^ACHSF(DUZ(2),"D",DA,0))
GOTO A
SET ACHSSTS=$SELECT($PIECE(^(0),U,12)=3:"P",$PIECE(^(0),U,12)=4:"C",1:"OPEN")
+3 IF ACHSRPT=1
IF "PC"[ACHSSTS
GOTO C
+4 IF ACHSRPT=2
IF "PC"'[ACHSSTS
GOTO C
+5 SET ACHSDOC1=$PIECE(^ACHSF(DUZ(2),"D",DA,0),U)
SET ACHSVPTR=$PIECE(^(0),U,8)
SET ACHSDOC2=$PIECE(^(0),U,14)
SET ACHS("$")=$PIECE(^(0),U,9)
SET ACHSTOS=$PIECE(^(0),U,4)
SET ACHSBLNK=+$PIECE(^(0),U,3)
+6 IF ACHSVPTR']""
GOTO A
IF '$DATA(^AUTTVNDR(ACHSVPTR,0))
GOTO A
SET ACHSVNDR=$PIECE(^(0),U)
SET ACHSEIN=""
IF $DATA(^(11))
SET ACHSEIN=$PIECE(^(11),U)_" "_$PIECE(^(11),U,2)
+7 SET ACHSDOC=ACHSDOC2_"-"_ACHSFC_"-"_ACHSDOC1
+8 KILL ACHSNAME
+9 SET ACHS=$ORDER(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTYPE,DA,0))
+10 IF +ACHS>0
IF $DATA(^ACHSF(DUZ(2),"D",DA,"T",ACHS,0))
SET DFN=$PIECE(^(0),U,3)
IF +DFN>0
IF $DATA(^DPT(DFN,0))
SET ACHSNAME=$PIECE(^(0),U)
+11 IF '$DATA(ACHSNAME)
IF ACHSBLNK
SET ACHSNAME=$SELECT(ACHSBLNK=1:"* BLANKET",1:"* SPECIAL TRANS")
D ;
+1 IF '$DATA(ACHSNAME)
GOTO C
+2 IF $DATA(^ACHSF(DUZ(2),"D",DA,"PA"))
SET ACHS("$")=+^("PA")
+3 IF $DATA(^ACHSF(DUZ(2),"D",DA,"ZA"))
SET ACHS("$")=+^("ZA")
E ;
+1 IF ACHSSTS="C"
SET ACHS("$")=0
FOR ACHS=0:0
SET ACHS=$ORDER(^ACHSF(DUZ(2),"D",DA,"T",ACHS))
IF +ACHS=0
QUIT
SET ACHS("$")=+$PIECE(^(ACHS,0),U,4)
+2 SET ACHSDOS=""
+3 IF $ORDER(^ACHSF(DUZ(2),"TB",ACHSBDT,"P",DA,0))
SET ACHSDOS=$PIECE(^ACHSF(DUZ(2),"D",DA,"T",$ORDER(^ACHSF(DUZ(2),"TB",ACHSBDT,"P",DA,0)),0),U,10)
+4 WRITE $EXTRACT(ACHSNAME,1,24),?25,$EXTRACT(ACHSVNDR,1,26),?52,$EXTRACT(ACHSBDT,4,7),$EXTRACT(ACHSBDT,2,3)
+5 IF ACHSDOS]""
WRITE "/",$EXTRACT(ACHSDOS,4,7)
+6 WRITE ?64
+7 IF "PC"'[ACHSSTS
GOTO P1
+8 WRITE $SELECT(ACHSSTS="P":"PAID",1:"CANCEL")
+9 SET X=ACHS("$")
+10 DO COMMA^%DTC
+11 WRITE ?80-$LENGTH(X),X
+12 GOTO P2
+13 ;
P1 ;
+1 IF +ACHS("$")'=0
SET X=ACHS("$")
DO COMMA^%DTC
WRITE ?80-$LENGTH(X),X
P2 ;
+1 WRITE !,ACHSDOC,?25,ACHSEIN,?52,$SELECT(ACHSTOS=1:"HOSPITAL",ACHSTOS=2:"DENTAL",ACHSTOS=3:"OUTPATIENT",1:"")
+2 IF ACHSSTS="P"
SET ACHSTOTP=ACHSTOTP+1
SET ACHSTOTP("$")=ACHSTOTP("$")+ACHS("$")
GOTO P3
+3 IF ACHSSTS="C"
SET ACHSCNX=ACHSCNX+1
SET ACHSCNX("$")=ACHSCNX("$")+ACHS("$")
GOTO P3
+4 SET ACHSOPEN=ACHSOPEN+1
SET ACHSOPEN("$")=ACHSOPEN("$")+ACHS("$")
P3 ; Ask RTRN if EOP, do header, go main loop.
+1 WRITE !!
+2 IF $Y>ACHSBM
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO KILL
DO HDR
+3 GOTO C
+4 ;
END ; Print totals, ask RTRN, write IOF.
+1 WRITE !,$$REPEAT^XLFSTR("-",79),!
+2 SET X2="2$"
SET X3=14
+3 IF ACHSTOTP
SET X=ACHSTOTP("$")
DO COMMA^%DTC
WRITE "TOTAL PAID DOCUMENTS:",$JUSTIFY(ACHSTOTP,11),?40,"TOTAL DOLLARS PAID: ",X,!
+4 IF ACHSCNX
SET X=ACHSCNX("$")
DO COMMA^%DTC
WRITE "TOTAL CANCELLED DOCUMENTS:",$JUSTIFY(ACHSCNX,6),?40,"TOTAL DOLLARS CANCELLED: ",X,!
+5 IF ACHSOPEN
SET X=ACHSOPEN("$")
DO COMMA^%DTC
WRITE "TOTAL OPEN DOCUMENTS:",$JUSTIFY(ACHSOPEN,11),?40,"TOTAL DOLLARS OPEN: ",X
+6 DO RTRN^ACHS
+7 WRITE @IOF
KILL ; Do ERPT, kill vars, quit.
+1 IF $DATA(ZTQUEUED)
KILL ACHSFC
+2 DO ERPT^ACHS
+3 KILL ACHSDOC,ACHSDOC1,ACHSDOC2,ACHSBLNK,ACHSCNX,ACHSDOS,ACHSTYPE,ACHSVNDR,ACHSEIN,ACHSOPEN,ACHSNAME,ACHSSTS,ACHSTOS,ACHSTOTP,ACHSVPTR
+4 KILL DA,DFN,X2,X3
+5 QUIT
+6 ;
HDR ; Print report header.
+1 SET ACHSPG=ACHSPG+1
+2 WRITE @IOF,!!,ACHSUSR,?71,"Page",$JUSTIFY(ACHSPG,3),!,$$C^XBFUNC("*** CONTRACT HEALTH MANAGEMENT SYSTEM ***",80),!!,ACHSLOC,!?29,"DOCUMENT STATUS REPORT"
+3 IF $DATA(ZTQUEUED)
WRITE ?77-$LENGTH(ZTSK),"(",ZTSK,")"
+4 WRITE !,ACHSTIME,!,ACHST1,!,ACHST2,!!,"Patient Name",?25,"Provider of Service",?52,"Issue /DOS",!,"Document number",?25,"EIN Number",?52,"Type",?64,"Status",?73,"Amount",!,$$REPEAT^XLFSTR("=",79),!
+5 QUIT
+6 ;
