ACDPCCL.m

ACDPCCL ;IHS/ADC/EDE/KML - PCC LINK;

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 ;

 ; Local array set as CDMIS entries added or edited:

 ;     ACDPCCL(patient ien,visit ien)=""

 ;     ACDPCCL(patient ien,visit ien,"CS",cs ien)=""

 ;     ACDPCCL(patient ien,visit ien,"IIF",iif ien)=""

 ;     ACDPCCL(patient ien,visit ien,"TDC",tdc ien)=""

 ;

 ; Local array set by this routine for PROTOCOL file:

 ;  PGM

 ;     ACDEV("TYPE")=add/edit/delete (i.e., A,E,D)

 ;     ACDEV("SITE TYPE")=pcc visit type (e.g. I, 6)

 ;     ACDEV("CLINIC")=clinic stop ien

 ;     ACDEV("LOCATION")=location ien

 ;  VIS

 ;     ACDEV("VISIT")=visit ien

 ;     ACDEV("PAT")=patient ien

 ;     ACDEV("TC")=type contact (e.g. IN, CS)

 ;     ACDEV("V DATE")=date of CDMIS visit

 ;     ACDEV("PRI PROV")=primary provider ien

 ;     ACDEV("SVC CAT")=service category (e.g. A)

 ;  IIF & TDC

 ;     ACDEV("POV",n)=icd9 ien:code:CHEMICAL DEPENDENCY-problem narr

 ;     ACDEV("TIME")=time in minutes

 ;  CS

 ;    *ACDEV("V DATE")=date of CDMIS visit

 ;    *ACDEV("LOCATION")=location ien

 ;    *ACDEV("TIME")=time in minutes

 ;    *ACDEV("POV",1)=icd9 ien:code:CONSULTING ON SUBSTANCE USE & ABUSE

 ;     ACDEV("PROC",date,loc,n,"CS IEN")=ien of client svc entry

 ;     ACDEV("PROC",date,loc,n,"NARR")=

 ;                          cpt ien:code:CHEMICAL DEPENDENCY-CS narr

 ;     ACDEV("PROC",date,loc,n,"TIME")=time in minutes

 ;     ACDEV("PROC",date,loc,n,"PROV",provider ien)=""

 ;

 ;     ACDEV("PROC",date,loc,"PROV",provider ien)=""

 ;

START ;

 NEW ACDPROV

 S ACDQ=0

 ;W !!,"Generating CDMIS event array for visit data",!

 W !!,"Generating PCC link",!

 I '$O(ACDPCCL(0)) D ERROR("No visit data found",3) Q

 D PATLOOP

 D EOJ

 S ACDQ=0

 K ACDDFNP,ACDVIEN

 Q

 ;

PATLOOP ; GENERATE PCC LINK OR BILL FOR ALL VISITS FOR EACH PATIENT

 S ACDDFNP=0

 F  S ACDDFNP=$O(ACDPCCL(ACDDFNP)) Q:'ACDDFNP  S ACDVIEN=0 F  S ACDVIEN=$O(ACDPCCL(ACDDFNP,ACDVIEN)) Q:'ACDVIEN  D VISIT

 Q

 ;

VISIT ; EP - BUILD EVENT ARRAY AND GENERATE LINK/BILL FOR ONE VISIT

 ;//^ACDPCCLS

 D VISIT2

 K ACDEV,ACDPCCL(ACDDFNP,ACDVIEN),ACDPDD,ACDPRD

 Q

 ;

VISIT2 ;

 I ACDFHCP D CHKCOV I 'ACD3PCOV,'ACDFPCC Q  ;quit if no coverage/pcc

 K ACD3PCOV

 ;----- if edit mode delete v file entries and then add back

 I ACDMODE="E" D ^ACDPCCL7 S ACDMODEE=""

 Q:'$D(ACDPCCL(ACDDFNP,ACDVIEN))  ; quit if should not be added back

 NEW ACDMODE

 S ACDMODE="A"

 ;-----

 D GENEVENT^ACDPCCL2

 Q:ACDQ

 D:ACDFHCP GENBILL^ACDPCCL4

 D:ACDFPCC GENLINK^ACDPCCL5

 Q

 ;

CHKCOV ; EP-CHECK PATIENT 3RD PARTY COVERAGE ON VISIT DATE

 ;//^ACDBILLP

 S ACD3PCOV=0

 S ACD3PDAT=$P($G(^ACDVIS(ACDVIEN,0)),U)

 Q:ACD3PDAT=""

 S ACD3PCOV=$$MCD^AUPNPAT(ACDDFNP,ACD3PDAT)

 Q:ACD3PCOV

 S ACD3PCOV=$$MCR^AUPNPAT(ACDDFNP,ACD3PDAT)

 Q:ACD3PCOV

 S ACD3PCOV=$$PI^AUPNPAT(ACDDFNP,ACD3PDAT)

 Q:ACD3PCOV

 Q:'$D(ACDPCCLS)

 W !

 S DIR(0)="Y",DIR("A")="There is no 3rd party coverage for this visit.  Print a hardcopy anyway?",DIR("B")="N" K DA D ^DIR K DIR

 S:Y ACD3PCOV=1

 Q

 ;

ERROR(MSG,TIME) ; EP - WRITE ERROR TO OPERATOR

 S:$G(MSG)="" MSG="***** ERROR^ACDPCCL - NOTIFY PROGRAMMER *****"

 W !,$G(IORVON),MSG,$G(IORVOFF),!

 I $G(TIME) H TIME

 Q

 ;

EOJ ;

 K %,A,C,W,X,Y,Z

 K AGE

 K ACDPCCL,ACDEV

 K ACD3PCOV,ACD3PDAT

 Q

ACDPCCL   ;IHS/ADC/EDE/KML - PCC LINK;

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 +2       ;

 +3       ; Local array set as CDMIS entries added or edited:

 +4       ;     ACDPCCL(patient ien,visit ien)=""

 +5       ;     ACDPCCL(patient ien,visit ien,"CS",cs ien)=""

 +6       ;     ACDPCCL(patient ien,visit ien,"IIF",iif ien)=""

 +7       ;     ACDPCCL(patient ien,visit ien,"TDC",tdc ien)=""

 +8       ;

 +9       ; Local array set by this routine for PROTOCOL file:

 +10      ;  PGM

 +11      ;     ACDEV("TYPE")=add/edit/delete (i.e., A,E,D)

 +12      ;     ACDEV("SITE TYPE")=pcc visit type (e.g. I, 6)

 +13      ;     ACDEV("CLINIC")=clinic stop ien

 +14      ;     ACDEV("LOCATION")=location ien

 +15      ;  VIS

 +16      ;     ACDEV("VISIT")=visit ien

 +17      ;     ACDEV("PAT")=patient ien

 +18      ;     ACDEV("TC")=type contact (e.g. IN, CS)

 +19      ;     ACDEV("V DATE")=date of CDMIS visit

 +20      ;     ACDEV("PRI PROV")=primary provider ien

 +21      ;     ACDEV("SVC CAT")=service category (e.g. A)

 +22      ;  IIF & TDC

 +23      ;     ACDEV("POV",n)=icd9 ien:code:CHEMICAL DEPENDENCY-problem narr

 +24      ;     ACDEV("TIME")=time in minutes

 +25      ;  CS

 +26      ;    *ACDEV("V DATE")=date of CDMIS visit

 +27      ;    *ACDEV("LOCATION")=location ien

 +28      ;    *ACDEV("TIME")=time in minutes

 +29      ;    *ACDEV("POV",1)=icd9 ien:code:CONSULTING ON SUBSTANCE USE & ABUSE

 +30      ;     ACDEV("PROC",date,loc,n,"CS IEN")=ien of client svc entry

 +31      ;     ACDEV("PROC",date,loc,n,"NARR")=

 +32      ;                          cpt ien:code:CHEMICAL DEPENDENCY-CS narr

 +33      ;     ACDEV("PROC",date,loc,n,"TIME")=time in minutes

 +34      ;     ACDEV("PROC",date,loc,n,"PROV",provider ien)=""

 +35      ;

 +36      ;     ACDEV("PROC",date,loc,"PROV",provider ien)=""

 +37      ;

START     ;

 +1        NEW ACDPROV

 +2        SET ACDQ=0

 +3       ;W !!,"Generating CDMIS event array for visit data",!

 +4        WRITE !!,"Generating PCC link",!

 +5        IF '$ORDER(ACDPCCL(0))

               DO ERROR("No visit data found",3)

               QUIT 

 +6        DO PATLOOP

 +7        DO EOJ

 +8        SET ACDQ=0

 +9        KILL ACDDFNP,ACDVIEN

 +10       QUIT 

 +11      ;

PATLOOP   ; GENERATE PCC LINK OR BILL FOR ALL VISITS FOR EACH PATIENT

 +1        SET ACDDFNP=0

 +2        FOR 

               SET ACDDFNP=$ORDER(ACDPCCL(ACDDFNP))

               IF 'ACDDFNP

                   QUIT 

               SET ACDVIEN=0

               FOR 

                   SET ACDVIEN=$ORDER(ACDPCCL(ACDDFNP,ACDVIEN))

                   IF 'ACDVIEN

                       QUIT 

                   DO VISIT

 +3        QUIT 

 +4       ;

VISIT     ; EP - BUILD EVENT ARRAY AND GENERATE LINK/BILL FOR ONE VISIT

 +1       ;//^ACDPCCLS

 +2        DO VISIT2

 +3        KILL ACDEV,ACDPCCL(ACDDFNP,ACDVIEN),ACDPDD,ACDPRD

 +4        QUIT 

 +5       ;

VISIT2    ;

 +1       ;quit if no coverage/pcc

           IF ACDFHCP

               DO CHKCOV

               IF 'ACD3PCOV

                   IF 'ACDFPCC

                       QUIT 

 +2        KILL ACD3PCOV

 +3       ;----- if edit mode delete v file entries and then add back

 +4        IF ACDMODE="E"

               DO ^ACDPCCL7

               SET ACDMODEE=""

 +5       ; quit if should not be added back

           IF '$DATA(ACDPCCL(ACDDFNP,ACDVIEN))

               QUIT 

 +6        NEW ACDMODE

 +7        SET ACDMODE="A"

 +8       ;-----

 +9        DO GENEVENT^ACDPCCL2

 +10       IF ACDQ

               QUIT 

 +11       IF ACDFHCP

               DO GENBILL^ACDPCCL4

 +12       IF ACDFPCC

               DO GENLINK^ACDPCCL5

 +13       QUIT 

 +14      ;

CHKCOV    ; EP-CHECK PATIENT 3RD PARTY COVERAGE ON VISIT DATE

 +1       ;//^ACDBILLP

 +2        SET ACD3PCOV=0

 +3        SET ACD3PDAT=$PIECE($GET(^ACDVIS(ACDVIEN,0)),U)

 +4        IF ACD3PDAT=""

               QUIT 

 +5        SET ACD3PCOV=$$MCD^AUPNPAT(ACDDFNP,ACD3PDAT)

 +6        IF ACD3PCOV

               QUIT 

 +7        SET ACD3PCOV=$$MCR^AUPNPAT(ACDDFNP,ACD3PDAT)

 +8        IF ACD3PCOV

               QUIT 

 +9        SET ACD3PCOV=$$PI^AUPNPAT(ACDDFNP,ACD3PDAT)

 +10       IF ACD3PCOV

               QUIT 

 +11       IF '$DATA(ACDPCCLS)

               QUIT 

 +12       WRITE !

 +13       SET DIR(0)="Y"

           SET DIR("A")="There is no 3rd party coverage for this visit.  Print a hardcopy anyway?"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +14       IF Y

               SET ACD3PCOV=1

 +15       QUIT 

 +16      ;

ERROR(MSG,TIME) ; EP - WRITE ERROR TO OPERATOR

 +1        IF $GET(MSG)=""

               SET MSG="***** ERROR^ACDPCCL - NOTIFY PROGRAMMER *****"

 +2        WRITE !,$GET(IORVON),MSG,$GET(IORVOFF),!

 +3        IF $GET(TIME)

               HANG TIME

 +4        QUIT 

 +5       ;

EOJ       ;

 +1        KILL %,A,C,W,X,Y,Z

 +2        KILL AGE

 +3        KILL ACDPCCL,ACDEV

 +4        KILL ACD3PCOV,ACD3PDAT

 +5        QUIT