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

ACHSPAP.m

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