ACHSPAP ; IHS/ITSC/PMF - LINK TO PATIENT CARE COMPONENT (1/2) ; JUL 10, 2008
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**3,14,23**;JUN 11,2001;Build 43
;ACHS*3.1*3 set a var needed by the PCC interface
;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES
;
; This routine is not called unless the LINK is established to PCC.
;
; Required variables, that are unaltered:
; ACHSDOCR - Document record.
; ACHSDIEN - Document Internal Entry Number.
;
S ACHS=$G(APCDALVR("APCDTYPE"))
;
N ACHSDUZ0,ACHSLBL,ACHSTRAN,ACHSWOK,APCDALVR,AUPNTALK,APCDANE,APCDAUTO
;
I $L(ACHS) S APCDALVR("APCDTYPE")=ACHS
S ACHSWOK=(($G(ACHSISAO)'=0)&('$D(ZTQUEUED))) ; OK to write.
;
I $P(ACHSDOCR,U,12)'=3 W:ACHSWOK !,"NOT A PAID DOCUMENT." Q
I $P(ACHSDOCR,U,3) W:ACHSWOK !,"DOCUMENT NOT PATIENT SPECFIC (BLANKET OR SPECIAL LOCAL TRANS)." Q
;
I ACHSWOK W !,"Transferring Medical data to PATIENT CARE COMPONENT!",! D WAIT^DICD
;
;IF THERE IS A VISIT DELETE IT?????
I $$DOC^ACHS(2,5) D I '$$DIE^ACHS("60///@;61///@") W:ACHSWOK !,"DELETE VISIT from DOCUMENT record failed." Q
. I $$TOK W !,"DELETING EXISTING VISIT INFO."
. N APCDVDLT
. S APCDVDLT=$$DOC^ACHS(2,5)
. D ^APCDVDLT ;
.Q
;
F %=1:1 I $P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",%,0)),U,2)="P" S ACHSTRAN=$G(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",%,0)) Q
S AUPNTALK=1,APCDANE=1,APCDAUTO=1,Y=$P(ACHSDOCR,U,22)
D ^AUPNPAT
;
S ACHSDUZ0=DUZ(0)
S:'(DUZ(0)["M") DUZ(0)=DUZ(0)_"M" ; Requires SAC exception.
;
F ACHSLBL="VISIT","VPOV","VPRV","PX","CHS","VDEN","VCPT" D @ACHSLBL Q:$D(APCDALVR("APCDAFLG")) S %=APCDALVR("APCDVSIT") K APCDALVR S APCDALVR("APCDVSIT")=%
;
I $D(APCDALVR("APCDAFLG")) D
. I $G(ACHSISAO)=0 S ACHSERRE=24,ACHSEDAT=$$FLG(APCDALVR("APCDAFLG")) D ^ACHSEOBG
. N APCDVDLT
. S APCDVDLT=$S($$DOC^ACHS(2,5):$$DOC^ACHS(2,5),1:$G(APCDALVR("APCDVSIT")))
. D:APCDVDLT ^APCDVDLT
. I $$DOC^ACHS(2,5),$$DIE^ACHS("60///@;61///@")
. Q:'ACHSWOK
. W *7,!,"MEDICAL DATA FAILED TRANSFER TO PATIENT CARE COMPONENT.",!,$$FLG(APCDALVR("APCDAFLG"))
. I $L($P($G(APCDALVR("APCDAFLG")),U,2)) W !,"VALUE = '",$P(APCDALVR("APCDAFLG"),U,2),"'"
.Q
;
S:1 DUZ(0)=ACHSDUZ0
Q
;
; ---------------------------------------------------------------
;
VISIT ; Check/create VISIT entry in Patient Care Component.
I $$TOK W !,"PCC VISIT..."
;
S APCDALVR("APCDPAT")=$P(ACHSDOCR,U,22)
S APCDALVR("APCDDATE")=$P(ACHSTRAN,U,10)
S APCDALVR("APCDLOC")="`"_$$LOC($P(ACHSDOCR,U,4))
S:'$D(APCDALVR("APCDTYPE")) APCDALVR("APCDTYPE")="CONTRACT"
S APCDALVR("APCDCAT")=$S($P(ACHSTRAN,U,16)="Y":"I",$P(ACHSDOCR,U,4)=1:"H",1:"A")
; S APCDALVR("APCDCLN")= ptr to CLINIC STOP file
; S APCDALVR("APCDACS")="" unknown
;
S APCDALVR("APCDADD")=""
D EN^APCDALV
;
I $D(APCDALVR("APCDAFLG")) S APCDALVR("APCDAFLG")=APCDALVR("APCDAFLG")_U_"ADD to VISIT failed." Q
;
I '$$DIE^ACHS("60////"_APCDALVR("APCDVSIT")),ACHSWOK W !,"Edit VISIT field of DOCUMENT failed."
Q
;
;
VPRV ; Create entry in "V PROVIDER" file. ^AUPNVPRV 9000010.06
I $$TOK W !,"PCC PROVIDER..."
;
;GET THE GENERIC USER??
S X=$O(^VA(200,"GIHS",215999,0)) ;IHS ADC INDEX
I 'X S APCDALVR("APCDAFLG")=21 Q
;
;IF THE PCC FILE CONVERSION HAS NOT BEEN DONE LOOK AT PERSON FILE PTR
;IN USER FILE
I '$P($G(^AUTTSITE(1,0)),U,22) S X=$P(^DIC(3,X,0),U,16) I 'X K X S APCDALVR("APCDAFLG")=22 Q
;
;IF PCC CONVERSION HAS BEEN DONE USE NEW PERSON FILE ELSE USE PERSON
;LINE BELOW WAS MISSING A COMMA AFTER ^VA(200
S (DIE,DIC)=$S($P($G(^AUTTSITE(1,0)),U,22):"^VA(200,",1:"^DIC(16,")
S DIC(0)=""
S X="`"_X ;SET X WITH ACCENT- INTERNAL NUMBER
X $P(^DD(9000010.06,.01,0),U,5,99)
I '$D(X) S APCDALVR("APCDAFLG")=41 Q ;PROV FAILED EDIT IN "V PROVIDER" FILE
S APCDALVR("APCDTPRO")="`"_X
;
S (X,APCDALVR("APCDPAT"))=$P(ACHSDOCR,U,22)
X $P(^DD(9000010.06,.02,0),U,5,99)
I '$D(X) S APCDALVR("APCDAFLG")=42 Q ;PATIENT FAILED EDIT
;
S (X,APCDALVR("APCDTPS"))="P"
X $P(^DD(9000010.06,.04,0),U,5,99)
I '$D(X) S APCDALVR("APCDAFLG")=44 Q ;PRIMARY/SEC FAILED EDIT
;
S (X,APCDALVR("APCDTOA"))=""
X $P(^DD(9000010.06,.05,0),U,5,99)
I '$D(X) S APCDALVR("APCDAFLG")=45 Q ;OPER/ATTENDING FAILED EDIT
;
S APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
;
D EN^APCDALVR
;
I $D(APCDALVR("APCDAFLG")) S APCDALVR("APCDAFLG")=APCDALVR("APCDAFLG")_U_"ADD to V PROVIDER failed." Q
;
Q
;
;
VPOV ; Create entry in "V POV" file.
I $$TOK W !,"PCC PURPOSE OF VISIT..."
;
S APCDALVR("APCDTPS")="P"
;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 3 LINES AND SPLIT F LOOP
;F ACHS=0:0 S ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,9,ACHS)) Q:'ACHS!$D(APCDALVR("APCDAFLG")) S ACHS("DX")=+^(ACHS,0) I ACHS("DX")>1,$D(^ICD9(ACHS("DX"),0)),$E($G(^ICD9(ACHS("DX"),0)))'="E" D VPOV1
;ACHS*3.1*23 ICD10 CHANGE
;F ACHS=0:0 S ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,9,ACHS)) Q:'ACHS!$D(APCDALVR("APCDAFLG")) S ACHS("DX")=+^(ACHS,0) I ACHS("DX")>1,$D(^ICD9(ACHS("DX"),0)),$E($P($$ICDDX^ICDCODE(ACHS("DX")),U,2))'="E" D VPOV1
F ACHS=0:0 S ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,9,ACHS)) Q:'ACHS!$D(APCDALVR("APCDAFLG")) S ACHS("DX")=+^(ACHS,0) I ACHS("DX")>1,$D(^ICD9(ACHS("DX"),0)),$E($P($$ICDDX^ICDEX(ACHS("DX")),U,2))'="E" D VPOV1
K ACHS("DX")
Q
;
VPOV1 ;
; Pointer to ^ICD9( is in ACHS("DX").
;
S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
;
;pmf - 10/18/00 add the next line, Lori Butcher says it allows
;^APCDALVR to work, and it does.
S APCDALVR("APCDOVRR")=""
;
; .01 - POV - APCDTPOV
S (DIE,DIC)="^ICD9(",DIC(0)=""
S (X,APCDALVR("APCDTPOV"))="`"_ACHS("DX")
X $P(^DD(9000010.07,.01,0),U,5,99)
I '$D(X) S APCDALVR("APCDAFLG")=24_U_APCDALVR("APCDTPOV") Q
;
; .02 - Patient Name
S APCDALVR("APCDPAT")=$P(ACHSDOCR,U,22)
;
; .04 - Provider Narrative - APCDTNQ
S (DIE,DIC)="^AUTNPOV(",DIC(0)=""
;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
;S (X,APCDALVR("APCDTNQ"))=$P(^ICD9(ACHS("DX"),0),U,3)
;S (X,APCDALVR("APCDTNQ"))=$P($$ICDDX^ICDCODE(ACHS("DX")),U,4) ;ACHS*3.1*23
S (X,APCDALVR("APCDTNQ"))=$P($$ICDDX^ICDEX(ACHS("DX")),U,4) ;ACHS*3.1*23
;
;2/12/02 pmf We need even more to make PCC work
S APCDOVRR=1 ; ACHS*3.1*3
;
X $P(^DD(9000010.07,.04,0),U,5,99)
I '$D(X) S APCDALVR("APCDAFLG")=14_U_APCDALVR("APCDTNQ") Q
;
; .05 - Stage - APCDTSTG
; .06 - Modifier - APCDTMOD
; .07 - Cause of DX - APCDTCD
; .08 - First/Revisit - APCDTFR
;
; .09 - Cause of Injury - APCDTCI
S X=$$DOC^ACHS(3,7)
I X S APCDALVR("APCDTCI")=X,(DIE,DIC)="^ICD9(",DIC(0)="" X $P(^DD(9000010.07,.09,0),U,5,99) I '$D(X) S APCDALVR("APCDAFLG")=15_U_APCDALVR("APCDTCI") Q
; .11 - Place of Accident - APCDTPA
; .12 - Primary/Secondary - APCDTPS
; .13 - Date of Injury
; .14 - Override/Accept - APCDTACC
; .15 - Clinical Term
; .16 - Problem List Entry
;
S APCDALVR("ACHSDIEN")="" ; Needed to get by X-NEW in APCDALVR, as a
; flag to "V POV" file to accept inactive ICD9 codes.
;
D EN^APCDALVR
;
I $D(APCDALVR("APCDAFLG")) S APCDALVR("APCDAFLG")=APCDALVR("APCDAFLG")_U_"ADD to V POV failed."
;
K APCDALVR("APCDTPS")
Q
;
;
PX ; Create/update "V PROCEDURE" data.
I $$TOK W !,"PCC PROCEDURE..."
;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
;F ACHS=0:0 S ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,10,ACHS)) Q:'ACHS!$D(APCDALVR("APCDAFLG")) S ACHS("PTR")=+^(ACHS,0),ACHS("PXDT")=$P(^(0),U,2),ACHS("PX")=$P(^ICD0(+^(0),0),U) D PX1
;ACHS*3.1*23 SPLIT LINE ADDED CHG API
F ACHS=0:0 S ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,10,ACHS)) Q:'ACHS!$D(APCDALVR("APCDAFLG")) D
.S ACHS("PTR")=+^ACHSF(DUZ(2),"D",ACHSDIEN,10,ACHS,0),ACHS("PXDT")=$P(^(0),U,2)
.S ACHS("PX")=$P($$ICDOP^ICDEX($P(^ACHSF(DUZ(2),"D",ACHSDIEN,10,ACHS,0),U),,,"I"),U,2) D PX1
K ACHS("PTR"),ACHS("PXDT"),ACHS("PX")
Q
;
PX1 ;
S APCDALVR("APCDATMP")="[APCDALVR 9000010.08 (ADD)]"
S DIC(0)="M",X=$G(^DD(80.1,0,"DIC"))
I X]"" X ^%ZOSF("TEST") E S DIC(0)="IM"
I DFN S Y=DFN D ^AUPNPAT
;
; .01 - Procedure - APCDTPRC
S (DIE,DIC)="^ICD0("
S (X,APCDALVR("APCDTPRC"))=ACHS("PX")
X $P(^DD(9000010.08,.01,0),U,5,99)
I '$D(X) S APCDALVR("APCDAFLG")=25_U_APCDALVR("APCDTPRC") Q
;
; .04 - Provider Narrative - APCDTNQ
S (DIE,DIC)="^AUTNPOV("
S (X,APCDALVR("APCDTNQ"))=$E($P($G(^ICD0(ACHS("PTR"),1)),U),1,80)
;THESE TWO LINES MOVED DOWN 4
I $L(APCDALVR("APCDTNQ"))>74 S APCDALVR("APCDTNQ")=$E(APCDALVR("APCDTNQ"),1,74)_"~*CHS*"
E S APCDALVR("APCDTNQ")=APCDALVR("APCDTNQ")_"*CHS*"
;THIS IS GEORGES 5-23 CHANGE TO NARATIVE FAILURE
S X=APCDALVR("APCDTNQ")
X $P(^DD(9000010.08,.04,0),U,5,99)
I '$D(X) S APCDALVR("APCDAFLG")=35_U_APCDALVR("APCDTNQ") Q
;
; .06 - Procedure Date - APCDTPD
S (X,APCDALVR("APCDTPD"))=ACHS("PXDT")
X $P(^DD(9000010.08,.06,0),U,5,99)
I '$D(X) S APCDALVR("APCDAFLG")=23_U_APCDALVR("APCDTPD") Q
;
D EN^APCDALVR
;
I $D(APCDALVR("APCDAFLG")) S APCDALVR("APCDAFLG")=APCDALVR("APCDAFLG")_U_"ADD to V PROCEDURE failed." Q
;
Q
;
VDEN ; Create entries in "V DENTAL"
I $$TOK W !,"PCC V DENTAL..."
D VDEN^ACHSPAP1
Q
;
VCPT ; Create entries in "V CPT"
I $$TOK W !,"PCC V CPT..."
D VCPT^ACHSPAP1
Q
;
CHS ; Create an entry in V CHS
I $$TOK W !,"PCC V CHS..."
D CHS^ACHSPAP1
Q
;
TOK() ;EP - Change argument to 1 interactive testing.
Q 0
;
LOC(T) ;
; Given the Type of service return the LOCATION IEN:
; TOS LOCATION Name
; ------------------------ -------------------------
; 1 = Inpatient CHS HOSPITAL
; 2 = Dental CHS OTHER
; 3 = Outpatient CHS PHYSICIAN OFFICE
; If the above cannot be ascertained based on the ASUFAC of the
; facility, return DUZ(2).
N A,Y
S A=$P($G(^AUTTLOC(DUZ(2),0)),U,10)
I 'A Q DUZ(2)
S A=$E(A,1,4)_$S(T=1:"82",T=2:"97",1:"88")
S Y=$O(^AUTTLOC("C",A,0))
I Y Q Y
I T=2 S A=$E(A,1,4)_"86" S Y=$O(^AUTTLOC("C",A,0)) I Y Q Y
Q DUZ(2)
;
FLG(N) ;
I '$G(N) Q "<UNKNOWN>"
I '$L($T(ERRS+N)) Q "<UNKNOWN>"
Q $P($T(ERRS+N),";",4)
ERRS ;
;;1;Bad Input Template
;;2;DIE Interface Failed
;;3
;;4
;;5
;;6
;;7
;;8
;;9
;;10
;;11
;;12
;;13
;;14;Provider Narrative failed edit in V POV
;;15;Cause Of Injury failed edit in V POV
;;16
;;17
;;18
;;19
;;20
;;21;Cannot find generic contract provider for V PROVIDER
;;22;PROVIDER cannot be found in File 6 for V PROVIDER
;;23;PROCEDURE DATE failed edit in V PROCEDURE
;;24;ICD Diagnosis code failed edit in V POV
;;25;ICD Procedure code failed edit in V PROCEDURE
;;26;AUTHORIZATION NUMBER failed edit in V CHS
;;27;PAY STATUS failed edit in V CHS
;;28;TOTAL CHARGES failed edit in V CHS
;;29;DATE OF DISCHARGE failed edit in V CHS
;;30;NO OF VISITS failed edit in V CHS
;;31;ADA code failed edit in V DENTAL
;;32;CPT code failed edit in V CPT
;;33;Number Of Unites failed edit in V DENTAL
;;34;Tooth Surface failed edit in V DENTAL
;;35;PROVIDER NARRATIVE failed edit in V PROCEDURE
;;36
;;37
;;38
;;39
;;40
;;41;Provider (.01) failed edit in V PROVIDER
;;42;Patient (.02) failed edit in V PROVIDER
;;43
;;44;Primary/Secondary (.04) failed edit in V PROVIDER
;;45;Operator/Attending (.05) failed edit in V PROVIDER
;;46
ACHSPAP ; IHS/ITSC/PMF - LINK TO PATIENT CARE COMPONENT (1/2) ; JUL 10, 2008
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**3,14,23**;JUN 11,2001;Build 43
+2 ;ACHS*3.1*3 set a var needed by the PCC interface
+3 ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES
+4 ;
+5 ; This routine is not called unless the LINK is established to PCC.
+6 ;
+7 ; Required variables, that are unaltered:
+8 ; ACHSDOCR - Document record.
+9 ; ACHSDIEN - Document Internal Entry Number.
+10 ;
+11 SET ACHS=$GET(APCDALVR("APCDTYPE"))
+12 ;
+13 NEW ACHSDUZ0,ACHSLBL,ACHSTRAN,ACHSWOK,APCDALVR,AUPNTALK,APCDANE,APCDAUTO
+14 ;
+15 IF $LENGTH(ACHS)
SET APCDALVR("APCDTYPE")=ACHS
+16 ; OK to write.
SET ACHSWOK=(($GET(ACHSISAO)'=0)&('$DATA(ZTQUEUED)))
+17 ;
+18 IF $PIECE(ACHSDOCR,U,12)'=3
IF ACHSWOK
WRITE !,"NOT A PAID DOCUMENT."
QUIT
+19 IF $PIECE(ACHSDOCR,U,3)
IF ACHSWOK
WRITE !,"DOCUMENT NOT PATIENT SPECFIC (BLANKET OR SPECIAL LOCAL TRANS)."
QUIT
+20 ;
+21 IF ACHSWOK
WRITE !,"Transferring Medical data to PATIENT CARE COMPONENT!",!
DO WAIT^DICD
+22 ;
+23 ;IF THERE IS A VISIT DELETE IT?????
+24 IF $$DOC^ACHS(2,5)
Begin DoDot:1
+25 IF $$TOK
WRITE !,"DELETING EXISTING VISIT INFO."
+26 NEW APCDVDLT
+27 SET APCDVDLT=$$DOC^ACHS(2,5)
+28 ;
DO ^APCDVDLT
+29 QUIT
End DoDot:1
IF '$$DIE^ACHS("60///@;61///@")
IF ACHSWOK
WRITE !,"DELETE VISIT from DOCUMENT record failed."
QUIT
+30 ;
+31 FOR %=1:1
IF $PIECE($GET(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",%,0)),U,2)="P"
SET ACHSTRAN=$GET(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",%,0))
QUIT
+32 SET AUPNTALK=1
SET APCDANE=1
SET APCDAUTO=1
SET Y=$PIECE(ACHSDOCR,U,22)
+33 DO ^AUPNPAT
+34 ;
+35 SET ACHSDUZ0=DUZ(0)
+36 ; Requires SAC exception.
IF '(DUZ(0)["M")
SET DUZ(0)=DUZ(0)_"M"
+37 ;
+38 FOR ACHSLBL="VISIT","VPOV","VPRV","PX","CHS","VDEN","VCPT"
DO @ACHSLBL
IF $DATA(APCDALVR("APCDAFLG"))
QUIT
SET %=APCDALVR("APCDVSIT")
KILL APCDALVR
SET APCDALVR("APCDVSIT")=%
+39 ;
+40 IF $DATA(APCDALVR("APCDAFLG"))
Begin DoDot:1
+41 IF $GET(ACHSISAO)=0
SET ACHSERRE=24
SET ACHSEDAT=$$FLG(APCDALVR("APCDAFLG"))
DO ^ACHSEOBG
+42 NEW APCDVDLT
+43 SET APCDVDLT=$SELECT($$DOC^ACHS(2,5):$$DOC^ACHS(2,5),1:$GET(APCDALVR("APCDVSIT")))
+44 IF APCDVDLT
DO ^APCDVDLT
+45 IF $$DOC^ACHS(2,5)
IF $$DIE^ACHS("60///@;61///@")
+46 IF 'ACHSWOK
QUIT
+47 WRITE *7,!,"MEDICAL DATA FAILED TRANSFER TO PATIENT CARE COMPONENT.",!,$$FLG(APCDALVR("APCDAFLG"))
+48 IF $LENGTH($PIECE($GET(APCDALVR("APCDAFLG")),U,2))
WRITE !,"VALUE = '",$PIECE(APCDALVR("APCDAFLG"),U,2),"'"
+49 QUIT
End DoDot:1
+50 ;
+51 IF 1
SET DUZ(0)=ACHSDUZ0
+52 QUIT
+53 ;
+54 ; ---------------------------------------------------------------
+55 ;
VISIT ; Check/create VISIT entry in Patient Care Component.
+1 IF $$TOK
WRITE !,"PCC VISIT..."
+2 ;
+3 SET APCDALVR("APCDPAT")=$PIECE(ACHSDOCR,U,22)
+4 SET APCDALVR("APCDDATE")=$PIECE(ACHSTRAN,U,10)
+5 SET APCDALVR("APCDLOC")="`"_$$LOC($PIECE(ACHSDOCR,U,4))
+6 IF '$DATA(APCDALVR("APCDTYPE"))
SET APCDALVR("APCDTYPE")="CONTRACT"
+7 SET APCDALVR("APCDCAT")=$SELECT($PIECE(ACHSTRAN,U,16)="Y":"I",$PIECE(ACHSDOCR,U,4)=1:"H",1:"A")
+8 ; S APCDALVR("APCDCLN")= ptr to CLINIC STOP file
+9 ; S APCDALVR("APCDACS")="" unknown
+10 ;
+11 SET APCDALVR("APCDADD")=""
+12 DO EN^APCDALV
+13 ;
+14 IF $DATA(APCDALVR("APCDAFLG"))
SET APCDALVR("APCDAFLG")=APCDALVR("APCDAFLG")_U_"ADD to VISIT failed."
QUIT
+15 ;
+16 IF '$$DIE^ACHS("60////"_APCDALVR("APCDVSIT"))
IF ACHSWOK
WRITE !,"Edit VISIT field of DOCUMENT failed."
+17 QUIT
+18 ;
+19 ;
VPRV ; Create entry in "V PROVIDER" file. ^AUPNVPRV 9000010.06
+1 IF $$TOK
WRITE !,"PCC PROVIDER..."
+2 ;
+3 ;GET THE GENERIC USER??
+4 ;IHS ADC INDEX
SET X=$ORDER(^VA(200,"GIHS",215999,0))
+5 IF 'X
SET APCDALVR("APCDAFLG")=21
QUIT
+6 ;
+7 ;IF THE PCC FILE CONVERSION HAS NOT BEEN DONE LOOK AT PERSON FILE PTR
+8 ;IN USER FILE
+9 IF '$PIECE($GET(^AUTTSITE(1,0)),U,22)
SET X=$PIECE(^DIC(3,X,0),U,16)
IF 'X
KILL X
SET APCDALVR("APCDAFLG")=22
QUIT
+10 ;
+11 ;IF PCC CONVERSION HAS BEEN DONE USE NEW PERSON FILE ELSE USE PERSON
+12 ;LINE BELOW WAS MISSING A COMMA AFTER ^VA(200
+13 SET (DIE,DIC)=$SELECT($PIECE($GET(^AUTTSITE(1,0)),U,22):"^VA(200,",1:"^DIC(16,")
+14 SET DIC(0)=""
+15 ;SET X WITH ACCENT- INTERNAL NUMBER
SET X="`"_X
+16 XECUTE $PIECE(^DD(9000010.06,.01,0),U,5,99)
+17 ;PROV FAILED EDIT IN "V PROVIDER" FILE
IF '$DATA(X)
SET APCDALVR("APCDAFLG")=41
QUIT
+18 SET APCDALVR("APCDTPRO")="`"_X
+19 ;
+20 SET (X,APCDALVR("APCDPAT"))=$PIECE(ACHSDOCR,U,22)
+21 XECUTE $PIECE(^DD(9000010.06,.02,0),U,5,99)
+22 ;PATIENT FAILED EDIT
IF '$DATA(X)
SET APCDALVR("APCDAFLG")=42
QUIT
+23 ;
+24 SET (X,APCDALVR("APCDTPS"))="P"
+25 XECUTE $PIECE(^DD(9000010.06,.04,0),U,5,99)
+26 ;PRIMARY/SEC FAILED EDIT
IF '$DATA(X)
SET APCDALVR("APCDAFLG")=44
QUIT
+27 ;
+28 SET (X,APCDALVR("APCDTOA"))=""
+29 XECUTE $PIECE(^DD(9000010.06,.05,0),U,5,99)
+30 ;OPER/ATTENDING FAILED EDIT
IF '$DATA(X)
SET APCDALVR("APCDAFLG")=45
QUIT
+31 ;
+32 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
+33 ;
+34 DO EN^APCDALVR
+35 ;
+36 IF $DATA(APCDALVR("APCDAFLG"))
SET APCDALVR("APCDAFLG")=APCDALVR("APCDAFLG")_U_"ADD to V PROVIDER failed."
QUIT
+37 ;
+38 QUIT
+39 ;
+40 ;
VPOV ; Create entry in "V POV" file.
+1 IF $$TOK
WRITE !,"PCC PURPOSE OF VISIT..."
+2 ;
+3 SET APCDALVR("APCDTPS")="P"
+4 ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 3 LINES AND SPLIT F LOOP
+5 ;F ACHS=0:0 S ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,9,ACHS)) Q:'ACHS!$D(APCDALVR("APCDAFLG")) S ACHS("DX")=+^(ACHS,0) I ACHS("DX")>1,$D(^ICD9(ACHS("DX"),0)),$E($G(^ICD9(ACHS("DX"),0)))'="E" D VPOV1
+6 ;ACHS*3.1*23 ICD10 CHANGE
+7 ;F ACHS=0:0 S ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,9,ACHS)) Q:'ACHS!$D(APCDALVR("APCDAFLG")) S ACHS("DX")=+^(ACHS,0) I ACHS("DX")>1,$D(^ICD9(ACHS("DX"),0)),$E($P($$ICDDX^ICDCODE(ACHS("DX")),U,2))'="E" D VPOV1
+8 FOR ACHS=0:0
SET ACHS=$ORDER(^ACHSF(DUZ(2),"D",ACHSDIEN,9,ACHS))
IF 'ACHS!$DATA(APCDALVR("APCDAFLG"))
QUIT
SET ACHS("DX")=+^(ACHS,0)
IF ACHS("DX")>1
IF $DATA(^ICD9(ACHS("DX"),0))
IF $EXTRACT($PIECE($$ICDDX^ICDEX(ACHS("DX")),U,2))'="E"
DO VPOV1
+9 KILL ACHS("DX")
+10 QUIT
+11 ;
VPOV1 ;
+1 ; Pointer to ^ICD9( is in ACHS("DX").
+2 ;
+3 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
+4 ;
+5 ;pmf - 10/18/00 add the next line, Lori Butcher says it allows
+6 ;^APCDALVR to work, and it does.
+7 SET APCDALVR("APCDOVRR")=""
+8 ;
+9 ; .01 - POV - APCDTPOV
+10 SET (DIE,DIC)="^ICD9("
SET DIC(0)=""
+11 SET (X,APCDALVR("APCDTPOV"))="`"_ACHS("DX")
+12 XECUTE $PIECE(^DD(9000010.07,.01,0),U,5,99)
+13 IF '$DATA(X)
SET APCDALVR("APCDAFLG")=24_U_APCDALVR("APCDTPOV")
QUIT
+14 ;
+15 ; .02 - Patient Name
+16 SET APCDALVR("APCDPAT")=$PIECE(ACHSDOCR,U,22)
+17 ;
+18 ; .04 - Provider Narrative - APCDTNQ
+19 SET (DIE,DIC)="^AUTNPOV("
SET DIC(0)=""
+20 ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
+21 ;S (X,APCDALVR("APCDTNQ"))=$P(^ICD9(ACHS("DX"),0),U,3)
+22 ;S (X,APCDALVR("APCDTNQ"))=$P($$ICDDX^ICDCODE(ACHS("DX")),U,4) ;ACHS*3.1*23
+23 ;ACHS*3.1*23
SET (X,APCDALVR("APCDTNQ"))=$PIECE($$ICDDX^ICDEX(ACHS("DX")),U,4)
+24 ;
+25 ;2/12/02 pmf We need even more to make PCC work
+26 ; ACHS*3.1*3
SET APCDOVRR=1
+27 ;
+28 XECUTE $PIECE(^DD(9000010.07,.04,0),U,5,99)
+29 IF '$DATA(X)
SET APCDALVR("APCDAFLG")=14_U_APCDALVR("APCDTNQ")
QUIT
+30 ;
+31 ; .05 - Stage - APCDTSTG
+32 ; .06 - Modifier - APCDTMOD
+33 ; .07 - Cause of DX - APCDTCD
+34 ; .08 - First/Revisit - APCDTFR
+35 ;
+36 ; .09 - Cause of Injury - APCDTCI
+37 SET X=$$DOC^ACHS(3,7)
+38 IF X
SET APCDALVR("APCDTCI")=X
SET (DIE,DIC)="^ICD9("
SET DIC(0)=""
XECUTE $PIECE(^DD(9000010.07,.09,0),U,5,99)
IF '$DATA(X)
SET APCDALVR("APCDAFLG")=15_U_APCDALVR("APCDTCI")
QUIT
+39 ; .11 - Place of Accident - APCDTPA
+40 ; .12 - Primary/Secondary - APCDTPS
+41 ; .13 - Date of Injury
+42 ; .14 - Override/Accept - APCDTACC
+43 ; .15 - Clinical Term
+44 ; .16 - Problem List Entry
+45 ;
+46 ; Needed to get by X-NEW in APCDALVR, as a
SET APCDALVR("ACHSDIEN")=""
+47 ; flag to "V POV" file to accept inactive ICD9 codes.
+48 ;
+49 DO EN^APCDALVR
+50 ;
+51 IF $DATA(APCDALVR("APCDAFLG"))
SET APCDALVR("APCDAFLG")=APCDALVR("APCDAFLG")_U_"ADD to V POV failed."
+52 ;
+53 KILL APCDALVR("APCDTPS")
+54 QUIT
+55 ;
+56 ;
PX ; Create/update "V PROCEDURE" data.
+1 IF $$TOK
WRITE !,"PCC PROCEDURE..."
+2 ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
+3 ;F ACHS=0:0 S ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,10,ACHS)) Q:'ACHS!$D(APCDALVR("APCDAFLG")) S ACHS("PTR")=+^(ACHS,0),ACHS("PXDT")=$P(^(0),U,2),ACHS("PX")=$P(^ICD0(+^(0),0),U) D PX1
+4 ;ACHS*3.1*23 SPLIT LINE ADDED CHG API
+5 FOR ACHS=0:0
SET ACHS=$ORDER(^ACHSF(DUZ(2),"D",ACHSDIEN,10,ACHS))
IF 'ACHS!$DATA(APCDALVR("APCDAFLG"))
QUIT
Begin DoDot:1
+6 SET ACHS("PTR")=+^ACHSF(DUZ(2),"D",ACHSDIEN,10,ACHS,0)
SET ACHS("PXDT")=$PIECE(^(0),U,2)
+7 SET ACHS("PX")=$PIECE($$ICDOP^ICDEX($PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,10,ACHS,0),U),,,"I"),U,2)
DO PX1
End DoDot:1
+8 KILL ACHS("PTR"),ACHS("PXDT"),ACHS("PX")
+9 QUIT
+10 ;
PX1 ;
+1 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.08 (ADD)]"
+2 SET DIC(0)="M"
SET X=$GET(^DD(80.1,0,"DIC"))
+3 IF X]""
XECUTE ^%ZOSF("TEST")
IF '$TEST
SET DIC(0)="IM"
+4 IF DFN
SET Y=DFN
DO ^AUPNPAT
+5 ;
+6 ; .01 - Procedure - APCDTPRC
+7 SET (DIE,DIC)="^ICD0("
+8 SET (X,APCDALVR("APCDTPRC"))=ACHS("PX")
+9 XECUTE $PIECE(^DD(9000010.08,.01,0),U,5,99)
+10 IF '$DATA(X)
SET APCDALVR("APCDAFLG")=25_U_APCDALVR("APCDTPRC")
QUIT
+11 ;
+12 ; .04 - Provider Narrative - APCDTNQ
+13 SET (DIE,DIC)="^AUTNPOV("
+14 SET (X,APCDALVR("APCDTNQ"))=$EXTRACT($PIECE($GET(^ICD0(ACHS("PTR"),1)),U),1,80)
+15 ;THESE TWO LINES MOVED DOWN 4
+16 IF $LENGTH(APCDALVR("APCDTNQ"))>74
SET APCDALVR("APCDTNQ")=$EXTRACT(APCDALVR("APCDTNQ"),1,74)_"~*CHS*"
+17 IF '$TEST
SET APCDALVR("APCDTNQ")=APCDALVR("APCDTNQ")_"*CHS*"
+18 ;THIS IS GEORGES 5-23 CHANGE TO NARATIVE FAILURE
+19 SET X=APCDALVR("APCDTNQ")
+20 XECUTE $PIECE(^DD(9000010.08,.04,0),U,5,99)
+21 IF '$DATA(X)
SET APCDALVR("APCDAFLG")=35_U_APCDALVR("APCDTNQ")
QUIT
+22 ;
+23 ; .06 - Procedure Date - APCDTPD
+24 SET (X,APCDALVR("APCDTPD"))=ACHS("PXDT")
+25 XECUTE $PIECE(^DD(9000010.08,.06,0),U,5,99)
+26 IF '$DATA(X)
SET APCDALVR("APCDAFLG")=23_U_APCDALVR("APCDTPD")
QUIT
+27 ;
+28 DO EN^APCDALVR
+29 ;
+30 IF $DATA(APCDALVR("APCDAFLG"))
SET APCDALVR("APCDAFLG")=APCDALVR("APCDAFLG")_U_"ADD to V PROCEDURE failed."
QUIT
+31 ;
+32 QUIT
+33 ;
VDEN ; Create entries in "V DENTAL"
+1 IF $$TOK
WRITE !,"PCC V DENTAL..."
+2 DO VDEN^ACHSPAP1
+3 QUIT
+4 ;
VCPT ; Create entries in "V CPT"
+1 IF $$TOK
WRITE !,"PCC V CPT..."
+2 DO VCPT^ACHSPAP1
+3 QUIT
+4 ;
CHS ; Create an entry in V CHS
+1 IF $$TOK
WRITE !,"PCC V CHS..."
+2 DO CHS^ACHSPAP1
+3 QUIT
+4 ;
TOK() ;EP - Change argument to 1 interactive testing.
+1 QUIT 0
+2 ;
LOC(T) ;
+1 ; Given the Type of service return the LOCATION IEN:
+2 ; TOS LOCATION Name
+3 ; ------------------------ -------------------------
+4 ; 1 = Inpatient CHS HOSPITAL
+5 ; 2 = Dental CHS OTHER
+6 ; 3 = Outpatient CHS PHYSICIAN OFFICE
+7 ; If the above cannot be ascertained based on the ASUFAC of the
+8 ; facility, return DUZ(2).
+9 NEW A,Y
+10 SET A=$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,10)
+11 IF 'A
QUIT DUZ(2)
+12 SET A=$EXTRACT(A,1,4)_$SELECT(T=1:"82",T=2:"97",1:"88")
+13 SET Y=$ORDER(^AUTTLOC("C",A,0))
+14 IF Y
QUIT Y
+15 IF T=2
SET A=$EXTRACT(A,1,4)_"86"
SET Y=$ORDER(^AUTTLOC("C",A,0))
IF Y
QUIT Y
+16 QUIT DUZ(2)
+17 ;
FLG(N) ;
+1 IF '$GET(N)
QUIT "<UNKNOWN>"
+2 IF '$LENGTH($TEXT(ERRS+N))
QUIT "<UNKNOWN>"
+3 QUIT $PIECE($TEXT(ERRS+N),";",4)
ERRS ;
+1 ;;1;Bad Input Template
+2 ;;2;DIE Interface Failed
+3 ;;3
+4 ;;4
+5 ;;5
+6 ;;6
+7 ;;7
+8 ;;8
+9 ;;9
+10 ;;10
+11 ;;11
+12 ;;12
+13 ;;13
+14 ;;14;Provider Narrative failed edit in V POV
+15 ;;15;Cause Of Injury failed edit in V POV
+16 ;;16
+17 ;;17
+18 ;;18
+19 ;;19
+20 ;;20
+21 ;;21;Cannot find generic contract provider for V PROVIDER
+22 ;;22;PROVIDER cannot be found in File 6 for V PROVIDER
+23 ;;23;PROCEDURE DATE failed edit in V PROCEDURE
+24 ;;24;ICD Diagnosis code failed edit in V POV
+25 ;;25;ICD Procedure code failed edit in V PROCEDURE
+26 ;;26;AUTHORIZATION NUMBER failed edit in V CHS
+27 ;;27;PAY STATUS failed edit in V CHS
+28 ;;28;TOTAL CHARGES failed edit in V CHS
+29 ;;29;DATE OF DISCHARGE failed edit in V CHS
+30 ;;30;NO OF VISITS failed edit in V CHS
+31 ;;31;ADA code failed edit in V DENTAL
+32 ;;32;CPT code failed edit in V CPT
+33 ;;33;Number Of Unites failed edit in V DENTAL
+34 ;;34;Tooth Surface failed edit in V DENTAL
+35 ;;35;PROVIDER NARRATIVE failed edit in V PROCEDURE
+36 ;;36
+37 ;;37
+38 ;;38
+39 ;;39
+40 ;;40
+41 ;;41;Provider (.01) failed edit in V PROVIDER
+42 ;;42;Patient (.02) failed edit in V PROVIDER
+43 ;;43
+44 ;;44;Primary/Secondary (.04) failed edit in V PROVIDER
+45 ;;45;Operator/Attending (.05) failed edit in V PROVIDER
+46 ;;46
