ACHSDSF ; IHS/ITSC/PMF - DOC STATUS REPORT BY FY (1/2) - FORMAT & DEVICE ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
S ACHSIO=IO
FYSEL ; Select fiscal year for report.
S ACHSFY=$$FYSEL^ACHS
G:$D(DUOUT)!$D(DTOUT) K
S %=$$FY^ACHSVAR($E(ACHSFY,3,4)),ACHSBDT=$P(%,U),ACHSEDT=$P(%,U,2)
I ACHSEDT>DT S ACHSEDT=DT
TYPE ; Select type of report.
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,FYSEL:$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^ACHSDSF"),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^ACHSDSF",ZTDESC="CHS Document Status, Type "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT),ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
F %="ACHSBDT","ACHSEDT","ACHSFY","ACHSRPT" S ZTSAVE(%)=""
D ^%ZTLOAD
G:'$D(ZTSK) DEV
K ;
D EN^XBVK("ACHS"),^ACHSVAR
K 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,HDR
S X3=0,ACHSDNU=1_($E(ACHSFY,4))_"00000"
A ; Main loop. Check end date.
S ACHSDNU=$O(^ACHSF(DUZ(2),"D","B",ACHSDNU))
G END:ACHSDNU="",END:$E(ACHSDNU,2)'=$E(ACHSFY,4)
S ACHSDIEN=""
B ; Get IEN.
S ACHSDIEN=$O(^ACHSF(DUZ(2),"D","B",ACHSDNU,ACHSDIEN))
G A:ACHSDIEN=""
C ;
G A:'$D(^ACHSF(DUZ(2),"D",ACHSDIEN,0)) S ACHSSTS=$S($P(^(0),U,12)=3:"P",$P(^(0),U,12)=4:"C",1:"OPEN")
I ACHSRPT=1,"PC"[ACHSSTS G B
I ACHSRPT=2,"PC"'[ACHSSTS G B
S ACHSDOC1=$P(^ACHSF(DUZ(2),"D",ACHSDIEN,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),ACHSDDT=$P(^(0),U,2),ACHS("$PCAN")=0
G B:ACHSVPTR']"",B:'$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 DFN=$P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,22)
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")
G B:'$D(ACHSNAME)
S:$D(^ACHSF(DUZ(2),"D",ACHSDIEN,"PA")) ACHS("$")=+^("PA")
S:$D(^ACHSF(DUZ(2),"D",ACHSDIEN,"ZA")) ACHS("$")=+^("ZA")
; I ACHSSTS="C" S ACHS("$")=0
F ACHS=0:0 S ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHS)) Q:+ACHS=0 D
. S ACHSDOS=$P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHS,0),U,10)
. I $P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHS,0),U,2)="C",$P(^(0),U,5)="F" S ACHS("$")=$P(^(0),U,4)
. I $P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHS,0),U,2)="C",$P(^(0),U,5)="P" S ACHS("$PCAN")=ACHS("$PCAN")+$P(^(0),U,4)
.Q
W $E(ACHSNAME,1,24),?25,$E(ACHSVNDR,1,26),?52,$E(ACHSDDT,4,7),$E(ACHSDDT,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 ; Open doc amt.
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 ACHS("$PCAN") W ?64,"P-CAN" S X=$FN(ACHS("$PCAN"),",",2) W ?79-$L(X),X
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("$")
I ACHS("$PCAN") S ACHSCNX("$")=ACHSCNX("$")+ACHS("$PCAN")
P3 ; End of transaction.
W !!
I $Y>ACHSBM D RTRN^ACHS G KILL:$D(DUOUT)!$D(DTOUT) D HDR
G B
;
END ; Print totals.
W !,$$REPEAT^XLFSTR("-",80),!
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
I ACHSCNX W !,"NOTE: Partial Cancels are not included in count, but ARE included in $."
D RTRN^ACHS
W @IOF
KILL ; Do ERPT, kill vars, quit.
D ERPT^ACHS
K ACHSDDT,ACHSDNU,ACHSDOC,ACHSDOC1,ACHSDOC2,ACHSBLNK,ACHSCNX,ACHSDOS,ACHSTYPE,ACHSVNDR,ACHSEIN,ACHSOPEN,ACHSNAME,ACHSSTS,ACHSTOS,ACHSTOTP,ACHSVPTR,ACHSDIEN,DFN,X2,X3,ACHSFY
Q
;
HDR ; Doc status rpt header.
S ACHSPG=ACHSPG+1
W @IOF,!,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,$$C^XBFUNC("*** CONTRACT HEALTH MANAGEMENT SYSTEM ***",80),!,ACHSLOC,!,$$C^XBFUNC("DOCUMENT STATUS REPORT, FY "_ACHSFY,80)
I $D(ZTQUEUED),$G(ZTSK) 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("=",80),!
Q
;
ACHSDSF ; IHS/ITSC/PMF - DOC STATUS REPORT BY FY (1/2) - FORMAT & DEVICE ; [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 SET ACHSIO=IO
FYSEL ; Select fiscal year for report.
+1 SET ACHSFY=$$FYSEL^ACHS
+2 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO K
+3 SET %=$$FY^ACHSVAR($EXTRACT(ACHSFY,3,4))
SET ACHSBDT=$PIECE(%,U)
SET ACHSEDT=$PIECE(%,U,2)
+4 IF ACHSEDT>DT
SET ACHSEDT=DT
TYPE ; Select type of report.
+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 FYSEL
+5 IF "123"[Y
IF Y>0
IF 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^ACHSDSF")
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^ACHSDSF"
SET ZTDESC="CHS Document Status, Type "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)
SET ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
+11 FOR %="ACHSBDT","ACHSEDT","ACHSFY","ACHSRPT"
SET ZTSAVE(%)=""
+12 DO ^%ZTLOAD
+13 IF '$DATA(ZTSK)
GOTO DEV
K ;
+1 DO EN^XBVK("ACHS")
DO ^ACHSVAR
+2 KILL ZTIO,ZTSK
+3 DO ^%ZISC
+4 QUIT
+5 ;
PRINT ;EP - From TaskMan.
+1 DO FC^ACHSUF
+2 IF $DATA(ACHSERR)
IF ACHSERR=1
KILL ZTSK
GOTO KILL
+3 SET (ACHSTOTP,ACHSCNX,ACHSOPEN,ACHSTOTP("$"),ACHSCNX("$"),ACHSOPEN("$"))=0
+4 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)
+5 DO BRPT^ACHSFU
DO HDR
+6 SET X3=0
SET ACHSDNU=1_($EXTRACT(ACHSFY,4))_"00000"
A ; Main loop. Check end date.
+1 SET ACHSDNU=$ORDER(^ACHSF(DUZ(2),"D","B",ACHSDNU))
+2 IF ACHSDNU=""
GOTO END
IF $EXTRACT(ACHSDNU,2)'=$EXTRACT(ACHSFY,4)
GOTO END
+3 SET ACHSDIEN=""
B ; Get IEN.
+1 SET ACHSDIEN=$ORDER(^ACHSF(DUZ(2),"D","B",ACHSDNU,ACHSDIEN))
+2 IF ACHSDIEN=""
GOTO A
C ;
+1 IF '$DATA(^ACHSF(DUZ(2),"D",ACHSDIEN,0))
GOTO A
SET ACHSSTS=$SELECT($PIECE(^(0),U,12)=3:"P",$PIECE(^(0),U,12)=4:"C",1:"OPEN")
+2 IF ACHSRPT=1
IF "PC"[ACHSSTS
GOTO B
+3 IF ACHSRPT=2
IF "PC"'[ACHSSTS
GOTO B
+4 SET ACHSDOC1=$PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,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)
SET ACHSDDT=$PIECE(^(0),U,2)
SET ACHS("$PCAN")=0
+5 IF ACHSVPTR']""
GOTO B
IF '$DATA(^AUTTVNDR(ACHSVPTR,0))
GOTO B
SET ACHSVNDR=$PIECE(^(0),U)
SET ACHSEIN=""
IF $DATA(^(11))
SET ACHSEIN=$PIECE(^(11),U)_" "_$PIECE(^(11),U,2)
+6 SET ACHSDOC=ACHSDOC2_"-"_ACHSFC_"-"_ACHSDOC1
+7 KILL ACHSNAME
+8 SET DFN=$PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,22)
+9 IF +DFN>0
IF $DATA(^DPT(DFN,0))
SET ACHSNAME=$PIECE(^(0),U)
+10 IF '$DATA(ACHSNAME)
IF ACHSBLNK
SET ACHSNAME=$SELECT(ACHSBLNK=1:"* BLANKET",1:"* SPECIAL TRANS")
+11 IF '$DATA(ACHSNAME)
GOTO B
+12 IF $DATA(^ACHSF(DUZ(2),"D",ACHSDIEN,"PA"))
SET ACHS("$")=+^("PA")
+13 IF $DATA(^ACHSF(DUZ(2),"D",ACHSDIEN,"ZA"))
SET ACHS("$")=+^("ZA")
+14 ; I ACHSSTS="C" S ACHS("$")=0
+15 FOR ACHS=0:0
SET ACHS=$ORDER(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHS))
IF +ACHS=0
QUIT
Begin DoDot:1
+16 SET ACHSDOS=$PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHS,0),U,10)
+17 IF $PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHS,0),U,2)="C"
IF $PIECE(^(0),U,5)="F"
SET ACHS("$")=$PIECE(^(0),U,4)
+18 IF $PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHS,0),U,2)="C"
IF $PIECE(^(0),U,5)="P"
SET ACHS("$PCAN")=ACHS("$PCAN")+$PIECE(^(0),U,4)
+19 QUIT
End DoDot:1
+20 WRITE $EXTRACT(ACHSNAME,1,24),?25,$EXTRACT(ACHSVNDR,1,26),?52,$EXTRACT(ACHSDDT,4,7),$EXTRACT(ACHSDDT,2,3)
+21 IF ACHSDOS]""
WRITE "/",$EXTRACT(ACHSDOS,4,7)
+22 WRITE ?64
+23 IF "PC"'[ACHSSTS
GOTO P1
+24 WRITE $SELECT(ACHSSTS="P":"PAID",1:"CANCEL")
+25 SET X=ACHS("$")
+26 DO COMMA^%DTC
+27 WRITE ?80-$LENGTH(X),X
+28 GOTO P2
+29 ;
P1 ; Open doc amt.
+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 ACHS("$PCAN")
WRITE ?64,"P-CAN"
SET X=$FNUMBER(ACHS("$PCAN"),",",2)
WRITE ?79-$LENGTH(X),X
+3 IF ACHSSTS="P"
SET ACHSTOTP=ACHSTOTP+1
SET ACHSTOTP("$")=ACHSTOTP("$")+ACHS("$")
GOTO P3
+4 IF ACHSSTS="C"
SET ACHSCNX=ACHSCNX+1
SET ACHSCNX("$")=ACHSCNX("$")+ACHS("$")
GOTO P3
+5 SET ACHSOPEN=ACHSOPEN+1
SET ACHSOPEN("$")=ACHSOPEN("$")+ACHS("$")
+6 IF ACHS("$PCAN")
SET ACHSCNX("$")=ACHSCNX("$")+ACHS("$PCAN")
P3 ; End of transaction.
+1 WRITE !!
+2 IF $Y>ACHSBM
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO KILL
DO HDR
+3 GOTO B
+4 ;
END ; Print totals.
+1 WRITE !,$$REPEAT^XLFSTR("-",80),!
+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 IF ACHSCNX
WRITE !,"NOTE: Partial Cancels are not included in count, but ARE included in $."
+7 DO RTRN^ACHS
+8 WRITE @IOF
KILL ; Do ERPT, kill vars, quit.
+1 DO ERPT^ACHS
+2 KILL ACHSDDT,ACHSDNU,ACHSDOC,ACHSDOC1,ACHSDOC2,ACHSBLNK,ACHSCNX,ACHSDOS,ACHSTYPE,ACHSVNDR,ACHSEIN,ACHSOPEN,ACHSNAME,ACHSSTS,ACHSTOS,ACHSTOTP,ACHSVPTR,ACHSDIEN,DFN,X2,X3,ACHSFY
+3 QUIT
+4 ;
HDR ; Doc status rpt header.
+1 SET ACHSPG=ACHSPG+1
+2 WRITE @IOF,!,ACHSUSR,?71,"Page",$JUSTIFY(ACHSPG,3),!,$$C^XBFUNC("*** CONTRACT HEALTH MANAGEMENT SYSTEM ***",80),!,ACHSLOC,!,$$C^XBFUNC("DOCUMENT STATUS REPORT, FY "_ACHSFY,80)
+3 IF $DATA(ZTQUEUED)
IF $GET(ZTSK)
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("=",80),!
+5 QUIT
+6 ;
