Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACDPCCL4

ACDPCCL4.m

Go to the documentation of this file. 
  1. ACDPCCL4 ;IHS/ADC/EDE/KML - PCC LINK;
  1.  ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1.  ;
  1. GENBILL ; EP-GENERATE HARDCOPY BILL
  1.  ;//^ACDPCCL
  1.  W !,"Generating hardcopy for billing",!
  1.  D GETDEV
  1.  I POP W !,"No hardcopy generated",! Q
  1.  D WRTBILL
  1.  D EOJ
  1.  Q
  1.  ;
  1. GETDEV ; EP-GET DEVICE FOR HARDCOPY OUTPUT
  1.  S ACDDEV=$P($G(^ACDF5PI(ACDPGM,11)),U,4)
  1.  S:ACDDEV]"" ACDDEV=$P($G(^%ZIS(1,ACDDEV,0)),U,2)
  1.  S:ACDDEV]"" %ZIS("B")=ACDDEV
  1.  D DEV^ACDDEU
  1.  Q
  1.  ;
  1. WRTBILL ; WRITE HARDCOPY BILL
  1.  I $D(IO("Q")) D  Q
  1.  . S ZTRTN="WRTBILLQ^ACDPCCL4",ZTDESC="CDMIS HARDCOPY BILL",ZTDTH=$H,ZTSAVE("ACDEV")=""
  1.  . D ^%ZTLOAD
  1.  . Q
  1.  D WRTBILLQ
  1.  U 0
  1.  Q
  1.  ;
  1. WRTBILLQ ; EP - FOR TASKMAN
  1.  I $D(ACDSLAVE) S IOP=ACDSLAVE D ^%ZIS
  1.  U IO
  1.  D WRTBILLP
  1.  K ACDPDD
  1.  I $D(ACDSLAVE) W @IOF D ^%ZISC Q
  1.  W:IOST["P-" @IOF
  1.  I $D(ZTQUEUED) D ^ACDKILL S ZTREQ="@"
  1.  D:IOST["P-" ^%ZISC
  1.  Q
  1.  ;
  1. WRTBILLP ; EP
  1.  ;//^ACDBILLP
  1.  D GETPDATA
  1.  S (ACDCSDTE,ACDLOC)=0 ;                so they exists if not 'CS'
  1.  I ACDEV("TC")'="CS" D  Q
  1.  . D HDR,WRTDATA
  1.  . Q
  1.  S ACDCSDTE=0
  1.  F  S ACDCSDTE=$O(ACDEV("PROC",ACDCSDTE)) Q:ACDCSDTE=""  S ACDLOC=0 F  S ACDLOC=$O(ACDEV("PROC",ACDCSDTE,ACDLOC)) Q:'ACDLOC  D
  1.  . S ACDEV("V DATE")=ACDCSDTE
  1.  . S ACDEV("CS LOC")=ACDEV("PROC",ACDCSDTE,ACDLOC,"CS LOC")
  1.  . S X=$G(ACDEV("PROC",ACDCSDTE,ACDLOC,"PCC LOC"))
  1.  . I X S ACDEV("LOCATION")=X
  1.  . S X=0
  1.  . F Y=0:0 S Y=$O(ACDEV("PROC",ACDCSDTE,ACDLOC,Y)) Q:'Y  S X=X+ACDEV("PROC",ACDCSDTE,ACDLOC,Y,"TIME")
  1.  . S ACDEV("TIME")=X
  1.  . D HDR
  1.  . D WRTDATA
  1.  . Q
  1.  Q
  1.  ;
  1. GETPDATA ;
  1.  K ACDPDD
  1.  S DIC=9000001,DR=".01;1101.2;1102.2;1107.2;1602.2:1606.2",DA=ACDEV("PAT"),DIQ="ACDPDD("
  1.  D DIQ1^ACDFMC
  1.  S ACDPDD(9000001,ACDEV("PAT"),1102.2)=$$DD^ACDFUNC(ACDPDD(9000001,ACDEV("PAT"),1102.2))
  1.  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)
  1.  Q
  1.  ;
  1. HDR ; WRITE HEADER
  1.  W @IOF
  1.  D CONF^ACDDEU
  1.  Q
  1.  ;
  1. WRTDATA ;
  1.  I $D(ACDMODEE) W "***** MODIFICATION OF PREVIOUS BILL *****",!
  1.  W !,"PATIENT NAME:",?40,ACDPDD(9000001,ACDEV("PAT"),.01)
  1.  W !,"  SEX:",?40,ACDPDD(9000001,ACDEV("PAT"),1101.2)
  1.  W !,"  DOB:",?40,ACDPDD(9000001,ACDEV("PAT"),1102.2)
  1.  W !,"  SSN:",?40,ACDPDD(9000001,ACDEV("PAT"),1107.2)
  1.  W !,"  PHONE:",?40,ACDPDD(9000001,ACDEV("PAT"),1606.2)
  1.  W !,"  ADDRESS:",?40,ACDPDD(9000001,ACDEV("PAT"),1602.2)
  1.  W !,"  ",?40,ACDPDD(9000001,ACDEV("PAT"),1603.2),"  ",ACDPDD(9000001,ACDEV("PAT"),1604.2),"  ",ACDPDD(9000001,ACDEV("PAT"),1605.2)
  1.  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)
  1.  ;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)
  1.  W !!,"PRIMARY PROVIDER:",?40,X,"  ",Y
  1.  W !!,"VISIT DATE:",?40,$$DD^ACDFUNC(ACDEV("V DATE"))
  1.  D PFTV^XBPFTV(9002170.1,ACDEV("COMP CODE"),.X)
  1.  W !,"  COMPONENT CODE:",?40,X
  1.  W !,"  COMPONENT TYPE:",?40,$$EXTSET^XBFUNC(9002172.1,5,ACDEV("COMP TYPE"))
  1.  W !,"  TYPE CONTACT:",?40,$$EXTSET^XBFUNC(9002172.1,3,ACDEV("TC"))
  1.  D PFTV^XBPFTV(9999999.06,ACDEV("LOCATION"),.X)
  1.  W !,"  LOCATION:",?40,X
  1.  I $G(ACDEV("CS LOC")) S X=$P($G(^ACDLOT(ACDEV("CS LOC"),0)),U) I X]"" W !,"  CLIENT SVC LOCATION:",?40,X
  1.  W !,"  CLINIC:",?40,$P(^DIC(40.7,ACDEV("CLINIC"),0),U)
  1.  W !,"  SERVICE CATEGORY:",?40,$$EXTSET^XBFUNC(9000010,.07,ACDEV("SVC CAT"))
  1.  W !,"  TIME:",?40,ACDEV("TIME")_" MINUTES"
  1.  W !,"  THIRD PARTY COVERAGE:"
  1.  S ACDY=0
  1.  I $$MCR^AUPNPAT(ACDEV("PAT"),ACDEV("V DATE")) S ACDY=1 W ?40,"MEDICARE",!
  1.  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,!
  1.  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,!
  1.  I 'ACDY W ?40,"NONE"
  1.  S ACDY=0
  1.  F  S ACDY=$O(ACDEV("POV",ACDY)) Q:'ACDY  D
  1.  . S ACDX=ACDEV("POV",ACDY)
  1.  . D F W !!,"PURPOSE OF VISIT:",?20,$P(ACDX,":",2),!,?20,$P(ACDX,":",3)
  1.  . Q
  1.  S ACDY=0
  1.  F  S ACDY=$O(ACDEV("PROC",ACDCSDTE,ACDLOC,ACDY)) Q:'ACDY  D
  1.  . S ACDX=ACDEV("PROC",ACDCSDTE,ACDLOC,ACDY,"NARR")
  1.  . D F W !!,"SERVICE:",?20,$P(ACDX,":",2),?40,"(",ACDEV("PROC",ACDCSDTE,ACDLOC,ACDY,"TIME")_" MINUTES)",!,?20,$P(ACDX,":",3)
  1.  . Q
  1.  S ACDPROV=0
  1.  F  S ACDPROV=$O(ACDEV("PROC",ACDCSDTE,ACDLOC,"PROV",ACDPROV)) Q:'ACDPROV  D
  1.  . 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)
  1.  .;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)
  1.  . D F W !!,"PROVIDER:",?20,X,"  ",Y
  1.  . Q
  1.  W !!,"..........................................",!
  1.  I IO=IO(0) D PAUSE^ACDDEU
  1.  Q
  1.  ;
  1. F ;Form feed
  1.  I $Y+4>IOSL D
  1.  . I IO=IO(0) D PAUSE^ACDDEU
  1.  . D HDR
  1.  . Q
  1.  Q
  1.  ;
  1. EOJ ; EP
  1.  ;//^ACDBILLP
  1.  K ACDCSDTE,ACDDEV,ACDLOC,ACDPDD,ACDPROV,ACDSLAVE,ACDX,ACDY
  1.  Q