ACDPCCL6 ;IHS/ADC/EDE/KML - PCC LINK;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
; This routine adds v file entries to the visit just generated
;
VFILES ;EP Create v file entries
I ACDEV("TC")'="CS" D PRIPROV I 1
E D CSPROVS,CSCPTS
D POV
D AT
D EOJ
Q
;
PRIPROV ; v provider (primary provider)
S ACDPRVDR=ACDEV("PRI PROV")
S ACDPRVPS="P"
D PROV
I $G(ACDQUIT)'="" D VFERROR
Q
;
CSPROVS ; v providers (CS visits)
; acdcsdte and acdloc are set prior to getting here
S ACDPRVPS="S"
S ACDPRVDR=0
F S ACDPRVDR=$O(ACDEV("PROC",ACDCSDTE,ACDLOC,"PROV",ACDPRVDR)) Q:'ACDPRVDR D PROV I $G(ACDQUIT)'="" D VFERROR
Q
;
PROV ; v provider
S ACDFILE="V PROVIDER",ACDFILEN=9000010.06
D KILL
S APCDALVR("APCDVSIT")=APCDVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
S APCDALVR("APCDPAT")=ACDEV("PAT")
S APCDALVR("APCDTPS")="P"
S X=ACDPRVDR
I '$P($G(^AUTTSITE(1,0)),U,22) D
. NEW A,P
. S P=X,A=$P(^DIC(3,P,0),U,16)
. I A="" S ACDQUIT=42,X="" Q
. I $P(^VA(200,P,0),U)'=$P(^DIC(16,A,0),U) S ACDQUIT=42,X="" Q
. S X=A
. Q
I X="" S ACDQUIT=41 Q
S APCDALVR("APCDTPRO")="`"_X
D APCDALVR
Q
;
CSCPTS ; v cpt
S ACDFILE="V CPT",ACDFILEN=9000010.18
S ACDCSPRC=0
F S ACDCSPRC=$O(ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC)) Q:'ACDCSPRC D
. D KILL
.;S APCDALVR("APCDTCPT")="`"_+ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"NARR") I APCDALVR("APCDTCPT")="`" S ACDQUIT=43 D VFERROR Q
. S APCDALVR("APCDTCPT")=+ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"NARR") I APCDALVR("APCDTCPT")="" S ACDQUIT=43 D VFERROR Q
. S APCDALVR("APCDVSIT")=APCDVSIT
. S APCDALVR("APCDATMP")="[APCDALVR 9000010.18 (ADD)]"
. S APCDALVR("APCDPAT")=ACDEV("PAT")
. S APCDALVR("APCDTPN")=$P(ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"NARR"),":",3)
. S APCDALVR("APCDTPP")="Y"
. S APCDALVR("APCDOVRR")=""
. D APCDALVR
. Q
Q
;
CSPROCS ; v procedures ***** NO LONGER USED *****
S ACDFILE="V PROCEDURES",ACDFILEN=9000010.08
S ACDCSPRC=0
F S ACDCSPRC=$O(ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC)) Q:'ACDCSPRC D
. D KILL
. S APCDALVR("APCDTPRC")="`"_+ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"NARR") I APCDALVR("APCDTPRC")="`" S ACDQUIT=43 D VFERROR Q
. S APCDALVR("APCDVSIT")=APCDVSIT
. S APCDALVR("APCDATMP")="[APCDALVR 9000010.08 (ADD)]"
. S APCDALVR("APCDPAT")=ACDEV("PAT")
. S APCDALVR("APCDTNQ")=$P(ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"NARR"),":",3)
. S APCDALVR("APCDOVRR")=""
. D APCDALVR
. Q
Q
;
POV ;create V POVS
S ACDFILE="V POV",ACDFILEN=9000010.07
S ACDY=0
F S ACDY=$O(ACDEV("POV",ACDY)) Q:'ACDY D
. D KILL
. S APCDALVR("APCDTPOV")="`"_+ACDEV("POV",ACDY) I APCDALVR("APCDTPOV")="`" S ACDQUIT=43 D VFERROR Q
. S APCDALVR("APCDTPS")=$S(ACDY=1:"P",1:"S")
. S APCDALVR("APCDVSIT")=APCDVSIT
. S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
. S APCDALVR("APCDPAT")=ACDEV("PAT")
. S APCDALVR("APCDTNQ")=$P(ACDEV("POV",ACDY),":",3)
. S APCDALVR("APCDOVRR")=""
. D APCDALVR
. Q
Q
;
AT ;create v activity time record
Q:'$G(ACDEV("TIME")) ; quit if no time
S ACDFILE="V ACTIVITY TIME",ACDFILEN=9000010.19
D KILL
S APCDALVR("APCDTACT")=ACDEV("TIME")
S APCDALVR("APCDVSIT")=APCDVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.19 (ADD)]"
S APCDALVR("APCDPAT")=ACDEV("PAT")
D APCDALVR
Q
;
APCDALVR ; GENERATE V FILE ENTRY
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S ACDQUIT=APCDALVR("APCDAFLG") D VFERROR Q
S ACDVFIEN=APCDALVR("APCDADFN")
S X=ACDFILEN,DA(2)=ACDEV("VISIT"),DA(1)=ACD21IEN,DIC="^ACDVIS("_DA(2)_",21,"_DA(1)_",11,",DIC(0)="L",DIC("DR")=".02////"_ACDVFIEN,DIC("P")=$P(^DD(9002172.121,1100,0),U,2)
I ACDEV("TC")="CS",ACDFILEN="9000010.18" S DIC("DR")=DIC("DR")_";.03////"_ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"CS IEN")
D FILE^ACDFMC
Q
;
KILL ;
K APCDAFLG,APCDALVR,APCDANE,APCDAPPT,APCDATMP,APCDAUTO
K APCDCAT,APCDCLN
K APCDLOC
K APCDOLOC
K APCDPAT
K APCDTAT,APCDTLOU,APCDTNQ,APCDTPOV,APCDTPRO,APCDTPRV,APCDTPS,APCDTTOP,APCDTYPE
K AUPNTALK
Q
;
EOJ ;
D KILL
K ACD21IEN,ACDCSPRC,ACDERR,ACDFILE,ACDFILEN,ACDIEN,ACDPRVDR,ACDPRVPS,ACDQUIT,ACDVFIEN,ACDY
Q
;
VFERROR ; WRITE ERROR MESSAGE
S ACDIEN=$G(ACDEV("VISIT"))
S ACDERR="VE"_ACDQUIT,ACDERR=$P($T(@ACDERR),";;",2)_$G(APCDALVR("APCDADIE"))
W !!,$G(IORVON)_"Notify your supervisor that the PCC LINK failed with the following error:",!,ACDFILE,"-",ACDERR_$G(IORVOFF),!!
D PAUSE^ACDDEU
K ACDQUIT
Q
;
VE1 ;;incorrect template specification
VE2 ;;invalid values being passed to V file.
VE3 ;;invalid visit parameters (date, location etc.)
VE41 ;;No PROVIDER ENTRY PASSED from CDMIS SYSTEM.
VE42 ;;Could NOT convert 200 Pointer to 6 pointer.
VE43 ;;Could not find ICD9 code in ICD Diagnosis file.
ACDPCCL6 ;IHS/ADC/EDE/KML - PCC LINK;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
+3 ; This routine adds v file entries to the visit just generated
+4 ;
VFILES ;EP Create v file entries
+1 IF ACDEV("TC")'="CS"
DO PRIPROV
IF 1
+2 IF '$TEST
DO CSPROVS
DO CSCPTS
+3 DO POV
+4 DO AT
+5 DO EOJ
+6 QUIT
+7 ;
PRIPROV ; v provider (primary provider)
+1 SET ACDPRVDR=ACDEV("PRI PROV")
+2 SET ACDPRVPS="P"
+3 DO PROV
+4 IF $GET(ACDQUIT)'=""
DO VFERROR
+5 QUIT
+6 ;
CSPROVS ; v providers (CS visits)
+1 ; acdcsdte and acdloc are set prior to getting here
+2 SET ACDPRVPS="S"
+3 SET ACDPRVDR=0
+4 FOR
SET ACDPRVDR=$ORDER(ACDEV("PROC",ACDCSDTE,ACDLOC,"PROV",ACDPRVDR))
IF 'ACDPRVDR
QUIT
DO PROV
IF $GET(ACDQUIT)'=""
DO VFERROR
+5 QUIT
+6 ;
PROV ; v provider
+1 SET ACDFILE="V PROVIDER"
SET ACDFILEN=9000010.06
+2 DO KILL
+3 SET APCDALVR("APCDVSIT")=APCDVSIT
+4 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
+5 SET APCDALVR("APCDPAT")=ACDEV("PAT")
+6 SET APCDALVR("APCDTPS")="P"
+7 SET X=ACDPRVDR
+8 IF '$PIECE($GET(^AUTTSITE(1,0)),U,22)
Begin DoDot:1
+9 NEW A,P
+10 SET P=X
SET A=$PIECE(^DIC(3,P,0),U,16)
+11 IF A=""
SET ACDQUIT=42
SET X=""
QUIT
+12 IF $PIECE(^VA(200,P,0),U)'=$PIECE(^DIC(16,A,0),U)
SET ACDQUIT=42
SET X=""
QUIT
+13 SET X=A
+14 QUIT
End DoDot:1
+15 IF X=""
SET ACDQUIT=41
QUIT
+16 SET APCDALVR("APCDTPRO")="`"_X
+17 DO APCDALVR
+18 QUIT
+19 ;
CSCPTS ; v cpt
+1 SET ACDFILE="V CPT"
SET ACDFILEN=9000010.18
+2 SET ACDCSPRC=0
+3 FOR
SET ACDCSPRC=$ORDER(ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC))
IF 'ACDCSPRC
QUIT
Begin DoDot:1
+4 DO KILL
+5 ;S APCDALVR("APCDTCPT")="`"_+ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"NARR") I APCDALVR("APCDTCPT")="`" S ACDQUIT=43 D VFERROR Q
+6 SET APCDALVR("APCDTCPT")=+ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"NARR")
IF APCDALVR("APCDTCPT")=""
SET ACDQUIT=43
DO VFERROR
QUIT
+7 SET APCDALVR("APCDVSIT")=APCDVSIT
+8 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.18 (ADD)]"
+9 SET APCDALVR("APCDPAT")=ACDEV("PAT")
+10 SET APCDALVR("APCDTPN")=$PIECE(ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"NARR"),":",3)
+11 SET APCDALVR("APCDTPP")="Y"
+12 SET APCDALVR("APCDOVRR")=""
+13 DO APCDALVR
+14 QUIT
End DoDot:1
+15 QUIT
+16 ;
CSPROCS ; v procedures ***** NO LONGER USED *****
+1 SET ACDFILE="V PROCEDURES"
SET ACDFILEN=9000010.08
+2 SET ACDCSPRC=0
+3 FOR
SET ACDCSPRC=$ORDER(ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC))
IF 'ACDCSPRC
QUIT
Begin DoDot:1
+4 DO KILL
+5 SET APCDALVR("APCDTPRC")="`"_+ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"NARR")
IF APCDALVR("APCDTPRC")="`"
SET ACDQUIT=43
DO VFERROR
QUIT
+6 SET APCDALVR("APCDVSIT")=APCDVSIT
+7 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.08 (ADD)]"
+8 SET APCDALVR("APCDPAT")=ACDEV("PAT")
+9 SET APCDALVR("APCDTNQ")=$PIECE(ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"NARR"),":",3)
+10 SET APCDALVR("APCDOVRR")=""
+11 DO APCDALVR
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
POV ;create V POVS
+1 SET ACDFILE="V POV"
SET ACDFILEN=9000010.07
+2 SET ACDY=0
+3 FOR
SET ACDY=$ORDER(ACDEV("POV",ACDY))
IF 'ACDY
QUIT
Begin DoDot:1
+4 DO KILL
+5 SET APCDALVR("APCDTPOV")="`"_+ACDEV("POV",ACDY)
IF APCDALVR("APCDTPOV")="`"
SET ACDQUIT=43
DO VFERROR
QUIT
+6 SET APCDALVR("APCDTPS")=$SELECT(ACDY=1:"P",1:"S")
+7 SET APCDALVR("APCDVSIT")=APCDVSIT
+8 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
+9 SET APCDALVR("APCDPAT")=ACDEV("PAT")
+10 SET APCDALVR("APCDTNQ")=$PIECE(ACDEV("POV",ACDY),":",3)
+11 SET APCDALVR("APCDOVRR")=""
+12 DO APCDALVR
+13 QUIT
End DoDot:1
+14 QUIT
+15 ;
AT ;create v activity time record
+1 ; quit if no time
IF '$GET(ACDEV("TIME"))
QUIT
+2 SET ACDFILE="V ACTIVITY TIME"
SET ACDFILEN=9000010.19
+3 DO KILL
+4 SET APCDALVR("APCDTACT")=ACDEV("TIME")
+5 SET APCDALVR("APCDVSIT")=APCDVSIT
+6 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.19 (ADD)]"
+7 SET APCDALVR("APCDPAT")=ACDEV("PAT")
+8 DO APCDALVR
+9 QUIT
+10 ;
APCDALVR ; GENERATE V FILE ENTRY
+1 DO ^APCDALVR
+2 IF $DATA(APCDALVR("APCDAFLG"))
SET ACDQUIT=APCDALVR("APCDAFLG")
DO VFERROR
QUIT
+3 SET ACDVFIEN=APCDALVR("APCDADFN")
+4 SET X=ACDFILEN
SET DA(2)=ACDEV("VISIT")
SET DA(1)=ACD21IEN
SET DIC="^ACDVIS("_DA(2)_",21,"_DA(1)_",11,"
SET DIC(0)="L"
SET DIC("DR")=".02////"_ACDVFIEN
SET DIC("P")=$PIECE(^DD(9002172.121,1100,0),U,2)
+5 IF ACDEV("TC")="CS"
IF ACDFILEN="9000010.18"
SET DIC("DR")=DIC("DR")_";.03////"_ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"CS IEN")
+6 DO FILE^ACDFMC
+7 QUIT
+8 ;
KILL ;
+1 KILL APCDAFLG,APCDALVR,APCDANE,APCDAPPT,APCDATMP,APCDAUTO
+2 KILL APCDCAT,APCDCLN
+3 KILL APCDLOC
+4 KILL APCDOLOC
+5 KILL APCDPAT
+6 KILL APCDTAT,APCDTLOU,APCDTNQ,APCDTPOV,APCDTPRO,APCDTPRV,APCDTPS,APCDTTOP,APCDTYPE
+7 KILL AUPNTALK
+8 QUIT
+9 ;
EOJ ;
+1 DO KILL
+2 KILL ACD21IEN,ACDCSPRC,ACDERR,ACDFILE,ACDFILEN,ACDIEN,ACDPRVDR,ACDPRVPS,ACDQUIT,ACDVFIEN,ACDY
+3 QUIT
+4 ;
VFERROR ; WRITE ERROR MESSAGE
+1 SET ACDIEN=$GET(ACDEV("VISIT"))
+2 SET ACDERR="VE"_ACDQUIT
SET ACDERR=$PIECE($TEXT(@ACDERR),";;",2)_$GET(APCDALVR("APCDADIE"))
+3 WRITE !!,$GET(IORVON)_"Notify your supervisor that the PCC LINK failed with the following error:",!,ACDFILE,"-",ACDERR_$GET(IORVOFF),!!
+4 DO PAUSE^ACDDEU
+5 KILL ACDQUIT
+6 QUIT
+7 ;
VE1 ;;incorrect template specification
VE2 ;;invalid values being passed to V file.
VE3 ;;invalid visit parameters (date, location etc.)
VE41 ;;No PROVIDER ENTRY PASSED from CDMIS SYSTEM.
VE42 ;;Could NOT convert 200 Pointer to 6 pointer.
VE43 ;;Could not find ICD9 code in ICD Diagnosis file.
