ACDPCCL4 ;IHS/ADC/EDE/KML - PCC LINK;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
GENBILL ; EP-GENERATE HARDCOPY BILL
;//^ACDPCCL
W !,"Generating hardcopy for billing",!
D GETDEV
I POP W !,"No hardcopy generated",! Q
D WRTBILL
D EOJ
Q
;
GETDEV ; EP-GET DEVICE FOR HARDCOPY OUTPUT
S ACDDEV=$P($G(^ACDF5PI(ACDPGM,11)),U,4)
S:ACDDEV]"" ACDDEV=$P($G(^%ZIS(1,ACDDEV,0)),U,2)
S:ACDDEV]"" %ZIS("B")=ACDDEV
D DEV^ACDDEU
Q
;
WRTBILL ; WRITE HARDCOPY BILL
I $D(IO("Q")) D Q
. S ZTRTN="WRTBILLQ^ACDPCCL4",ZTDESC="CDMIS HARDCOPY BILL",ZTDTH=$H,ZTSAVE("ACDEV")=""
. D ^%ZTLOAD
. Q
D WRTBILLQ
U 0
Q
;
WRTBILLQ ; EP - FOR TASKMAN
I $D(ACDSLAVE) S IOP=ACDSLAVE D ^%ZIS
U IO
D WRTBILLP
K ACDPDD
I $D(ACDSLAVE) W @IOF D ^%ZISC Q
W:IOST["P-" @IOF
I $D(ZTQUEUED) D ^ACDKILL S ZTREQ="@"
D:IOST["P-" ^%ZISC
Q
;
WRTBILLP ; EP
;//^ACDBILLP
D GETPDATA
S (ACDCSDTE,ACDLOC)=0 ; so they exists if not 'CS'
I ACDEV("TC")'="CS" D Q
. D HDR,WRTDATA
. Q
S ACDCSDTE=0
F S ACDCSDTE=$O(ACDEV("PROC",ACDCSDTE)) Q:ACDCSDTE="" S ACDLOC=0 F S ACDLOC=$O(ACDEV("PROC",ACDCSDTE,ACDLOC)) Q:'ACDLOC D
. S ACDEV("V DATE")=ACDCSDTE
. S ACDEV("CS LOC")=ACDEV("PROC",ACDCSDTE,ACDLOC,"CS LOC")
. S X=$G(ACDEV("PROC",ACDCSDTE,ACDLOC,"PCC LOC"))
. I X S ACDEV("LOCATION")=X
. S X=0
. F Y=0:0 S Y=$O(ACDEV("PROC",ACDCSDTE,ACDLOC,Y)) Q:'Y S X=X+ACDEV("PROC",ACDCSDTE,ACDLOC,Y,"TIME")
. S ACDEV("TIME")=X
. D HDR
. D WRTDATA
. Q
Q
;
GETPDATA ;
K ACDPDD
S DIC=9000001,DR=".01;1101.2;1102.2;1107.2;1602.2:1606.2",DA=ACDEV("PAT"),DIQ="ACDPDD("
D DIQ1^ACDFMC
S ACDPDD(9000001,ACDEV("PAT"),1102.2)=$$DD^ACDFUNC(ACDPDD(9000001,ACDEV("PAT"),1102.2))
S X=ACDPDD(9000001,ACDEV("PAT"),1107.2) I X]"",X'["-" S ACDPDD(9000001,ACDEV("PAT"),1107.2)=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,9)
Q
;
HDR ; WRITE HEADER
W @IOF
D CONF^ACDDEU
Q
;
WRTDATA ;
I $D(ACDMODEE) W "***** MODIFICATION OF PREVIOUS BILL *****",!
W !,"PATIENT NAME:",?40,ACDPDD(9000001,ACDEV("PAT"),.01)
W !," SEX:",?40,ACDPDD(9000001,ACDEV("PAT"),1101.2)
W !," DOB:",?40,ACDPDD(9000001,ACDEV("PAT"),1102.2)
W !," SSN:",?40,ACDPDD(9000001,ACDEV("PAT"),1107.2)
W !," PHONE:",?40,ACDPDD(9000001,ACDEV("PAT"),1606.2)
W !," ADDRESS:",?40,ACDPDD(9000001,ACDEV("PAT"),1602.2)
W !," ",?40,ACDPDD(9000001,ACDEV("PAT"),1603.2)," ",ACDPDD(9000001,ACDEV("PAT"),1604.2)," ",ACDPDD(9000001,ACDEV("PAT"),1605.2)
S X=ACDEV("PRI PROV"),Y="" I X,$D(^VA(200,X,0)) S Y=$P($G(^VA(200,X,"PS")),U,5),X=$P(^VA(200,X,0),U) I Y S Y=$P($G(^DIC(7,Y,0)),U,2)
;S X=ACDEV("PRI PROV"),Y="" I X,$D(^DIC(6,X,0)) S Y=$P(^DIC(6,X,0),U,4),X=$P(^DIC(16,X,0),U) I Y S Y=$P($G(^DIC(7,Y,0)),U,2)
W !!,"PRIMARY PROVIDER:",?40,X," ",Y
W !!,"VISIT DATE:",?40,$$DD^ACDFUNC(ACDEV("V DATE"))
D PFTV^XBPFTV(9002170.1,ACDEV("COMP CODE"),.X)
W !," COMPONENT CODE:",?40,X
W !," COMPONENT TYPE:",?40,$$EXTSET^XBFUNC(9002172.1,5,ACDEV("COMP TYPE"))
W !," TYPE CONTACT:",?40,$$EXTSET^XBFUNC(9002172.1,3,ACDEV("TC"))
D PFTV^XBPFTV(9999999.06,ACDEV("LOCATION"),.X)
W !," LOCATION:",?40,X
I $G(ACDEV("CS LOC")) S X=$P($G(^ACDLOT(ACDEV("CS LOC"),0)),U) I X]"" W !," CLIENT SVC LOCATION:",?40,X
W !," CLINIC:",?40,$P(^DIC(40.7,ACDEV("CLINIC"),0),U)
W !," SERVICE CATEGORY:",?40,$$EXTSET^XBFUNC(9000010,.07,ACDEV("SVC CAT"))
W !," TIME:",?40,ACDEV("TIME")_" MINUTES"
W !," THIRD PARTY COVERAGE:"
S ACDY=0
I $$MCR^AUPNPAT(ACDEV("PAT"),ACDEV("V DATE")) S ACDY=1 W ?40,"MEDICARE",!
I $$MCD^AUPNPAT(ACDEV("PAT"),ACDEV("V DATE")) S ACDY=1,ACDX=$$MCDPN^AUPNPAT(ACDEV("PAT"),ACDEV("V DATE"),"E") S:ACDX="" ACDX="MEDICAID PLAN UNKNOWN" W ?40,ACDX,!
I $$PI^AUPNPAT(ACDEV("PAT"),ACDEV("V DATE")) S ACDY=1,ACDX=$$PIN^AUPNPAT(ACDEV("PAT"),ACDEV("V DATE"),"E") S:ACDX="" ACDX="PLAN UNKNOWN" W ?40,ACDX,!
I 'ACDY W ?40,"NONE"
S ACDY=0
F S ACDY=$O(ACDEV("POV",ACDY)) Q:'ACDY D
. S ACDX=ACDEV("POV",ACDY)
. D F W !!,"PURPOSE OF VISIT:",?20,$P(ACDX,":",2),!,?20,$P(ACDX,":",3)
. Q
S ACDY=0
F S ACDY=$O(ACDEV("PROC",ACDCSDTE,ACDLOC,ACDY)) Q:'ACDY D
. S ACDX=ACDEV("PROC",ACDCSDTE,ACDLOC,ACDY,"NARR")
. D F W !!,"SERVICE:",?20,$P(ACDX,":",2),?40,"(",ACDEV("PROC",ACDCSDTE,ACDLOC,ACDY,"TIME")_" MINUTES)",!,?20,$P(ACDX,":",3)
. Q
S ACDPROV=0
F S ACDPROV=$O(ACDEV("PROC",ACDCSDTE,ACDLOC,"PROV",ACDPROV)) Q:'ACDPROV D
. S X=ACDPROV,Y="" I X,$D(^VA(200,X,0)) S Y=$P($G(^VA(200,X,"PS")),U,5),X=$P(^VA(200,X,0),U) I Y S Y=$P($G(^DIC(7,Y,0)),U,2)
.;S X=ACDPROV,Y="" I X,$D(^DIC(6,X,0)) S Y=$P(^DIC(6,X,0),U,4),X=$P(^DIC(16,X,0),U) I Y S Y=$P($G(^DIC(7,Y,0)),U,2)
. D F W !!,"PROVIDER:",?20,X," ",Y
. Q
W !!,"..........................................",!
I IO=IO(0) D PAUSE^ACDDEU
Q
;
F ;Form feed
I $Y+4>IOSL D
. I IO=IO(0) D PAUSE^ACDDEU
. D HDR
. Q
Q
;
EOJ ; EP
;//^ACDBILLP
K ACDCSDTE,ACDDEV,ACDLOC,ACDPDD,ACDPROV,ACDSLAVE,ACDX,ACDY
Q
ACDPCCL4 ;IHS/ADC/EDE/KML - PCC LINK;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
GENBILL ; EP-GENERATE HARDCOPY BILL
+1 ;//^ACDPCCL
+2 WRITE !,"Generating hardcopy for billing",!
+3 DO GETDEV
+4 IF POP
WRITE !,"No hardcopy generated",!
QUIT
+5 DO WRTBILL
+6 DO EOJ
+7 QUIT
+8 ;
GETDEV ; EP-GET DEVICE FOR HARDCOPY OUTPUT
+1 SET ACDDEV=$PIECE($GET(^ACDF5PI(ACDPGM,11)),U,4)
+2 IF ACDDEV]""
SET ACDDEV=$PIECE($GET(^%ZIS(1,ACDDEV,0)),U,2)
+3 IF ACDDEV]""
SET %ZIS("B")=ACDDEV
+4 DO DEV^ACDDEU
+5 QUIT
+6 ;
WRTBILL ; WRITE HARDCOPY BILL
+1 IF $DATA(IO("Q"))
Begin DoDot:1
+2 SET ZTRTN="WRTBILLQ^ACDPCCL4"
SET ZTDESC="CDMIS HARDCOPY BILL"
SET ZTDTH=$HOROLOG
SET ZTSAVE("ACDEV")=""
+3 DO ^%ZTLOAD
+4 QUIT
End DoDot:1
QUIT
+5 DO WRTBILLQ
+6 USE 0
+7 QUIT
+8 ;
WRTBILLQ ; EP - FOR TASKMAN
+1 IF $DATA(ACDSLAVE)
SET IOP=ACDSLAVE
DO ^%ZIS
+2 USE IO
+3 DO WRTBILLP
+4 KILL ACDPDD
+5 IF $DATA(ACDSLAVE)
WRITE @IOF
DO ^%ZISC
QUIT
+6 IF IOST["P-"
WRITE @IOF
+7 IF $DATA(ZTQUEUED)
DO ^ACDKILL
SET ZTREQ="@"
+8 IF IOST["P-"
DO ^%ZISC
+9 QUIT
+10 ;
WRTBILLP ; EP
+1 ;//^ACDBILLP
+2 DO GETPDATA
+3 ; so they exists if not 'CS'
SET (ACDCSDTE,ACDLOC)=0
+4 IF ACDEV("TC")'="CS"
Begin DoDot:1
+5 DO HDR
DO WRTDATA
+6 QUIT
End DoDot:1
QUIT
+7 SET ACDCSDTE=0
+8 FOR
SET ACDCSDTE=$ORDER(ACDEV("PROC",ACDCSDTE))
IF ACDCSDTE=""
QUIT
SET ACDLOC=0
FOR
SET ACDLOC=$ORDER(ACDEV("PROC",ACDCSDTE,ACDLOC))
IF 'ACDLOC
QUIT
Begin DoDot:1
+9 SET ACDEV("V DATE")=ACDCSDTE
+10 SET ACDEV("CS LOC")=ACDEV("PROC",ACDCSDTE,ACDLOC,"CS LOC")
+11 SET X=$GET(ACDEV("PROC",ACDCSDTE,ACDLOC,"PCC LOC"))
+12 IF X
SET ACDEV("LOCATION")=X
+13 SET X=0
+14 FOR Y=0:0
SET Y=$ORDER(ACDEV("PROC",ACDCSDTE,ACDLOC,Y))
IF 'Y
QUIT
SET X=X+ACDEV("PROC",ACDCSDTE,ACDLOC,Y,"TIME")
+15 SET ACDEV("TIME")=X
+16 DO HDR
+17 DO WRTDATA
+18 QUIT
End DoDot:1
+19 QUIT
+20 ;
GETPDATA ;
+1 KILL ACDPDD
+2 SET DIC=9000001
SET DR=".01;1101.2;1102.2;1107.2;1602.2:1606.2"
SET DA=ACDEV("PAT")
SET DIQ="ACDPDD("
+3 DO DIQ1^ACDFMC
+4 SET ACDPDD(9000001,ACDEV("PAT"),1102.2)=$$DD^ACDFUNC(ACDPDD(9000001,ACDEV("PAT"),1102.2))
+5 SET X=ACDPDD(9000001,ACDEV("PAT"),1107.2)
IF X]""
IF X'["-"
SET ACDPDD(9000001,ACDEV("PAT"),1107.2)=$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,9)
+6 QUIT
+7 ;
HDR ; WRITE HEADER
+1 WRITE @IOF
+2 DO CONF^ACDDEU
+3 QUIT
+4 ;
WRTDATA ;
+1 IF $DATA(ACDMODEE)
WRITE "***** MODIFICATION OF PREVIOUS BILL *****",!
+2 WRITE !,"PATIENT NAME:",?40,ACDPDD(9000001,ACDEV("PAT"),.01)
+3 WRITE !," SEX:",?40,ACDPDD(9000001,ACDEV("PAT"),1101.2)
+4 WRITE !," DOB:",?40,ACDPDD(9000001,ACDEV("PAT"),1102.2)
+5 WRITE !," SSN:",?40,ACDPDD(9000001,ACDEV("PAT"),1107.2)
+6 WRITE !," PHONE:",?40,ACDPDD(9000001,ACDEV("PAT"),1606.2)
+7 WRITE !," ADDRESS:",?40,ACDPDD(9000001,ACDEV("PAT"),1602.2)
+8 WRITE !," ",?40,ACDPDD(9000001,ACDEV("PAT"),1603.2)," ",ACDPDD(9000001,ACDEV("PAT"),1604.2)," ",ACDPDD(9000001,ACDEV("PAT"),1605.2)
+9 SET X=ACDEV("PRI PROV")
SET Y=""
IF X
IF $DATA(^VA(200,X,0))
SET Y=$PIECE($GET(^VA(200,X,"PS")),U,5)
SET X=$PIECE(^VA(200,X,0),U)
IF Y
SET Y=$PIECE($GET(^DIC(7,Y,0)),U,2)
+10 ;S X=ACDEV("PRI PROV"),Y="" I X,$D(^DIC(6,X,0)) S Y=$P(^DIC(6,X,0),U,4),X=$P(^DIC(16,X,0),U) I Y S Y=$P($G(^DIC(7,Y,0)),U,2)
+11 WRITE !!,"PRIMARY PROVIDER:",?40,X," ",Y
+12 WRITE !!,"VISIT DATE:",?40,$$DD^ACDFUNC(ACDEV("V DATE"))
+13 DO PFTV^XBPFTV(9002170.1,ACDEV("COMP CODE"),.X)
+14 WRITE !," COMPONENT CODE:",?40,X
+15 WRITE !," COMPONENT TYPE:",?40,$$EXTSET^XBFUNC(9002172.1,5,ACDEV("COMP TYPE"))
+16 WRITE !," TYPE CONTACT:",?40,$$EXTSET^XBFUNC(9002172.1,3,ACDEV("TC"))
+17 DO PFTV^XBPFTV(9999999.06,ACDEV("LOCATION"),.X)
+18 WRITE !," LOCATION:",?40,X
+19 IF $GET(ACDEV("CS LOC"))
SET X=$PIECE($GET(^ACDLOT(ACDEV("CS LOC"),0)),U)
IF X]""
WRITE !," CLIENT SVC LOCATION:",?40,X
+20 WRITE !," CLINIC:",?40,$PIECE(^DIC(40.7,ACDEV("CLINIC"),0),U)
+21 WRITE !," SERVICE CATEGORY:",?40,$$EXTSET^XBFUNC(9000010,.07,ACDEV("SVC CAT"))
+22 WRITE !," TIME:",?40,ACDEV("TIME")_" MINUTES"
+23 WRITE !," THIRD PARTY COVERAGE:"
+24 SET ACDY=0
+25 IF $$MCR^AUPNPAT(ACDEV("PAT"),ACDEV("V DATE"))
SET ACDY=1
WRITE ?40,"MEDICARE",!
+26 IF $$MCD^AUPNPAT(ACDEV("PAT"),ACDEV("V DATE"))
SET ACDY=1
SET ACDX=$$MCDPN^AUPNPAT(ACDEV("PAT"),ACDEV("V DATE"),"E")
IF ACDX=""
SET ACDX="MEDICAID PLAN UNKNOWN"
WRITE ?40,ACDX,!
+27 IF $$PI^AUPNPAT(ACDEV("PAT"),ACDEV("V DATE"))
SET ACDY=1
SET ACDX=$$PIN^AUPNPAT(ACDEV("PAT"),ACDEV("V DATE"),"E")
IF ACDX=""
SET ACDX="PLAN UNKNOWN"
WRITE ?40,ACDX,!
+28 IF 'ACDY
WRITE ?40,"NONE"
+29 SET ACDY=0
+30 FOR
SET ACDY=$ORDER(ACDEV("POV",ACDY))
IF 'ACDY
QUIT
Begin DoDot:1
+31 SET ACDX=ACDEV("POV",ACDY)
+32 DO F
WRITE !!,"PURPOSE OF VISIT:",?20,$PIECE(ACDX,":",2),!,?20,$PIECE(ACDX,":",3)
+33 QUIT
End DoDot:1
+34 SET ACDY=0
+35 FOR
SET ACDY=$ORDER(ACDEV("PROC",ACDCSDTE,ACDLOC,ACDY))
IF 'ACDY
QUIT
Begin DoDot:1
+36 SET ACDX=ACDEV("PROC",ACDCSDTE,ACDLOC,ACDY,"NARR")
+37 DO F
WRITE !!,"SERVICE:",?20,$PIECE(ACDX,":",2),?40,"(",ACDEV("PROC",ACDCSDTE,ACDLOC,ACDY,"TIME")_" MINUTES)",!,?20,$PIECE(ACDX,":",3)
+38 QUIT
End DoDot:1
+39 SET ACDPROV=0
+40 FOR
SET ACDPROV=$ORDER(ACDEV("PROC",ACDCSDTE,ACDLOC,"PROV",ACDPROV))
IF 'ACDPROV
QUIT
Begin DoDot:1
+41 SET X=ACDPROV
SET Y=""
IF X
IF $DATA(^VA(200,X,0))
SET Y=$PIECE($GET(^VA(200,X,"PS")),U,5)
SET X=$PIECE(^VA(200,X,0),U)
IF Y
SET Y=$PIECE($GET(^DIC(7,Y,0)),U,2)
+42 ;S X=ACDPROV,Y="" I X,$D(^DIC(6,X,0)) S Y=$P(^DIC(6,X,0),U,4),X=$P(^DIC(16,X,0),U) I Y S Y=$P($G(^DIC(7,Y,0)),U,2)
+43 DO F
WRITE !!,"PROVIDER:",?20,X," ",Y
+44 QUIT
End DoDot:1
+45 WRITE !!,"..........................................",!
+46 IF IO=IO(0)
DO PAUSE^ACDDEU
+47 QUIT
+48 ;
F ;Form feed
+1 IF $Y+4>IOSL
Begin DoDot:1
+2 IF IO=IO(0)
DO PAUSE^ACDDEU
+3 DO HDR
+4 QUIT
End DoDot:1
+5 QUIT
+6 ;
EOJ ; EP
+1 ;//^ACDBILLP
+2 KILL ACDCSDTE,ACDDEV,ACDLOC,ACDPDD,ACDPROV,ACDSLAVE,ACDX,ACDY
+3 QUIT
